X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPackage%2FStash%2FPP.pm;h=52753c2c4e973e91c2d3bb39ee76950646187f29;hb=bca9865190a06f363601baceeb803d555f55ff77;hp=446642bcfc1390ed55001091effe6053bd3f626c;hpb=2905fb35f8d7e19e0b9422060689d71c72bb6f39;p=gitmo%2FPackage-Stash.git

diff --git a/lib/Package/Stash/PP.pm b/lib/Package/Stash/PP.pm
index 446642b..52753c2 100644
--- a/lib/Package/Stash/PP.pm
+++ b/lib/Package/Stash/PP.pm
@@ -4,11 +4,14 @@ use warnings;
 # ABSTRACT: pure perl implementation of the Package::Stash API
 
 use Carp qw(confess);
-use Scalar::Util qw(blessed reftype);
+use Scalar::Util qw(blessed reftype weaken);
 use Symbol;
 # before 5.12, assigning to the ISA glob would make it lose its magical ->isa
 # powers
 use constant BROKEN_ISA_ASSIGNMENT => ($] < 5.012);
+# before 5.10, stashes don't ever seem to drop to a refcount of zero, so
+# weakening them isn't helpful
+use constant BROKEN_WEAK_STASH     => ($] < 5.010);
 
 =head1 SYNOPSIS
 
@@ -23,16 +26,19 @@ This is a backend for L<Package::Stash> implemented in pure perl, for those with
 sub new {
     my $class = shift;
     my ($package) = @_;
-    my $namespace;
-    {
-        no strict 'refs';
-        # supposedly this caused a bug in earlier perls, but I can't reproduce
-        # it, so re-enabling the caching
-        $namespace = \%{$package . '::'};
+
+    if (!defined($package) || (ref($package) && ref($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";
     }
+
     return bless {
-        'package'   => $package,
-        'namespace' => $namespace,
+        'package' => $package,
     }, $class;
 }
 
@@ -45,7 +51,23 @@ sub name {
 sub namespace {
     confess "Can't call namespace as a class method"
         unless blessed($_[0]);
-    return $_[0]->{namespace};
+
+    if (BROKEN_WEAK_STASH) {
+        no strict 'refs';
+        return \%{$_[0]->name . '::'};
+    }
+    else {
+        return $_[0]->{namespace} if defined $_[0]->{namespace};
+
+        {
+            no strict 'refs';
+            $_[0]->{namespace} = \%{$_[0]->name . '::'};
+        }
+
+        weaken($_[0]->{namespace});
+
+        return $_[0]->{namespace};
+    }
 }
 
 {
@@ -83,7 +105,7 @@ sub _valid_for_type {
     }
     else {
         my $ref = reftype($value);
-        return !defined($ref) || $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE';
+        return !defined($ref) || $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE' || $ref eq 'REGEXP';
     }
 }
 
@@ -122,8 +144,7 @@ sub add_symbol {
 
 sub remove_glob {
     my ($self, $name) = @_;
-    no strict 'refs';
-    delete ${$self->name . '::'}{$name};
+    delete $self->namespace->{$name};
 }
 
 sub has_symbol {
@@ -196,13 +217,7 @@ sub get_symbol {
             }
         }
         else {
-            if ($type eq 'CODE') {
-                # this effectively "de-vivifies" the code slot. if we don't do
-                # this, referencing the coderef at the end of this function
-                # will cause perl to auto-vivify a stub coderef in the slot,
-                # which isn't what we want
-                $self->add_symbol($variable);
-            }
+            return undef;
         }
     }
 
@@ -351,6 +366,12 @@ considered a feature in some cases (this is how L<namespace::clean> works, for
 instance), but should not be relied upon - use C<remove_glob> directly if you
 want this behavior.
 
+=item * Some minor memory leaks
+
+The pure perl implementation has a couple minor memory leaks (see the TODO
+tests in t/20-leaks.t) that I'm having a hard time tracking down - these may be
+core perl bugs, it's hard to tell.
+
 =back
 
 Please report any bugs through RT: email
@@ -402,6 +423,22 @@ Jesse Luehrs <doy at tozt dot net>
 Mostly copied from code from L<Class::MOP::Package>, by Stevan Little and the
 Moose Cabal.
 
+=begin Pod::Coverage
+
+BROKEN_ISA_ASSIGNMENT
+add_symbol
+get_all_symbols
+get_or_add_symbol
+get_symbol
+has_symbol
+list_all_symbols
+name
+namespace
+new
+remove_glob
+
+=end Pod::Coverage
+
 =cut
 
 1;