From: Jesse Luehrs <doy@tozt.net>
Date: Fri, 12 Nov 2010 15:13:50 +0000 (-0600)
Subject: remove_package_symbol
X-Git-Tag: 0.14~57
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=215f49f872bb4995c2168ca5b300ed0ac8f92aa0;p=gitmo%2FPackage-Stash-XS.git

remove_package_symbol
---

diff --git a/Stash.xs b/Stash.xs
index 07ed2cf..a70683e 100644
--- a/Stash.xs
+++ b/Stash.xs
@@ -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