[완료] perl에서, 한 변수의 값에 동적으로 의존하는 변수랄까... 이런 게 가능할까요?

#
#===============================================================================
#
#         FILE:  MyScalar.pm
#
#  DESCRIPTION:  Scalar를 타이하기 위한 모듈
#
#        FILES:  ---
#         BUGS:  ---
#        NOTES:  ---
#       AUTHOR:   (), <>
#      COMPANY:  
#      VERSION:  1.0
#      CREATED:  2007년 03월 05일 11시 09분 32초 KST
#     REVISION:  ---
#===============================================================================
 
package MyScalar;
 
use strict;
use warnings;
 
use Tie::Scalar;
our @ISA = qw(Tie::Scalar);
 
# Scalar tie에 대한 생성자
sub TIESCALAR {
    my $class  = shift;
    my $format = shift;
    my @args   = @_;
    my $object =  {
        value       => '',
        format      => $format,
        arguments   => \@args,
    };
 
    bless $object, $class;
}
 
# 읽기 전용 액세스 가로채기
sub FETCH {
    my $self = shift;
 
    # 범용적 포맷에 맞게 적용
    #   - pung96님의 방법 응용해 보았습니다.
    #   - 굳이 이렇게 할 필요는 없겠지요. :-)
    #   - 대신 포맷에 맞게 출력해주니 범용적입니다.
    #   - 포맷과 파라미터 개수에 대한 에러체크는 뺐습니다.
 
    # 포맷 적용을 위한 네임 영역 생성
    my $original_value = $$self{value};
    my @arg = map { $$_ } @{$$self{arguments}};
 
    # 포맷에 실제 네임 영역에 해당하는 값들을 치환
    my $apply_format = $$self{format};
    $apply_format =~ s/\%(.+?)\%/$1/gee;
 
    return $apply_format;
}
 
# 쓰기 전용 액세스 가로채기
sub STORE {
    my ($self, $newval) = @_;
    $$self{value} = $newval;
}
 
1;

#!/usr/bin/perl 
#===============================================================================
#
#         FILE:  tie_simple.pl
#
#        USAGE:  ./tie_simple.pl 
#
#  DESCRIPTION:  scalar를 tie하는 간단한 예제
#
#      OPTIONS:  ---
# REQUIREMENTS:  ---
#         BUGS:  ---
#        NOTES:  ---
#       AUTHOR:   (), <>
#      COMPANY:  
#      VERSION:  1.0
#      CREATED:  2007년 03월 05일 11시 13분 39초 KST
#     REVISION:  ---
#===============================================================================
 
use strict;
use warnings;
 
# 스칼라 tie를 위한 나만의 API
use MyScalar;
 
my $test_index;
my $test_prefix;
my $test_postfix;
 
# 스칼라 tie 적용
my $message;
tie(
    $message,                                               # tie할 변수
    'MyScalar',                                             # tie적용 클래스
    'No. %$arg[2]%: %$arg[0]%_%$original_value%_%$arg[1]%',   # 구현자 마음: format argument
    \$test_prefix,                                          # 구현자 마음: $arg[0]
    \$test_postfix,                                         # 구현자 마음: $arg[1]
    \$test_index,                                           # 구현자 마음: $arg[1]
);
 
# 타이로 인한 변화를 살펴보기, $message는 변화시키지 않음!
$test_index   = 1;
$test_prefix  = 'perlmania';
$test_postfix = 'BBS';
check_variable($test_index, $test_prefix, $test_postfix, $message);
 
# 타이로 인한 변화를 살펴보기, $message는 변화시키지 않음!
$test_index   = 2;
$test_prefix  = 'perlmania';
$test_postfix = 'mod_perl';
check_variable($test_index, $test_prefix, $test_postfix, $message);
 
# 타이로 인한 변화를 살펴보기, $message만 변화
$message      = "Tie 테스트 입니다.";
check_variable($test_index, $test_prefix, $test_postfix, $message);
 
# 타이로 인한 변화를 살펴보기, 모두 변화
$test_index   = 100;
$test_prefix  = 'KLDP';
$test_postfix = 'Programming Language';
$message      = "Linux & Perl";
check_variable($test_index, $test_prefix, $test_postfix, $message);
 
# 타이로 인한 변화를 살펴보기, $message만 변화
$message      = "이것이 바로 Tie 입니다.";
check_variable($test_index, $test_prefix, $test_postfix, $message);
 
# 간단한 변수 출력을 위한 함수
sub check_variable {
    my @variables = @_;
 
    for my $variable ( @variables ) {
        print "[$variable]\n";
    }
    print "\n";
}

[1]
[perlmania]
[BBS]
[No. 1: perlmania__BBS]
 
[2]
[perlmania]
[mod_perl]
[No. 2: perlmania__mod_perl]
 
[2]
[perlmania]
[mod_perl]
[No. 2: perlmania_Tie 테스트 입니다._mod_perl]
 
[100]
[KLDP]
[Programming Language]
[No. 100: KLDP_Linux & Perl_Programming Language]
 
[100]
[KLDP]
[Programming Language]
[No. 100: KLDP_이것이 바로 Tie 입니다._Programming Language]