diff options
Diffstat (limited to 'MDK')
-rw-r--r-- | MDK/Common.pm | 19 | ||||
-rw-r--r-- | MDK/Common/Globals.pm | 61 |
2 files changed, 73 insertions, 7 deletions
diff --git a/MDK/Common.pm b/MDK/Common.pm index 4cccc21..dbc161c 100644 --- a/MDK/Common.pm +++ b/MDK/Common.pm @@ -1,12 +1,17 @@ package MDK::Common; -use MDK::Common::DataStructure ':all'; -use MDK::Common::File ':all'; -use MDK::Common::Func ':all'; -use MDK::Common::Math ':all'; -use MDK::Common::String ':all'; -use MDK::Common::System ':all'; -use MDK::Common::Various ':all'; +use MDK::Common::DataStructure qw(:all); +use MDK::Common::File qw(:all); +use MDK::Common::Func qw(:all); +use MDK::Common::Math qw(:all); +use MDK::Common::String qw(:all); +use MDK::Common::System qw(:all); +use MDK::Common::Various qw(:all); + +use vars qw(@ISA @EXPORT $VERSION); #); +@ISA = qw(Exporter); +# perl_checker: RE-EXPORT-ALL +@EXPORT = map { @$_ } map { values %{'MDK::Common::' . $_ . 'EXPORT_TAGS'} } grep { /::$/ } keys %MDK::Common::; $VERSION = "1.0"; diff --git a/MDK/Common/Globals.pm b/MDK/Common/Globals.pm new file mode 100644 index 0000000..32a4fc1 --- /dev/null +++ b/MDK/Common/Globals.pm @@ -0,0 +1,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; |