diff options
| -rw-r--r-- | Stash.xs | 39 | ||||
| -rw-r--r-- | lib/Package/Stash.pm | 65 |
2 files changed, 39 insertions, 65 deletions
@@ -201,6 +201,45 @@ remove_package_glob(self, name) hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD); void +remove_package_symbol(self, variable) + SV *self + varspec_t variable + PREINIT: + HV *namespace; + SV **entry; + CODE: + namespace = _get_namespace(self); + entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0); + if (!entry) + XSRETURN_EMPTY; + + if (isGV(*entry)) { + GV *glob = (GV*)(*entry); + switch (variable.type) { + case VAR_SCALAR: + GvSV(glob) = Nullsv; + break; + case VAR_ARRAY: + GvAV(glob) = Nullav; + break; + case VAR_HASH: + GvHV(glob) = Nullhv; + break; + case VAR_CODE: + GvCV(glob) = Nullcv; + break; + case VAR_IO: + GvIOp(glob) = Null(struct io*); + break; + } + } + else { + if (variable.type == VAR_CODE) { + hv_delete(namespace, variable.name, strlen(variable.name), G_DISCARD); + } + } + +void list_all_package_symbols(self, vartype=VAR_NONE) SV *self vartype_t vartype diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm index a984a96..51226ec 100644 --- a/lib/Package/Stash.pm +++ b/lib/Package/Stash.pm @@ -285,71 +285,6 @@ Removes the package variable described by C<$variable> (which includes the sigil); other variables with the same name but different sigils will be untouched. -=cut - -sub remove_package_symbol { - my ($self, $variable) = @_; - - my ($name, $sigil, $type) = ref $variable eq 'HASH' - ? @{$variable}{qw[name sigil type]} - : $self->_deconstruct_variable_name($variable); - - # FIXME: - # no doubt this is grossly inefficient and - # could be done much easier and faster in XS - - my ($scalar_desc, $array_desc, $hash_desc, $code_desc, $io_desc) = ( - { sigil => '$', type => 'SCALAR', name => $name }, - { sigil => '@', type => 'ARRAY', name => $name }, - { sigil => '%', type => 'HASH', name => $name }, - { sigil => '&', type => 'CODE', name => $name }, - { sigil => '', type => 'IO', name => $name }, - ); - - my ($scalar, $array, $hash, $code, $io); - if ($type eq 'SCALAR') { - $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); - $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); - $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); - $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); - } - elsif ($type eq 'ARRAY') { - $scalar = $self->get_package_symbol($scalar_desc); - $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); - $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); - $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); - } - elsif ($type eq 'HASH') { - $scalar = $self->get_package_symbol($scalar_desc); - $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); - $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); - $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); - } - elsif ($type eq 'CODE') { - $scalar = $self->get_package_symbol($scalar_desc); - $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); - $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); - $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); - } - elsif ($type eq 'IO') { - $scalar = $self->get_package_symbol($scalar_desc); - $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); - $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); - $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); - } - else { - confess "This should never ever ever happen"; - } - - $self->remove_package_glob($name); - - $self->add_package_symbol($scalar_desc => $scalar); - $self->add_package_symbol($array_desc => $array) if defined $array; - $self->add_package_symbol($hash_desc => $hash) if defined $hash; - $self->add_package_symbol($code_desc => $code) if defined $code; - $self->add_package_symbol($io_desc => $io) if defined $io; -} - =method list_all_package_symbols $type_filter Returns a list of package variable names in the package, without sigils. If a |