diff options
| -rw-r--r-- | Stash.xs | 59 | ||||
| -rw-r--r-- | lib/Package/Stash.pm | 8 | ||||
| -rw-r--r-- | t/02-extension.t | 2 |
3 files changed, 68 insertions, 1 deletions
@@ -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 --- 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 --- 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; |