get_package_symbol, without the vivify bits yet

diff --git a/Stash.xs b/Stash.xs
index f63ab01..db517d9 100644 (file)
--- a/Stash.xs
+++ b/Stash.xs
@@ -387,6 +387,65 @@ has_package_symbol(self, variable)
   OUTPUT:
     RETVAL
 
+SV*
+get_package_symbol(self, variable, ...)
+    SV *self
+    varspec_t variable
+  PREINIT:
+    HV *namespace;
+    SV **entry;
+  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 (vivify) {
+            /* XXX: vivify */
+        }
+    }
+
+    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 = newRV(GvSV(glob));
+            break;
+        case VAR_ARRAY:
+            RETVAL = newRV((SV*)GvAV(glob));
+            break;
+        case VAR_HASH:
+            RETVAL = newRV((SV*)GvHV(glob));
+            break;
+        case VAR_CODE:
+            RETVAL = newRV((SV*)GvCV(glob));
+            break;
+        case VAR_IO:
+            RETVAL = newRV((SV*)GvIO(glob));
+            break;
+        }
+    }
+    else {
+        /* XXX: need to expand code slots */
+        XSRETURN_UNDEF;
+    }
+  OUTPUT:
+    RETVAL
+
 void
 remove_package_symbol(self, variable)
     SV *self

diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm
index 73e53ef..0cd0c95 100644 (file)
--- a/lib/Package/Stash.pm
+++ b/lib/Package/Stash.pm
@@ -55,6 +55,8 @@ Returns the raw stash itself.
 
 =cut
 
+=pod
+
 {
     my %SIGIL_MAP = (
         '$' => 'SCALAR',
@@ -81,6 +83,8 @@ Returns the raw stash itself.
     }
 }
 
+=cut
+
 =method add_package_symbol $variable $value %opts
 
 Adds a new package symbol, for the symbol given as C<$variable>, and optionally
@@ -121,6 +125,8 @@ Returns the value of the given package variable (including sigil).
 
 =cut
 
+=pod
+
 sub get_package_symbol {
     my ($self, $variable, %opts) = @_;
 
@@ -186,6 +192,8 @@ sub get_package_symbol {
     }
 }
 
+=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/02-extension.t b/t/02-extension.t
index 18d87ea..0136b1a 100644 (file)
--- a/t/02-extension.t
+++ b/t/02-extension.t
@@ -23,7 +23,7 @@ use Test::Fatal;
     sub add_package_symbol {
         my ($self, $variable, $initial_value) = @_;
 
-        my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
+        (my $name = $variable) =~ s/^[\$\@\%\&]//;
 
         my $glob = gensym();
         *{$glob} = $initial_value if defined $initial_value;