diff options
author | Jesse Luehrs <doy@tozt.net> | 2010-06-13 11:55:28 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2010-06-13 11:55:28 -0500 |
commit | e55803fce07b2fda98971fcb17698eef8a2fe4bb (patch) | |
tree | 50e54ede011b2a98c710db4d67e2d537355bc722 | |
parent | a1c10d3a2df2bb969aa0cdca2aeab9ce913d6f88 (diff) | |
download | package-stash-e55803fce07b2fda98971fcb17698eef8a2fe4bb.tar.gz package-stash-e55803fce07b2fda98971fcb17698eef8a2fe4bb.zip |
add get_or_add_package_symbol, for the vivify behavior
-rw-r--r-- | lib/Package/Stash.pm | 31 | ||||
-rw-r--r-- | t/004-get.t | 18 |
2 files changed, 47 insertions, 2 deletions
diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm index 6b95340..6396ed5 100644 --- a/lib/Package/Stash.pm +++ b/lib/Package/Stash.pm @@ -226,7 +226,7 @@ Returns the value of the given package variable (including sigil). =cut sub get_package_symbol { - my ($self, $variable) = @_; + my ($self, $variable, %opts) = @_; my ($name, $sigil, $type) = ref $variable eq 'HASH' ? @{$variable}{qw[name sigil type]} @@ -235,7 +235,22 @@ sub get_package_symbol { my $namespace = $self->namespace; if (!exists $namespace->{$name}) { - $self->add_package_symbol($variable) + # assigning to the result of this function like + # @{$stash->get_package_symbol('@ISA')} = @new_ISA + # makes the result not visible until the variable is explicitly + # accessed... in the case of @ISA, this might never happen + # for instance, assigning like that and then calling $obj->isa + # will fail. see t/005-isa.t + if ($opts{vivify} && $type eq 'ARRAY' && $name ne 'ISA') { + $self->add_package_symbol($variable, []); + } + elsif ($opts{vivify} && $type eq 'HASH') { + $self->add_package_symbol($variable, {}); + } + else { + # FIXME + $self->add_package_symbol($variable) + } } my $entry_ref = \$namespace->{$name}; @@ -254,6 +269,18 @@ sub get_package_symbol { } } +=head2 get_or_add_package_symbol $variable + +Like C<get_package_symbol>, except that it will return an empty hashref or +arrayref if the variable doesn't exist. + +=cut + +sub get_or_add_package_symbol { + my $self = shift; + $self->get_package_symbol(@_, vivify => 1); +} + =head2 remove_package_symbol $variable Removes the package variable described by C<$variable> (which includes the diff --git a/t/004-get.t b/t/004-get.t index 89d7567..ebeb864 100644 --- a/t/004-get.t +++ b/t/004-get.t @@ -45,4 +45,22 @@ use Package::Stash; } } +{ + my $stash = Package::Stash->new('Baz'); + my $val = $stash->get_or_add_package_symbol('%foo'); + is(ref($val), 'HASH', "got something"); + $val->{bar} = 1; + is_deeply($stash->get_or_add_package_symbol('%foo'), {bar => 1}, + "got the right variable"); +} + +{ + my $stash = Package::Stash->new('Quux'); + my $val = $stash->get_or_add_package_symbol('@foo'); + is(ref($val), 'ARRAY', "got something"); + push @$val, 1; + is_deeply($stash->get_or_add_package_symbol('@foo'), [1], + "got the right variable"); +} + done_testing; |