has_package_symbol

diff --git a/Stash.xs b/Stash.xs
index 58833e9..5631b9c 100644 (file)
--- a/Stash.xs
+++ b/Stash.xs
@@ -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 (file)
--- 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 (executable)
--- 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');