From e94260dab724974551751dbdda9c4c9abde76e6e Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Fri, 14 May 2010 11:39:56 -0500 Subject: rename Stash::Manip -> Package::Stash --- Changes | 2 +- dist.ini | 2 +- lib/Package/Stash.pm | 400 +++++++++++++++++++++++++++++++++++++++++++++++++++ lib/Stash/Manip.pm | 400 --------------------------------------------------- t/000-load.t | 4 +- t/001-basic.t | 10 +- t/002-extension.t | 10 +- t/003-io.t | 8 +- t/004-get.t | 6 +- t/005-isa.t | 4 +- t/010-synopsis.t | 4 +- 11 files changed, 425 insertions(+), 425 deletions(-) create mode 100644 lib/Package/Stash.pm delete mode 100644 lib/Stash/Manip.pm diff --git a/Changes b/Changes index e503e81..38f5689 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,4 @@ -Revision history for Stash::Manip +Revision history for Package::Stash 0.02 2010-05-13 Need to dep on Test::Exception diff --git a/dist.ini b/dist.ini index 5b634e5..162472e 100644 --- a/dist.ini +++ b/dist.ini @@ -1,4 +1,4 @@ -name = Stash-Manip +name = Package-Stash version = 0.02 author = Jesse Luehrs license = Perl_5 diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm new file mode 100644 index 0000000..84a4d0b --- /dev/null +++ b/lib/Package/Stash.pm @@ -0,0 +1,400 @@ +package Package::Stash; +use strict; +use warnings; + +use Carp qw(confess); +use Scalar::Util qw(reftype); + +=head1 NAME + +Package::Stash - routines for manipulating stashes + +=head1 SYNOPSIS + + my $stash = Package::Stash->new('Foo'); + $stash->add_package_symbol('%foo', {bar => 1}); + # $Foo::foo{bar} == 1 + $stash->has_package_symbol('$foo') # false + my $namespace = $stash->namespace; + *{ $namespace->{foo} }{HASH} # {bar => 1} + +=head1 DESCRIPTION + +Manipulating stashes (Perl's symbol tables) is occasionally necessary, but +incredibly messy, and easy to get wrong. This module hides all of that behind a +simple API. + +NOTE: Most methods in this class require a variable specification that includes +a sigil. If this sigil is absent, it is assumed to represent the IO slot. + +=head1 METHODS + +=cut + +=head2 new $package_name + +Creates a new C object, for the package given as the only +argument. + +=cut + +sub new { + my $class = shift; + my ($namespace) = @_; + return bless { 'package' => $namespace }, $class; +} + +=head2 name + +Returns the name of the package that this object represents. + +=cut + +sub name { + return $_[0]->{package}; +} + +=head2 namespace + +Returns the raw stash itself. + +=cut + +sub namespace { + # NOTE: + # because of issues with the Perl API + # to the typeglob in some versions, we + # need to just always grab a new + # reference to the hash here. Ideally + # we could just store a ref and it would + # Just Work, but oh well :\ + no strict 'refs'; + return \%{$_[0]->name . '::'}; +} + +{ + 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{''}); + } + } +} + +=head2 add_package_symbol $variable $value + +Adds a new package symbol, for the symbol given as C<$variable>, and optionally +gives it an initial value of C<$value>. C<$variable> should be the name of +variable including the sigil, so + + Package::Stash->new('Foo')->add_package_symbol('%foo') + +will create C<%Foo::foo>. + +=cut + +sub _valid_for_type { + my $self = shift; + my ($value, $type) = @_; + if ($type eq 'HASH' || $type eq 'ARRAY' + || $type eq 'IO' || $type eq 'CODE') { + return reftype($value) eq $type; + } + else { + my $ref = reftype($value); + return !defined($ref) || $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE'; + } +} + +sub add_package_symbol { + my ($self, $variable, $initial_value) = @_; + + my ($name, $sigil, $type) = ref $variable eq 'HASH' + ? @{$variable}{qw[name sigil type]} + : $self->_deconstruct_variable_name($variable); + + if (@_ > 2) { + $self->_valid_for_type($initial_value, $type) + || confess "$initial_value is not of type $type"; + } + + my $pkg = $self->name; + + no strict 'refs'; + no warnings 'redefine', 'misc', 'prototype'; + *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value; +} + +=head2 remove_package_glob $name + +Removes all package variables with the given name, regardless of sigil. + +=cut + +sub remove_package_glob { + my ($self, $name) = @_; + no strict 'refs'; + delete ${$self->name . '::'}{$name}; +} + +# ... these functions deal with stuff on the namespace level + +=head2 has_package_symbol $variable + +Returns whether or not the given package variable (including sigil) exists. + +=cut + +sub has_package_symbol { + my ($self, $variable) = @_; + + my ($name, $sigil, $type) = ref $variable eq 'HASH' + ? @{$variable}{qw[name sigil type]} + : $self->_deconstruct_variable_name($variable); + + my $namespace = $self->namespace; + + return unless exists $namespace->{$name}; + + my $entry_ref = \$namespace->{$name}; + if (reftype($entry_ref) eq 'GLOB') { + if ( $type eq 'SCALAR' ) { + return defined ${ *{$entry_ref}{SCALAR} }; + } + else { + return defined *{$entry_ref}{$type}; + } + } + else { + # a symbol table entry can be -1 (stub), string (stub with prototype), + # or reference (constant) + return $type eq 'CODE'; + } +} + +=head2 get_package_symbol $variable + +Returns the value of the given package variable (including sigil). + +=cut + +sub get_package_symbol { + my ($self, $variable) = @_; + + 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}) { + # 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 ($type eq 'ARRAY' && $name ne 'ISA') { + $self->add_package_symbol($variable, []); + } + elsif ($type eq 'HASH') { + $self->add_package_symbol($variable, {}); + } + else { + # FIXME + $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; + } + } +} + +=head2 remove_package_symbol $variable + +Removes the package variable described by C<$variable> (which includes the +sigil); other variables with the same name but different sigils will be +untouched. + +=cut + +sub remove_package_symbol { + my ($self, $variable) = @_; + + my ($name, $sigil, $type) = ref $variable eq 'HASH' + ? @{$variable}{qw[name sigil type]} + : $self->_deconstruct_variable_name($variable); + + # FIXME: + # no doubt this is grossly inefficient and + # could be done much easier and faster in XS + + my ($scalar_desc, $array_desc, $hash_desc, $code_desc, $io_desc) = ( + { sigil => '$', type => 'SCALAR', name => $name }, + { sigil => '@', type => 'ARRAY', name => $name }, + { sigil => '%', type => 'HASH', name => $name }, + { sigil => '&', type => 'CODE', name => $name }, + { sigil => '', type => 'IO', name => $name }, + ); + + my ($scalar, $array, $hash, $code, $io); + if ($type eq 'SCALAR') { + $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); + $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); + $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); + $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); + } + elsif ($type eq 'ARRAY') { + $scalar = $self->get_package_symbol($scalar_desc); + $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); + $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); + $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); + } + elsif ($type eq 'HASH') { + $scalar = $self->get_package_symbol($scalar_desc); + $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); + $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); + $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); + } + elsif ($type eq 'CODE') { + $scalar = $self->get_package_symbol($scalar_desc); + $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); + $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); + $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); + } + elsif ($type eq 'IO') { + $scalar = $self->get_package_symbol($scalar_desc); + $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); + $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); + $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); + } + else { + confess "This should never ever ever happen"; + } + + $self->remove_package_glob($name); + + $self->add_package_symbol($scalar_desc => $scalar); + $self->add_package_symbol($array_desc => $array) if defined $array; + $self->add_package_symbol($hash_desc => $hash) if defined $hash; + $self->add_package_symbol($code_desc => $code) if defined $code; + $self->add_package_symbol($io_desc => $io) if defined $io; +} + +=head2 list_all_package_symbols $type_filter + +Returns a list of package variable names in the package, without sigils. If a +C is passed, it is used to select package variables of a given +type, where valid types are the slots of a typeglob ('SCALAR', 'CODE', 'HASH', +etc). + +=cut + +sub list_all_package_symbols { + my ($self, $type_filter) = @_; + + my $namespace = $self->namespace; + return keys %{$namespace} unless defined $type_filter; + + # NOTE: + # or we can filter based on + # type (SCALAR|ARRAY|HASH|CODE) + if ($type_filter eq 'CODE') { + return grep { + (ref($namespace->{$_}) + ? (ref($namespace->{$_}) eq 'SCALAR') + : (ref(\$namespace->{$_}) eq 'GLOB' + && defined(*{$namespace->{$_}}{CODE}))); + } keys %{$namespace}; + } else { + return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace}; + } +} + +=head1 BUGS + +No known bugs. + +Please report any bugs through RT: email +C, or browse to +L. + +=head1 SEE ALSO + +L - this module is a factoring out of code that used to +live here + +=head1 SUPPORT + +You can find this documentation for this module with the perldoc command. + + perldoc Package::Stash + +You can also look for information at: + +=over 4 + +=item * AnnoCPAN: Annotated CPAN documentation + +L + +=item * CPAN Ratings + +L + +=item * RT: CPAN's request tracker + +L + +=item * Search CPAN + +L + +=back + +=head1 AUTHOR + + Jesse Luehrs + +Mostly copied from code from L, by Stevan Little and the +Moose Cabal. + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by Jesse Luehrs. + +This is free software; you can redistribute it and/or modify it under +the same terms as perl itself. + +=cut + +1; diff --git a/lib/Stash/Manip.pm b/lib/Stash/Manip.pm deleted file mode 100644 index cad3742..0000000 --- a/lib/Stash/Manip.pm +++ /dev/null @@ -1,400 +0,0 @@ -package Stash::Manip; -use strict; -use warnings; - -use Carp qw(confess); -use Scalar::Util qw(reftype); - -=head1 NAME - -Stash::Manip - routines for manipulating stashes - -=head1 SYNOPSIS - - my $stash = Stash::Manip->new('Foo'); - $stash->add_package_symbol('%foo', {bar => 1}); - # $Foo::foo{bar} == 1 - $stash->has_package_symbol('$foo') # false - my $namespace = $stash->namespace; - *{ $namespace->{foo} }{HASH} # {bar => 1} - -=head1 DESCRIPTION - -Manipulating stashes (Perl's symbol tables) is occasionally necessary, but -incredibly messy, and easy to get wrong. This module hides all of that behind a -simple API. - -NOTE: Most methods in this class require a variable specification that includes -a sigil. If this sigil is absent, it is assumed to represent the IO slot. - -=head1 METHODS - -=cut - -=head2 new $package_name - -Creates a new C object, for the package given as the only -argument. - -=cut - -sub new { - my $class = shift; - my ($namespace) = @_; - return bless { 'package' => $namespace }, $class; -} - -=head2 name - -Returns the name of the package that this object represents. - -=cut - -sub name { - return $_[0]->{package}; -} - -=head2 namespace - -Returns the raw stash itself. - -=cut - -sub namespace { - # NOTE: - # because of issues with the Perl API - # to the typeglob in some versions, we - # need to just always grab a new - # reference to the hash here. Ideally - # we could just store a ref and it would - # Just Work, but oh well :\ - no strict 'refs'; - return \%{$_[0]->name . '::'}; -} - -{ - 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{''}); - } - } -} - -=head2 add_package_symbol $variable $value - -Adds a new package symbol, for the symbol given as C<$variable>, and optionally -gives it an initial value of C<$value>. C<$variable> should be the name of -variable including the sigil, so - - Stash::Manip->new('Foo')->add_package_symbol('%foo') - -will create C<%Foo::foo>. - -=cut - -sub _valid_for_type { - my $self = shift; - my ($value, $type) = @_; - if ($type eq 'HASH' || $type eq 'ARRAY' - || $type eq 'IO' || $type eq 'CODE') { - return reftype($value) eq $type; - } - else { - my $ref = reftype($value); - return !defined($ref) || $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE'; - } -} - -sub add_package_symbol { - my ($self, $variable, $initial_value) = @_; - - my ($name, $sigil, $type) = ref $variable eq 'HASH' - ? @{$variable}{qw[name sigil type]} - : $self->_deconstruct_variable_name($variable); - - if (@_ > 2) { - $self->_valid_for_type($initial_value, $type) - || confess "$initial_value is not of type $type"; - } - - my $pkg = $self->name; - - no strict 'refs'; - no warnings 'redefine', 'misc', 'prototype'; - *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value; -} - -=head2 remove_package_glob $name - -Removes all package variables with the given name, regardless of sigil. - -=cut - -sub remove_package_glob { - my ($self, $name) = @_; - no strict 'refs'; - delete ${$self->name . '::'}{$name}; -} - -# ... these functions deal with stuff on the namespace level - -=head2 has_package_symbol $variable - -Returns whether or not the given package variable (including sigil) exists. - -=cut - -sub has_package_symbol { - my ($self, $variable) = @_; - - my ($name, $sigil, $type) = ref $variable eq 'HASH' - ? @{$variable}{qw[name sigil type]} - : $self->_deconstruct_variable_name($variable); - - my $namespace = $self->namespace; - - return unless exists $namespace->{$name}; - - my $entry_ref = \$namespace->{$name}; - if (reftype($entry_ref) eq 'GLOB') { - if ( $type eq 'SCALAR' ) { - return defined ${ *{$entry_ref}{SCALAR} }; - } - else { - return defined *{$entry_ref}{$type}; - } - } - else { - # a symbol table entry can be -1 (stub), string (stub with prototype), - # or reference (constant) - return $type eq 'CODE'; - } -} - -=head2 get_package_symbol $variable - -Returns the value of the given package variable (including sigil). - -=cut - -sub get_package_symbol { - my ($self, $variable) = @_; - - 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}) { - # 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 ($type eq 'ARRAY' && $name ne 'ISA') { - $self->add_package_symbol($variable, []); - } - elsif ($type eq 'HASH') { - $self->add_package_symbol($variable, {}); - } - else { - # FIXME - $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; - } - } -} - -=head2 remove_package_symbol $variable - -Removes the package variable described by C<$variable> (which includes the -sigil); other variables with the same name but different sigils will be -untouched. - -=cut - -sub remove_package_symbol { - my ($self, $variable) = @_; - - my ($name, $sigil, $type) = ref $variable eq 'HASH' - ? @{$variable}{qw[name sigil type]} - : $self->_deconstruct_variable_name($variable); - - # FIXME: - # no doubt this is grossly inefficient and - # could be done much easier and faster in XS - - my ($scalar_desc, $array_desc, $hash_desc, $code_desc, $io_desc) = ( - { sigil => '$', type => 'SCALAR', name => $name }, - { sigil => '@', type => 'ARRAY', name => $name }, - { sigil => '%', type => 'HASH', name => $name }, - { sigil => '&', type => 'CODE', name => $name }, - { sigil => '', type => 'IO', name => $name }, - ); - - my ($scalar, $array, $hash, $code, $io); - if ($type eq 'SCALAR') { - $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); - $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); - $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); - $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); - } - elsif ($type eq 'ARRAY') { - $scalar = $self->get_package_symbol($scalar_desc); - $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); - $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); - $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); - } - elsif ($type eq 'HASH') { - $scalar = $self->get_package_symbol($scalar_desc); - $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); - $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); - $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); - } - elsif ($type eq 'CODE') { - $scalar = $self->get_package_symbol($scalar_desc); - $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); - $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); - $io = $self->get_package_symbol($io_desc) if $self->has_package_symbol($io_desc); - } - elsif ($type eq 'IO') { - $scalar = $self->get_package_symbol($scalar_desc); - $array = $self->get_package_symbol($array_desc) if $self->has_package_symbol($array_desc); - $hash = $self->get_package_symbol($hash_desc) if $self->has_package_symbol($hash_desc); - $code = $self->get_package_symbol($code_desc) if $self->has_package_symbol($code_desc); - } - else { - confess "This should never ever ever happen"; - } - - $self->remove_package_glob($name); - - $self->add_package_symbol($scalar_desc => $scalar); - $self->add_package_symbol($array_desc => $array) if defined $array; - $self->add_package_symbol($hash_desc => $hash) if defined $hash; - $self->add_package_symbol($code_desc => $code) if defined $code; - $self->add_package_symbol($io_desc => $io) if defined $io; -} - -=head2 list_all_package_symbols $type_filter - -Returns a list of package variable names in the package, without sigils. If a -C is passed, it is used to select package variables of a given -type, where valid types are the slots of a typeglob ('SCALAR', 'CODE', 'HASH', -etc). - -=cut - -sub list_all_package_symbols { - my ($self, $type_filter) = @_; - - my $namespace = $self->namespace; - return keys %{$namespace} unless defined $type_filter; - - # NOTE: - # or we can filter based on - # type (SCALAR|ARRAY|HASH|CODE) - if ($type_filter eq 'CODE') { - return grep { - (ref($namespace->{$_}) - ? (ref($namespace->{$_}) eq 'SCALAR') - : (ref(\$namespace->{$_}) eq 'GLOB' - && defined(*{$namespace->{$_}}{CODE}))); - } keys %{$namespace}; - } else { - return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace}; - } -} - -=head1 BUGS - -No known bugs. - -Please report any bugs through RT: email -C, or browse to -L. - -=head1 SEE ALSO - -L - this module is a factoring out of code that used to -live here - -=head1 SUPPORT - -You can find this documentation for this module with the perldoc command. - - perldoc Stash::Manip - -You can also look for information at: - -=over 4 - -=item * AnnoCPAN: Annotated CPAN documentation - -L - -=item * CPAN Ratings - -L - -=item * RT: CPAN's request tracker - -L - -=item * Search CPAN - -L - -=back - -=head1 AUTHOR - - Jesse Luehrs - -Mostly copied from code from L, by Stevan Little and the -Moose Cabal. - -=head1 COPYRIGHT AND LICENSE - -This software is copyright (c) 2010 by Jesse Luehrs. - -This is free software; you can redistribute it and/or modify it under -the same terms as perl itself. - -=cut - -1; diff --git a/t/000-load.t b/t/000-load.t index 5b9dc25..0420fe7 100644 --- a/t/000-load.t +++ b/t/000-load.t @@ -4,5 +4,5 @@ use warnings; use Test::More tests => 1; package Foo; -::use_ok('Stash::Manip') - or ::BAIL_OUT("couldn't load Stash::Manip"); +::use_ok('Package::Stash') + or ::BAIL_OUT("couldn't load Package::Stash"); diff --git a/t/001-basic.t b/t/001-basic.t index b3cecfb..efd82b4 100644 --- a/t/001-basic.t +++ b/t/001-basic.t @@ -4,9 +4,9 @@ use warnings; use Test::More; use Test::Exception; -use Stash::Manip; +use Package::Stash; -dies_ok { Stash::Manip->name } q{... can't call name() as a class method}; +dies_ok { Package::Stash->name } q{... can't call name() as a class method}; { package Foo; @@ -17,7 +17,7 @@ dies_ok { Stash::Manip->name } q{... can't call name() as a class method}; # ---------------------------------------------------------------------- ## tests adding a HASH -my $foo_stash = Stash::Manip->new('Foo'); +my $foo_stash = Package::Stash->new('Foo'); ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet'); ok(!$foo_stash->has_package_symbol('%foo'), '... the object agrees'); ok(!defined($Foo::{foo}), '... checking doesn\' vivify'); @@ -258,11 +258,11 @@ dies_ok { our %foo = (baz => 1); sub foo { } open *foo, '<', $0; - BEGIN { Stash::Manip->new(__PACKAGE__)->remove_package_symbol('&foo') } + BEGIN { Package::Stash->new(__PACKAGE__)->remove_package_symbol('&foo') } } { - my $stash = Stash::Manip->new('Baz'); + my $stash = Package::Stash->new('Baz'); is(${ $stash->get_package_symbol('$foo') }, 23, "got \$foo"); is_deeply($stash->get_package_symbol('@foo'), ['bar'], "got \@foo"); is_deeply($stash->get_package_symbol('%foo'), {baz => 1}, "got \%foo"); diff --git a/t/002-extension.t b/t/002-extension.t index 4a9e7c1..2f95f15 100644 --- a/t/002-extension.t +++ b/t/002-extension.t @@ -5,11 +5,11 @@ use Test::More; use Test::Exception; { - package My::Stash::Manip; + package My::Package::Stash; use strict; use warnings; - use base 'Stash::Manip'; + use base 'Package::Stash'; use Symbol 'gensym'; @@ -29,10 +29,10 @@ use Test::Exception; } # No actually package Foo exists :) -my $foo_stash = My::Stash::Manip->new('Foo'); +my $foo_stash = My::Package::Stash->new('Foo'); -isa_ok($foo_stash, 'My::Stash::Manip'); -isa_ok($foo_stash, 'Stash::Manip'); +isa_ok($foo_stash, 'My::Package::Stash'); +isa_ok($foo_stash, 'Package::Stash'); ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet'); ok(!$foo_stash->has_package_symbol('%foo'), '... the foo_stash agrees'); diff --git a/t/003-io.t b/t/003-io.t index a41b2ae..43a7dd8 100644 --- a/t/003-io.t +++ b/t/003-io.t @@ -18,10 +18,10 @@ use Test::Exception; sub bar { } } -use Stash::Manip; +use Package::Stash; { - my $stash = Stash::Manip->new('Foo'); + my $stash = Package::Stash->new('Foo'); ok($stash->has_package_symbol('&foo'), "has &foo"); ok($stash->has_package_symbol('foo'), "has foo"); $stash->remove_package_symbol('&foo'); @@ -30,7 +30,7 @@ use Stash::Manip; } { - my $stash = Stash::Manip->new('Bar'); + my $stash = Package::Stash->new('Bar'); ok($stash->has_package_symbol('&bar'), "has &bar"); ok($stash->has_package_symbol('bar'), "has bar"); $stash->remove_package_symbol('bar'); @@ -39,7 +39,7 @@ use Stash::Manip; } { - my $stash = Stash::Manip->new('Baz'); + my $stash = Package::Stash->new('Baz'); lives_ok { $stash->add_package_symbol('baz', *Foo::foo{IO}); } "can add an IO symbol"; diff --git a/t/004-get.t b/t/004-get.t index c38ae65..15e252f 100644 --- a/t/004-get.t +++ b/t/004-get.t @@ -3,10 +3,10 @@ use strict; use warnings; use Test::More; -use Stash::Manip; +use Package::Stash; { - my $stash = Stash::Manip->new('Foo'); + my $stash = Package::Stash->new('Foo'); my $val = $stash->get_package_symbol('%foo'); is(ref($val), 'HASH', "got something"); $val->{bar} = 1; @@ -15,7 +15,7 @@ use Stash::Manip; } { - my $stash = Stash::Manip->new('Bar'); + my $stash = Package::Stash->new('Bar'); my $val = $stash->get_package_symbol('@foo'); is(ref($val), 'ARRAY', "got something"); push @$val, 1; diff --git a/t/005-isa.t b/t/005-isa.t index d21c7a7..3198fb1 100644 --- a/t/005-isa.t +++ b/t/005-isa.t @@ -3,7 +3,7 @@ use strict; use warnings; use Test::More; -use Stash::Manip; +use Package::Stash; { package Foo; @@ -13,7 +13,7 @@ use Stash::Manip; package Bar; } -my $stash = Stash::Manip->new('Foo'); +my $stash = Package::Stash->new('Foo'); my @ISA = ('Bar'); @{$stash->get_package_symbol('@ISA')} = @ISA; isa_ok('Foo', 'Bar'); diff --git a/t/010-synopsis.t b/t/010-synopsis.t index 5d29573..4c93f32 100644 --- a/t/010-synopsis.t +++ b/t/010-synopsis.t @@ -3,9 +3,9 @@ use strict; use warnings; use Test::More; -use Stash::Manip; +use Package::Stash; -my $stash = Stash::Manip->new('Foo'); +my $stash = Package::Stash->new('Foo'); $stash->add_package_symbol('%foo', {bar => 1}); { no warnings 'once'; -- cgit v1.2.3-54-g00ecf