# before 5.10, the scalar slot was always treated as existing if the
# glob existed
use constant BROKEN_SCALAR_INITIALIZATION => ($] < 5.010);
+# add_method on anon stashes triggers rt.perl #1804 otherwise
+# fixed in perl commit v5.13.3-70-g0fe688f
+use constant BROKEN_GLOB_ASSIGNMENT => ($] < 5.013004);
=head1 SYNOPSIS
my $class = shift;
my ($package) = @_;
- if (!defined($package) || (ref($package) && ref($package) ne 'HASH')) {
+ if (!defined($package) || (ref($package) && reftype($package) ne 'HASH')) {
confess "Package::Stash->new must be passed the name of the "
. "package to access";
}
- elsif (ref($package) eq 'HASH') {
- confess "The pure perl implementation of Package::Stash doesn't "
- . "currently support anonymous stashes. You should install "
- . "Package::Stash::XS";
+ elsif (ref($package) && reftype($package) eq 'HASH') {
+ confess "The PP implementation of Package::Stash does not support "
+ . "anonymous stashes before perl 5.14"
+ if BROKEN_GLOB_ASSIGNMENT;
+
+ return bless {
+ 'namespace' => $package,
+ }, $class;
}
- elsif ($package !~ /\A[0-9A-Z_a-z]+(?:::[0-9A-Z_a-z]+)*\z/) {
+ elsif ($package =~ /\A[0-9A-Z_a-z]+(?:::[0-9A-Z_a-z]+)*\z/) {
+ return bless {
+ 'package' => $package,
+ }, $class;
+ }
+ else {
confess "$package is not a module name";
}
- return bless {
- 'package' => $package,
- }, $class;
}
sub name {
confess "Can't call name as a class method"
unless blessed($_[0]);
+ confess "Can't get the name of an anonymous package"
+ unless defined($_[0]->{package});
return $_[0]->{package};
}
}
}
+sub _is_anon {
+ return !defined $_[0]->{package};
+}
+
{
my %SIGIL_MAP = (
'$' => 'SCALAR',
}
}
- my $namespace = $self->namespace;
- my $gv = $namespace->{$name} || Symbol::gensym;
- *$gv = ref $initial_value ? $initial_value : \$initial_value;
- $namespace->{$name} = *$gv;
+ if (BROKEN_GLOB_ASSIGNMENT) {
+ if (@_ > 2) {
+ no strict 'refs';
+ *{ $self->name . '::' . $name } = ref $initial_value
+ ? $initial_value : \$initial_value;
+ }
+ else {
+ no strict 'refs';
+ *{ $self->name . '::' . $name };
+ }
+ }
+ else {
+ my $namespace = $self->namespace;
+ $namespace->{$name} ||= *{ Symbol::gensym() };
+
+ if (@_ > 2) {
+ no warnings 'redefine';
+ *{ $namespace->{$name} } = ref $initial_value
+ ? $initial_value : \$initial_value;
+ }
+ }
}
sub remove_glob {
}
else {
if ($type eq 'CODE') {
- no strict 'refs';
- return \&{ $self->name . '::' . $name };
+ if (BROKEN_GLOB_ASSIGNMENT || !$self->_is_anon) {
+ no strict 'refs';
+ return \&{ $self->name . '::' . $name };
+ }
+
+ # XXX we should really be able to support arbitrary anonymous
+ # stashes here... (not just via Package::Anon)
+ if (blessed($namespace) && $namespace->isa('Package::Anon')) {
+ # ->can will call gv_init for us, which inflates the glob
+ # don't know how to do this in general
+ $namespace->bless(\(my $foo))->can($name);
+ }
+ else {
+ confess "Don't know how to inflate a " . ref($entry_ref)
+ . " into a full coderef (perhaps you could use"
+ . " Package::Anon instead of a bare stash?)"
+ }
+
+ return *{ $namespace->{$name} }{CODE};
}
else {
return undef;