1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
=head1 NAME
Shares constant values between modules
=head1 SYNOPSIS
use MDK::Common::Globals "foo", qw($a $b);
MDK::Common::Globals::init(a => 2, b => 3);
print $a; # 2
=cut
package MDK::Common::Globals;
sub import {
my (undef, $name, @globals) = @_;
foreach (@globals) {
$name =~ /^\$/ and die q(usage : use MDK::Common::Globals "group", qw($var1 $var2 ...););
s/^\$// or die qq(bad parameter to "use MDK::Common::Globals": missing variable ``$_'' should be written ``\$$_''); #);
no strict 'refs';
my $v = caller() . '::' . $_;
my $lv = "$foo __ $_";
*$v = *$lv;
eval { undef = $$lv; tie $$lv, 'MDK::Common::Globals', $_ };
}
}
sub init {
@_ % 2 == 0 or die "usage MDK::Common::Globals::init(key => val, key2 => val2, ...)\n";
my %l = @_;
foreach (keys %l) {
my $v = caller() . '::' . $_;
no strict 'refs';
$$v = $l{$_};
}
}
sub TIESCALAR {
my ($class, $name) = @_;
my $var;
bless [$var, undef, $name], $class;
}
sub STORE {
my ($o, $val) = @_;
$o->[1] and die "MDK::Common::Globals::$o->[2] already set\n";
$o->[1] = 1;
$o->[0] = $val;
}
sub FETCH {
my ($o) = @_;
$o->[1] or die "MDK::Common::Globals::$o->[2] unset\n";
$o->[0];
}
1;
|
