diff options
author | Jesse Luehrs <doy@tozt.net> | 2010-11-12 04:09:54 -0600 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2010-11-12 04:09:54 -0600 |
commit | 9b608466b5fdd9e91e34e050eb9ca861e36aa71d (patch) | |
tree | 19ab0857a9373bfab7131a2de1fb5fc0b08b15f4 | |
parent | a382a84ba7f959ceab7ecbf75e7c937153ebb603 (diff) | |
download | package-stash-xs-9b608466b5fdd9e91e34e050eb9ca861e36aa71d.tar.gz package-stash-xs-9b608466b5fdd9e91e34e050eb9ca861e36aa71d.zip |
implement list_all_package_symbols
-rw-r--r-- | Stash.xs | 58 | ||||
-rw-r--r-- | lib/Package/Stash.pm | 33 |
2 files changed, 58 insertions, 33 deletions
@@ -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. |