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