From: Jesse Luehrs Date: Fri, 12 Nov 2010 19:03:02 +0000 (-0600) Subject: get_package_symbol, without the vivify bits yet X-Git-Tag: 0.14~52 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e3ad44fd3e7afaec9dbe9420082df0a227d7c696;p=gitmo%2FPackage-Stash-XS.git get_package_symbol, without the vivify bits yet --- diff --git a/Stash.xs b/Stash.xs index f63ab01..db517d9 100644 --- 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 --- 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, 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;