summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2010-06-13 11:55:28 -0500
committerJesse Luehrs <doy@tozt.net>2010-06-13 11:55:28 -0500
commite55803fce07b2fda98971fcb17698eef8a2fe4bb (patch)
tree50e54ede011b2a98c710db4d67e2d537355bc722
parenta1c10d3a2df2bb969aa0cdca2aeab9ce913d6f88 (diff)
downloadpackage-stash-e55803fce07b2fda98971fcb17698eef8a2fe4bb.tar.gz
package-stash-e55803fce07b2fda98971fcb17698eef8a2fe4bb.zip
add get_or_add_package_symbol, for the vivify behavior
-rw-r--r--lib/Package/Stash.pm31
-rw-r--r--t/004-get.t18
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;