lib/Package/Stash.pm

   1 package Package::Stash;
   2 use strict;
   3 use warnings;
   4 # ABSTRACT: routines for manipulating stashes
   5
   6 our $IMPLEMENTATION;
   7
   8 BEGIN {
   9     #warn "loading Package::Stash";
  10     $IMPLEMENTATION = $ENV{PACKAGE_STASH_IMPLEMENTATION}
  11         if exists $ENV{PACKAGE_STASH_IMPLEMENTATION};
  12     #warn "found $IMPLEMENTATION" if $IMPLEMENTATION;
  13
  14     if (!$IMPLEMENTATION) {
  15         #warn "detecting...";
  16         for my $impl ('XS', 'PP') {
  17             if (eval "require Package::Stash::$impl; 1;") {
  18                 #warn "found $impl";
  19                 $IMPLEMENTATION = $impl;
  20                 last;
  21             }
  22         }
  23     }
  24
  25     if (!$IMPLEMENTATION) {
  26         require Carp;
  27         Carp::croak("Could not find a suitable Package::Stash implementation");
  28     }
  29
  30     my $impl = "Package::Stash::$IMPLEMENTATION";
  31     my $from = $impl->new($impl);
  32     my $to = $impl->new(__PACKAGE__);
  33     my $methods = $from->get_all_symbols('CODE');
  34     for my $meth (keys %$methods) {
  35         #warn "installing $meth";
  36         $to->add_symbol("&$meth" => $methods->{$meth});
  37     }
  38 }
  39
  40 use Package::DeprecationManager -deprecations => {
  41     'Package::Stash::add_package_symbol'        => 0.14,
  42     'Package::Stash::remove_package_glob'       => 0.14,
  43     'Package::Stash::has_package_symbol'        => 0.14,
  44     'Package::Stash::get_package_symbol'        => 0.14,
  45     'Package::Stash::get_or_add_package_symbol' => 0.14,
  46     'Package::Stash::remove_package_symbol'     => 0.14,
  47     'Package::Stash::list_all_package_symbols'  => 0.14,
  48 };
  49
  50 sub add_package_symbol {
  51     deprecated('add_package_symbol is deprecated, please use add_symbol');
  52     shift->add_symbol(@_);
  53 }
  54
  55 sub remove_package_glob {
  56     deprecated('remove_package_glob is deprecated, please use remove_glob');
  57     shift->remove_glob(@_);
  58 }
  59
  60 sub has_package_symbol {
  61     deprecated('has_package_symbol is deprecated, please use has_symbol');
  62     shift->has_symbol(@_);
  63 }
  64
  65 sub get_package_symbol {
  66     deprecated('get_package_symbol is deprecated, please use get_symbol');
  67     shift->get_symbol(@_);
  68 }
  69
  70 sub get_or_add_package_symbol {
  71     deprecated('get_or_add_package_symbol is deprecated, please use get_or_add_symbol');
  72     shift->get_or_add_symbol(@_);
  73 }
  74
  75 sub remove_package_symbol {
  76     deprecated('remove_package_symbol is deprecated, please use remove_symbol');
  77     shift->remove_symbol(@_);
  78 }
  79
  80 sub list_all_package_symbols {
  81     deprecated('list_all_package_symbols is deprecated, please use list_all_symbols');
  82     shift->list_all_symbols(@_);
  83 }
  84
  85 =head1 SYNOPSIS
  86
  87   my $stash = Package::Stash->new('Foo');
  88   $stash->add_symbol('%foo', {bar => 1});
  89   # $Foo::foo{bar} == 1
  90   $stash->has_symbol('$foo') # false
  91   my $namespace = $stash->namespace;
  92   *{ $namespace->{foo} }{HASH} # {bar => 1}
  93
  94 =head1 DESCRIPTION
  95
  96 Manipulating stashes (Perl's symbol tables) is occasionally necessary, but
  97 incredibly messy, and easy to get wrong. This module hides all of that behind a
  98 simple API.
  99
 100 NOTE: Most methods in this class require a variable specification that includes
 101 a sigil. If this sigil is absent, it is assumed to represent the IO slot.
 102
 103 Due to limitations in the typeglob API available to perl code, and to typeglob
 104 manipulation in perl being quite slow, this module provides two
 105 implementations - one in pure perl, and one using XS. The XS implementation is
 106 to be preferred for most usages; the pure perl one is provided for cases where
 107 XS modules are not a possibility. The current implementation in use can be set
 108 by setting C<$ENV{PACKAGE_STASH_IMPLEMENTATION}> or
 109 C<$Package::Stash::IMPLEMENTATION> before loading Package::Stash (with the
 110 environment variable taking precedence), otherwise, it will use the XS
 111 implementation if possible, falling back to the pure perl one.
 112
 113 =method new $package_name
 114
 115 Creates a new C<Package::Stash> object, for the package given as the only
 116 argument.
 117
 118 =method name
 119
 120 Returns the name of the package that this object represents.
 121
 122 =method namespace
 123
 124 Returns the raw stash itself.
 125
 126 =method add_symbol $variable $value %opts
 127
 128 Adds a new package symbol, for the symbol given as C<$variable>, and optionally
 129 gives it an initial value of C<$value>. C<$variable> should be the name of
 130 variable including the sigil, so
 131
 132   Package::Stash->new('Foo')->add_symbol('%foo')
 133
 134 will create C<%Foo::foo>.
 135
 136 Valid options (all optional) are C<filename>, C<first_line_num>, and
 137 C<last_line_num>.
 138
 139 C<$opts{filename}>, C<$opts{first_line_num}>, and C<$opts{last_line_num}> can
 140 be used to indicate where the symbol should be regarded as having been defined.
 141 Currently these values are only used if the symbol is a subroutine ('C<&>'
 142 sigil) and only if C<$^P & 0x10> is true, in which case the special C<%DB::sub>
 143 hash is updated to record the values of C<filename>, C<first_line_num>, and
 144 C<last_line_num> for the subroutine. If these are not passed, their values are
 145 inferred (as much as possible) from C<caller> information.
 146
 147 This is especially useful for debuggers and profilers, which use C<%DB::sub> to
 148 determine where the source code for a subroutine can be found.  See
 149 L<http://perldoc.perl.org/perldebguts.html#Debugger-Internals> for more
 150 information about C<%DB::sub>.
 151
 152 =method remove_glob $name
 153
 154 Removes all package variables with the given name, regardless of sigil.
 155
 156 =method has_symbol $variable
 157
 158 Returns whether or not the given package variable (including sigil) exists.
 159
 160 =method get_symbol $variable
 161
 162 Returns the value of the given package variable (including sigil).
 163
 164 =method get_or_add_symbol $variable
 165
 166 Like C<get_symbol>, except that it will return an empty hashref or
 167 arrayref if the variable doesn't exist.
 168
 169 =method remove_symbol $variable
 170
 171 Removes the package variable described by C<$variable> (which includes the
 172 sigil); other variables with the same name but different sigils will be
 173 untouched.
 174
 175 =method list_all_symbols $type_filter
 176
 177 Returns a list of package variable names in the package, without sigils. If a
 178 C<type_filter> is passed, it is used to select package variables of a given
 179 type, where valid types are the slots of a typeglob ('SCALAR', 'CODE', 'HASH',
 180 etc). Note that if the package contained any C<BEGIN> blocks, perl will leave
 181 an empty typeglob in the C<BEGIN> slot, so this will show up if no filter is
 182 used (and similarly for C<INIT>, C<END>, etc).
 183
 184 =method get_all_symbols $type_filter
 185
 186 Returns a hashref, keyed by the variable names in the package. If
 187 C<$type_filter> is passed, the hash will contain every variable of that type in
 188 the package as values, otherwise, it will contain the typeglobs corresponding
 189 to the variable names (basically, a clone of the stash).
 190
 191 =head1 BUGS / CAVEATS
 192
 193 =over 4
 194
 195 =item * GLOB and FORMAT variables are not (yet) accessible through this module.
 196
 197 =item * Also, see the BUGS section for the specific backends (L<Package::Stash::XS> and L<Package::Stash::PP>)
 198
 199 =back
 200
 201 Please report any bugs through RT: email
 202 C<bug-package-stash at rt.cpan.org>, or browse to
 203 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Package-Stash>.
 204
 205 =head1 SEE ALSO
 206
 207 =over 4
 208
 209 =item * L<Class::MOP::Package>
 210
 211 This module is a factoring out of code that used to live here
 212
 213 =back
 214
 215 =head1 SUPPORT
 216
 217 You can find this documentation for this module with the perldoc command.
 218
 219     perldoc Package::Stash
 220
 221 You can also look for information at:
 222
 223 =over 4
 224
 225 =item * AnnoCPAN: Annotated CPAN documentation
 226
 227 L<http://annocpan.org/dist/Package-Stash>
 228
 229 =item * CPAN Ratings
 230
 231 L<http://cpanratings.perl.org/d/Package-Stash>
 232
 233 =item * RT: CPAN's request tracker
 234
 235 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Package-Stash>
 236
 237 =item * Search CPAN
 238
 239 L<http://search.cpan.org/dist/Package-Stash>
 240
 241 =back
 242
 243 =head1 AUTHOR
 244
 245 Jesse Luehrs <doy at tozt dot net>
 246
 247 Based on code from L<Class::MOP::Package>, by Stevan Little and the Moose
 248 Cabal.
 249
 250 =begin Pod::Coverage
 251
 252 add_package_symbol
 253 remove_package_glob
 254 has_package_symbol
 255 get_package_symbol
 256 get_or_add_package_symbol
 257 remove_package_symbol
 258 list_all_package_symbols
 259
 260 =end Pod::Coverage
 261
 262 =cut
 263
 264 1;