X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPackage%2FStash%2FPP.pm;h=121a57e8188ab5e5b26a03b94d79c130eb027e3b;hb=c049a789b0ccb2734ee8c8f1b8a6bb80b575c19b;hp=f60ac4a3aa77bf0b0260a283a71730b38a1ada67;hpb=50419d916de6240d6dd8ea2af69b628db0c287ba;p=gitmo%2FPackage-Stash.git diff --git a/lib/Package/Stash/PP.pm b/lib/Package/Stash/PP.pm index f60ac4a..121a57e 100644 --- a/lib/Package/Stash/PP.pm +++ b/lib/Package/Stash/PP.pm @@ -31,27 +31,31 @@ sub new { my $class = shift; my ($package) = @_; - if (!defined($package) || (ref($package) && ref($package) ne 'HASH')) { + if (!defined($package) || (ref($package) && reftype($package) ne 'HASH')) { confess "Package::Stash->new must be passed the name of the " . "package to access"; } - elsif (ref($package) eq 'HASH') { - confess "The pure perl implementation of Package::Stash doesn't " - . "currently support anonymous stashes. You should install " - . "Package::Stash::XS"; + elsif (ref($package) && reftype($package) eq 'HASH') { + return bless { + 'namespace' => $package, + }, $class; } - elsif ($package !~ /\A[0-9A-Z_a-z]+(?:::[0-9A-Z_a-z]+)*\z/) { + elsif ($package =~ /\A[0-9A-Z_a-z]+(?:::[0-9A-Z_a-z]+)*\z/) { + return bless { + 'package' => $package, + }, $class; + } + else { confess "$package is not a module name"; } - return bless { - 'package' => $package, - }, $class; } sub name { confess "Can't call name as a class method" unless blessed($_[0]); + confess "Can't get the name of an anonymous package" + unless defined($_[0]->{package}); return $_[0]->{package}; } @@ -155,9 +159,9 @@ sub add_symbol { } my $namespace = $self->namespace; - my $gv = $namespace->{$name} || Symbol::gensym; - *$gv = ref $initial_value ? $initial_value : \$initial_value; - $namespace->{$name} = *$gv; + $namespace->{$name} ||= *{ Symbol::gensym() }; + *{ $namespace->{$name} } = ref $initial_value + ? $initial_value : \$initial_value; } sub remove_glob { @@ -243,8 +247,17 @@ sub get_symbol { } else { if ($type eq 'CODE') { - no strict 'refs'; - return \&{ $self->name . '::' . $name }; + # XXX we should really be able to support arbitrary anonymous + # stashes here... (not just via Package::Anon) + if (blessed($namespace) && $namespace->isa('Package::Anon')) { + # ->can will call gv_init for us + $namespace->bless(\(my $foo))->can($name); + return *{ $namespace->{$name} }{CODE}; + } + else { + no strict 'refs'; + return \&{ $self->name . '::' . $name }; + } } else { return undef;