package vars::global; { use version; $VERSION = qv('0.0.1'); use warnings; use strict; use Carp; # Module implementation here # Where we keep existing globals my %ref_for; sub import { my $package = shift; my $caller = caller; my @import; GRAB_IMPORTS: while (@_) { my $param = shift; last GRAB_IMPORTS if lc($param) eq 'create'; if (lc($param) eq ':all') { @import = keys %ref_for; while (@_) { last GRAB_IMPORTS if shift eq 'create'; } last GRAB_IMPORTS; } push @import, $param; } $package->_create($caller, @_); $package->_import($caller, @import, @_); return; } ## end sub import sub create { my $package = shift; my $caller = caller; $package->_create($caller, @_); $package->_import($caller, @_); return; } ## end sub create sub has { my $package = shift; my ($symbol) = @_; return unless exists $ref_for{$symbol}; return $ref_for{$symbol}; } ## end sub has sub _create { my $package = shift; my $caller = shift; my @symbols = @_; no strict 'refs'; no warnings 'once'; foreach my $symbol (@symbols) { # Some checks croak "undefined symbol" unless defined $symbol; croak "empty symbol" unless length $symbol; my $identifier = substr $symbol, 1; croak "invalid identifier '$identifier'" unless $identifier =~ /\A \w+ \z/mxs; my $fqn = $package . '::' . $identifier; my $sigil = substr $symbol, 0, 1; $ref_for{$symbol} = $sigil eq '$' ? \${$fqn} : $sigil eq '@' ? \@{$fqn} : $sigil eq '%' ? \%{$fqn} : croak "invalid sigil: '$sigil'"; } ## end foreach my $symbol (@symbols) return; } ## end sub _create sub _import { my $package = shift; my $caller = shift; no strict 'refs'; foreach my $symbol (@_) { my $ref = $package->has($symbol) or croak "non existent global: '$symbol'"; *{$caller . '::' . substr $symbol, 1} = $ref; } return; } ## end sub _import } 1; # Magic true value required at end of module __END__