# ABSTRACT: pure perl implementation of the Package::Stash API
use Carp qw(confess);
-use Scalar::Util qw(blessed reftype);
+use Scalar::Util qw(blessed reftype weaken);
use Symbol;
# before 5.12, assigning to the ISA glob would make it lose its magical ->isa
# powers
use constant BROKEN_ISA_ASSIGNMENT => ($] < 5.012);
+# before 5.10, stashes don't ever seem to drop to a refcount of zero, so
+# weakening them isn't helpful
+use constant BROKEN_WEAK_STASH => ($] < 5.010);
=head1 SYNOPSIS
sub new {
my $class = shift;
my ($package) = @_;
- my $namespace;
- {
- no strict 'refs';
- # supposedly this caused a bug in earlier perls, but I can't reproduce
- # it, so re-enabling the caching
- $namespace = \%{$package . '::'};
+
+ if (!defined($package) || (ref($package) && ref($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";
}
+
return bless {
- 'package' => $package,
- 'namespace' => $namespace,
+ 'package' => $package,
}, $class;
}
sub namespace {
confess "Can't call namespace as a class method"
unless blessed($_[0]);
- return $_[0]->{namespace};
+
+ if (BROKEN_WEAK_STASH) {
+ no strict 'refs';
+ return \%{$_[0]->name . '::'};
+ }
+ else {
+ return $_[0]->{namespace} if defined $_[0]->{namespace};
+
+ {
+ no strict 'refs';
+ $_[0]->{namespace} = \%{$_[0]->name . '::'};
+ }
+
+ weaken($_[0]->{namespace});
+
+ return $_[0]->{namespace};
+ }
}
{
}
else {
my $ref = reftype($value);
- return !defined($ref) || $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE';
+ return !defined($ref) || $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE' || $ref eq 'REGEXP' || $ref eq 'VSTRING';
}
}
sub remove_glob {
my ($self, $name) = @_;
- no strict 'refs';
- delete ${$self->name . '::'}{$name};
+ delete $self->namespace->{$name};
}
sub has_symbol {
instance), but should not be relied upon - use C<remove_glob> directly if you
want this behavior.
+=item * Some minor memory leaks
+
+The pure perl implementation has a couple minor memory leaks (see the TODO
+tests in t/20-leaks.t) that I'm having a hard time tracking down - these may be
+core perl bugs, it's hard to tell.
+
=back
Please report any bugs through RT: email
Mostly copied from code from L<Class::MOP::Package>, by Stevan Little and the
Moose Cabal.
+=begin Pod::Coverage
+
+BROKEN_ISA_ASSIGNMENT
+add_symbol
+get_all_symbols
+get_or_add_symbol
+get_symbol
+has_symbol
+list_all_symbols
+name
+namespace
+new
+remove_glob
+
+=end Pod::Coverage
+
=cut
1;