From: Jesse Luehrs <doy@tozt.net>
Date: Fri, 12 Nov 2010 09:20:16 +0000 (-0600)
Subject: fix list_all_package_symbols
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FPackage-Stash-PP.git;a=commitdiff_plain;h=HEAD

fix list_all_package_symbols
---

diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm
index 132f687..4f1db68 100644
--- a/lib/Package/Stash.pm
+++ b/lib/Package/Stash.pm
@@ -381,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
 
@@ -399,10 +401,20 @@ sub list_all_package_symbols {
             # 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});
+                || 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};
     }
 }
 
diff --git a/t/01-basic.t b/t/01-basic.t
index 9c48845..4d78764 100644
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -324,4 +324,45 @@ ok(exception {
     }
 }
 
+{
+    package Quuux;
+    our $foo = 1;
+    our @foo;
+    our @bar;
+    our %baz;
+    sub baz { }
+    use constant quux => 1;
+    use constant quuux => [];
+    sub quuuux;
+}
+
+{
+    my $quuux = Package::Stash->new('Quuux');
+    is_deeply(
+        [sort $quuux->list_all_package_symbols],
+        [qw(BEGIN bar baz foo quuuux quuux quux)],
+        "list_all_package_symbols",
+    );
+    is_deeply(
+        [sort $quuux->list_all_package_symbols('SCALAR')],
+        [qw(foo)],
+        "list_all_package_symbols SCALAR",
+    );
+    is_deeply(
+        [sort $quuux->list_all_package_symbols('ARRAY')],
+        [qw(bar foo)],
+        "list_all_package_symbols ARRAY",
+    );
+    is_deeply(
+        [sort $quuux->list_all_package_symbols('HASH')],
+        [qw(baz)],
+        "list_all_package_symbols HASH",
+    );
+    is_deeply(
+        [sort $quuux->list_all_package_symbols('CODE')],
+        [qw(baz quuuux quuux quux)],
+        "list_all_package_symbols CODE",
+    );
+}
+
 done_testing;