fix list_all_package_symbols

[gitmo/Package-Stash-PP.git] / lib / Package / Stash.pm

diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm
index f708bbc..4f1db68 100644 (file)
--- a/lib/Package/Stash.pm
+++ b/lib/Package/Stash.pm
@@ -6,6 +6,9 @@ use warnings;
 use Carp qw(confess);
 use Scalar::Util qw(reftype);
 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);
 
 =head1 SYNOPSIS
 
@@ -201,8 +204,12 @@ sub has_package_symbol {
 
     my $entry_ref = \$namespace->{$name};
     if (reftype($entry_ref) eq 'GLOB') {
-        if ( $type eq 'SCALAR' ) {
-            return defined ${ *{$entry_ref}{SCALAR} };
+        # XXX: assigning to any typeglob slot also initializes the SCALAR slot,
+        # and saying that an undef scalar variable doesn't exist is probably
+        # vaguely less surprising than a scalar variable popping into existence
+        # without anyone defining it
+        if ($type eq 'SCALAR') {
+            return defined ${ *{$entry_ref}{$type} };
         }
         else {
             return defined *{$entry_ref}{$type};
@@ -233,12 +240,15 @@ sub get_package_symbol {
     if (!exists $namespace->{$name}) {
         if ($opts{vivify}) {
             if ($type eq 'ARRAY') {
-                $self->add_package_symbol(
-                    $variable,
-                    # setting our own arrayref manually loses the magicalness
-                    # or something
-                    $name eq 'ISA' ? () : ([])
-                );
+                if (BROKEN_ISA_ASSIGNMENT) {
+                    $self->add_package_symbol(
+                        $variable,
+                        $name eq 'ISA' ? () : ([])
+                    );
+                }
+                else {
+                    $self->add_package_symbol($variable, []);
+                }
             }
             elsif ($type eq 'HASH') {
                 $self->add_package_symbol($variable, {});
@@ -371,7 +381,9 @@ sub remove_package_symbol {
 Returns a list of package variable names in the package, without sigils. If a
 C<type_filter> is passed, it is used to select package variables of a given
 type, where valid types are the slots of a typeglob ('SCALAR', 'CODE', 'HASH',
-etc).
+etc). Note that if the package contained any C<BEGIN> blocks, perl will leave
+an empty typeglob in the C<BEGIN> slot, so this will show up if no filter is
+used (and similarly for C<INIT>, C<END>, etc).
 
 =cut
 
@@ -386,13 +398,23 @@ sub list_all_package_symbols {
     # type (SCALAR|ARRAY|HASH|CODE)
     if ($type_filter eq 'CODE') {
         return grep {
-            (ref($namespace->{$_})
-                ? (ref($namespace->{$_}) eq 'SCALAR')
-                : (ref(\$namespace->{$_}) eq 'GLOB'
-                   && defined(*{$namespace->{$_}}{CODE})));
+            # any non-typeglob in the symbol table is a constant or stub
+            ref(\$namespace->{$_}) ne 'GLOB'
+                # regular subs are stored in the CODE slot of the typeglob
+                || defined(*{$namespace->{$_}}{CODE})
+        } keys %{$namespace};
+    }
+    elsif ($type_filter eq 'SCALAR') {
+        return grep {
+            ref(\$namespace->{$_}) eq 'GLOB'
+                && defined(${*{$namespace->{$_}}{'SCALAR'}})
+        } keys %{$namespace};
+    }
+    else {
+        return grep {
+            ref(\$namespace->{$_}) eq 'GLOB'
+                && defined(*{$namespace->{$_}}{$type_filter})
         } keys %{$namespace};
-    } else {
-        return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace};
     }
 }