diff options
| -rw-r--r-- | Stash.xs | 73 | ||||
| -rw-r--r-- | lib/Package/Stash.pm | 111 | ||||
| -rw-r--r-- | t/04-get.t | 1 |
3 files changed, 49 insertions, 136 deletions
@@ -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 --- 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 @@ -4,6 +4,7 @@ use warnings; use Test::More; use Package::Stash; +use Scalar::Util; { BEGIN { |