diff options
author | Jesse Luehrs <doy@tozt.net> | 2010-11-12 09:25:55 -0600 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2010-11-12 09:25:55 -0600 |
commit | 34805376fa48a707b1a7f52f3a282ee5cacd2cf9 (patch) | |
tree | 024096cf644712dcd827aa87f373131235b01dd1 | |
parent | 996a8db0046b5172fadd26b389f73030f00149eb (diff) | |
download | package-stash-xs-34805376fa48a707b1a7f52f3a282ee5cacd2cf9.tar.gz package-stash-xs-34805376fa48a707b1a7f52f3a282ee5cacd2cf9.zip |
has_package_symbol
-rw-r--r-- | Stash.xs | 39 | ||||
-rw-r--r-- | lib/Package/Stash.pm | 33 | ||||
-rwxr-xr-x | t/07-edge-cases.t | 2 |
3 files changed, 39 insertions, 35 deletions
@@ -198,6 +198,45 @@ remove_package_glob(self, name) CODE: hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD); +int +has_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_UNDEF; + + if (isGV(*entry)) { + GV *glob = (GV*)(*entry); + switch (variable.type) { + case VAR_SCALAR: + RETVAL = GvSV(glob) ? 1 : 0; + break; + case VAR_ARRAY: + RETVAL = GvAV(glob) ? 1 : 0; + break; + case VAR_HASH: + RETVAL = GvHV(glob) ? 1 : 0; + break; + case VAR_CODE: + RETVAL = GvCV(glob) ? 1 : 0; + break; + case VAR_IO: + RETVAL = GvIO(glob) ? 1 : 0; + break; + } + } + else { + RETVAL = (variable.type == VAR_CODE); + } + OUTPUT: + RETVAL + void remove_package_symbol(self, variable) SV *self diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm index 51226ec..2015046 100644 --- a/lib/Package/Stash.pm +++ b/lib/Package/Stash.pm @@ -163,39 +163,6 @@ Removes all package variables with the given name, regardless of sigil. Returns whether or not the given package variable (including sigil) exists. -=cut - -sub has_package_symbol { - my ($self, $variable) = @_; - - my ($name, $sigil, $type) = ref $variable eq 'HASH' - ? @{$variable}{qw[name sigil type]} - : $self->_deconstruct_variable_name($variable); - - my $namespace = $self->namespace; - - return unless exists $namespace->{$name}; - - my $entry_ref = \$namespace->{$name}; - if (reftype($entry_ref) eq 'GLOB') { - # 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}; - } - } - else { - # a symbol table entry can be -1 (stub), string (stub with prototype), - # or reference (constant) - return $type eq 'CODE'; - } -} - =method get_package_symbol $variable Returns the value of the given package variable (including sigil). diff --git a/t/07-edge-cases.t b/t/07-edge-cases.t index e544c7a..a742c76 100755 --- a/t/07-edge-cases.t +++ b/t/07-edge-cases.t @@ -24,9 +24,7 @@ use Package::Stash; } my $stash = Package::Stash->new('Foo'); -{ local $TODO = "i think this is a perl bug (see comment in has_package_symbol)"; ok($stash->has_package_symbol('$SCALAR'), '$SCALAR'); -} ok($stash->has_package_symbol('$SCALAR_WITH_VALUE'), '$SCALAR_WITH_VALUE'); ok($stash->has_package_symbol('@ARRAY'), '@ARRAY'); ok($stash->has_package_symbol('%HASH'), '%HASH'); |