implement the rest of get_package_symbol

diff --git a/Stash.xs b/Stash.xs
index 42b3ee5..ff8cf70 100644 (file)
--- a/Stash.xs
+++ b/Stash.xs
@@ -396,37 +396,30 @@ get_package_symbol(self, variable, ...)
     HV *namespace;
     SV **entry;
     GV *glob;
+    int i, vivify = 0;
+    SV *val;
   CODE:
-    namespace = _get_namespace(self);
-
-    if (!hv_exists(namespace, variable.name, strlen(variable.name))) {
-        int i, vivify = 0;
-        if ((items - 2) % 2)
-            croak("get_package_symbol: Odd number of elements in %%opts");
-
-        for (i = 2; i < items; i += 2) {
-            char *key;
-            key = SvPV_nolen(ST(i));
-            if (strEQ(key, "vivify")) {
-                vivify = SvTRUE(ST(i + 1));
-            }
-        }
+    if (items > 2 && (items - 2) % 2)
+        croak("get_package_symbol: Odd number of elements in %%opts");
 
-        if (vivify) {
-            /* XXX: vivify */
+    for (i = 2; i < items; i += 2) {
+        char *key;
+        key = SvPV_nolen(ST(i));
+        if (strEQ(key, "vivify")) {
+            vivify = SvTRUE(ST(i + 1));
         }
     }
 
-    entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0);
+    namespace = _get_namespace(self);
+    entry = hv_fetch(namespace, variable.name, strlen(variable.name), vivify);
     if (!entry)
         XSRETURN_UNDEF;
 
     glob = (GV*)(*entry);
-
-    if (!isGV(*entry)) {
+    if (!isGV(glob)) {
         SV *namesv;
         char *name;
-        int len;
+        STRLEN len;
 
         namesv = newSVsv(_get_name(self));
         sv_catpvs(namesv, "::");
@@ -437,23 +430,53 @@ get_package_symbol(self, variable, ...)
         gv_init(glob, namespace, name, len, 1);
     }
 
+    if (vivify) {
+        switch (variable.type) {
+        case VAR_SCALAR:
+            if (!GvSV(glob))
+                GvSV(glob) = newSV(0);
+            break;
+        case VAR_ARRAY:
+            if (!GvAV(glob))
+                GvAV(glob) = newAV();
+            break;
+        case VAR_HASH:
+            if (!GvHV(glob))
+                GvHV(glob) = newHV();
+            break;
+        case VAR_CODE:
+            croak("Don't know how to vivify CODE variables");
+        case VAR_IO:
+            if (!GvIO(glob))
+                GvIOp(glob) = newIO();
+            break;
+        default:
+            croak("Unknown type in vivication");
+        }
+    }
+
     switch (variable.type) {
     case VAR_SCALAR:
-        RETVAL = newRV(GvSV(glob));
+        val = GvSV(glob);
         break;
     case VAR_ARRAY:
-        RETVAL = newRV((SV*)GvAV(glob));
+        val = (SV*)GvAV(glob);
         break;
     case VAR_HASH:
-        RETVAL = newRV((SV*)GvHV(glob));
+        val = (SV*)GvHV(glob);
         break;
     case VAR_CODE:
-        RETVAL = newRV((SV*)GvCV(glob));
+        val = (SV*)GvCV(glob);
         break;
     case VAR_IO:
-        RETVAL = newRV((SV*)GvIO(glob));
+        val = (SV*)GvIO(glob);
         break;
     }
+
+    if (!val)
+        XSRETURN_UNDEF;
+
+    RETVAL = newRV(val);
   OUTPUT:
     RETVAL
 

diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm
index 0cd0c95..be440a1 100644 (file)
--- a/lib/Package/Stash.pm
+++ b/lib/Package/Stash.pm
@@ -3,10 +3,6 @@ use strict;
 use warnings;
 # ABSTRACT: routines for manipulating stashes
 
-use Carp qw(confess);
-use Scalar::Util qw(reftype);
-use Symbol;
-
 use XSLoader;
 XSLoader::load(
     __PACKAGE__,
@@ -18,10 +14,6 @@ XSLoader::load(
         ? ${ $Package::Stash::{VERSION} } : (),
 );
 
-# before 5.12, assigning to the ISA glob would make it lose its magical ->isa
-# powers
-use constant BROKEN_ISA_ASSIGNMENT => ($] < 5.012);
-
 =head1 SYNOPSIS
 
   my $stash = Package::Stash->new('Foo');
@@ -53,38 +45,6 @@ Returns the name of the package that this object represents.
 
 Returns the raw stash itself.
 
-=cut
-
-=pod
-
-{
-    my %SIGIL_MAP = (
-        '$' => 'SCALAR',
-        '@' => 'ARRAY',
-        '%' => 'HASH',
-        '&' => 'CODE',
-        ''  => 'IO',
-    );
-
-    sub _deconstruct_variable_name {
-        my ($self, $variable) = @_;
-
-        (defined $variable && length $variable)
-            || confess "You must pass a variable name";
-
-        my $sigil = substr($variable, 0, 1, '');
-
-        if (exists $SIGIL_MAP{$sigil}) {
-            return ($variable, $sigil, $SIGIL_MAP{$sigil});
-        }
-        else {
-            return ("${sigil}${variable}", '', $SIGIL_MAP{''});
-        }
-    }
-}
-
-=cut
-
 =method add_package_symbol $variable $value %opts
 
 Adds a new package symbol, for the symbol given as C<$variable>, and optionally
@@ -123,77 +83,6 @@ Returns whether or not the given package variable (including sigil) exists.
 
 Returns the value of the given package variable (including sigil).
 
-=cut
-
-=pod
-
-sub get_package_symbol {
-    my ($self, $variable, %opts) = @_;
-
-    my ($name, $sigil, $type) = ref $variable eq 'HASH'
-        ? @{$variable}{qw[name sigil type]}
-        : $self->_deconstruct_variable_name($variable);
-
-    my $namespace = $self->namespace;
-
-    if (!exists $namespace->{$name}) {
-        if ($opts{vivify}) {
-            if ($type eq 'ARRAY') {
-                if (BROKEN_ISA_ASSIGNMENT) {
-                    $self->add_package_symbol(
-                        $variable,
-                        $name eq 'ISA' ? () : ([])
-                    );
-                }
-                else {
-                    $self->add_package_symbol($variable, []);
-                }
-            }
-            elsif ($type eq 'HASH') {
-                $self->add_package_symbol($variable, {});
-            }
-            elsif ($type eq 'SCALAR') {
-                $self->add_package_symbol($variable);
-            }
-            elsif ($type eq 'IO') {
-                $self->add_package_symbol($variable, Symbol::geniosym);
-            }
-            elsif ($type eq 'CODE') {
-                confess "Don't know how to vivify CODE variables";
-            }
-            else {
-                confess "Unknown type $type in vivication";
-            }
-        }
-        else {
-            if ($type eq 'CODE') {
-                # this effectively "de-vivifies" the code slot. if we don't do
-                # this, referencing the coderef at the end of this function
-                # will cause perl to auto-vivify a stub coderef in the slot,
-                # which isn't what we want
-                $self->add_package_symbol($variable);
-            }
-        }
-    }
-
-    my $entry_ref = \$namespace->{$name};
-
-    if (ref($entry_ref) eq 'GLOB') {
-        return *{$entry_ref}{$type};
-    }
-    else {
-        if ($type eq 'CODE') {
-            no strict 'refs';
-            return \&{ $self->name . '::' . $name };
-        }
-        else {
-            return undef;
-        }
-    }
-}
-
-=cut
-
 =method get_or_add_package_symbol $variable
 
 Like C<get_package_symbol>, except that it will return an empty hashref or

diff --git a/t/04-get.t b/t/04-get.t
index 3c4ae43..64847da 100644 (file)
--- a/t/04-get.t
+++ b/t/04-get.t
@@ -4,6 +4,7 @@ use warnings;
 use Test::More;
 
 use Package::Stash;
+use Scalar::Util;
 
 {
     BEGIN {