From: Jesse Luehrs <doy@tozt.net>
Date: Fri, 12 Nov 2010 10:09:54 +0000 (-0600)
Subject: implement list_all_package_symbols
X-Git-Tag: 0.14~60
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9b608466b5fdd9e91e34e050eb9ca861e36aa71d;p=gitmo%2FPackage-Stash-XS.git

implement list_all_package_symbols
---

diff --git a/Stash.xs b/Stash.xs
index d7eecc7..07c0238 100644
--- a/Stash.xs
+++ b/Stash.xs
@@ -199,3 +199,61 @@ remove_package_glob(self, name)
     HV *namespace;
   CODE:
     hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD);
+
+void
+list_all_package_symbols(self, vartype=VAR_NONE)
+    SV *self
+    vartype_t vartype
+  PPCODE:
+    if (vartype == VAR_NONE) {
+        HV *namespace;
+        HE *entry;
+        int keys;
+
+        namespace = _get_namespace(self);
+        keys = hv_iterinit(namespace);
+        EXTEND(SP, keys);
+        while (entry = hv_iternext(namespace)) {
+            mPUSHs(newSVhek(HeKEY_hek(entry)));
+        }
+    }
+    else {
+        HV *namespace;
+        HE *entry;
+        SV *val;
+        char *key;
+        int len;
+
+        namespace = _get_namespace(self);
+        hv_iterinit(namespace);
+        while (val = hv_iternextsv(namespace, &key, &len)) {
+            GV *gv = (GV*)val;
+            if (isGV(gv)) {
+                switch (vartype) {
+                case VAR_SCALAR:
+                    if (GvSV(val))
+                        mXPUSHp(key, len);
+                    break;
+                case VAR_ARRAY:
+                    if (GvAV(val))
+                        mXPUSHp(key, len);
+                    break;
+                case VAR_HASH:
+                    if (GvHV(val))
+                        mXPUSHp(key, len);
+                    break;
+                case VAR_CODE:
+                    if (GvCVu(val))
+                        mXPUSHp(key, len);
+                    break;
+                case VAR_IO:
+                    if (GvIO(val))
+                        mXPUSHp(key, len);
+                    break;
+                }
+            }
+            else if (vartype == VAR_CODE) {
+                mXPUSHp(key, len);
+            }
+        }
+    }
diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm
index 59b2c29..a984a96 100644
--- a/lib/Package/Stash.pm
+++ b/lib/Package/Stash.pm
@@ -359,39 +359,6 @@ 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
-
-sub list_all_package_symbols {
-    my ($self, $type_filter) = @_;
-
-    my $namespace = $self->namespace;
-    return keys %{$namespace} unless defined $type_filter;
-
-    # NOTE:
-    # or we can filter based on
-    # type (SCALAR|ARRAY|HASH|CODE)
-    if ($type_filter eq 'CODE') {
-        return grep {
-            # 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};
-    }
-}
-
 =head1 BUGS
 
 No known bugs.