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 { |
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; |