File | /usr/local/share/perl/5.10.0/namespace/clean.pm |
Statements Executed | 1130 |
Total Time | 0.00322249999999997 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
8 | 2 | 1 | 1.63ms | 1.63ms | __ANON__[:182] | namespace::clean::
7 | 1 | 1 | 116µs | 1.70ms | clean_subroutines | namespace::clean::
1 | 1 | 1 | 49µs | 254µs | import | namespace::clean::
1 | 1 | 1 | 47µs | 138µs | get_functions | namespace::clean::
1 | 1 | 1 | 19µs | 19µs | get_class_store | namespace::clean::
1 | 1 | 1 | 10µs | 58µs | __ANON__[:246] | namespace::clean::
0 | 0 | 0 | 0s | 0s | BEGIN | namespace::clean::
0 | 0 | 0 | 0s | 0s | __ANON__[:219] | namespace::clean::
0 | 0 | 0 | 0s | 0s | unimport | namespace::clean::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package namespace::clean; | |||
2 | ||||
3 | =head1 NAME | |||
4 | ||||
5 | namespace::clean - Keep imports and functions out of your namespace | |||
6 | ||||
7 | =cut | |||
8 | ||||
9 | 3 | 37µs | 12µs | use warnings; # spent 25µs making 1 call to warnings::import |
10 | 3 | 32µs | 11µs | use strict; # spent 11µs making 1 call to strict::import |
11 | ||||
12 | 3 | 33µs | 11µs | use vars qw( $VERSION $STORAGE_VAR $SCOPE_HOOK_KEY $SCOPE_EXPLICIT ); # spent 60µs making 1 call to vars::import |
13 | 3 | 135µs | 45µs | use Symbol qw( qualify_to_ref ); # spent 65µs making 1 call to Exporter::import |
14 | 3 | 144µs | 48µs | use B::Hooks::EndOfScope; # spent 343µs making 1 call to Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756] |
15 | ||||
16 | =head1 VERSION | |||
17 | ||||
18 | 0.11 | |||
19 | ||||
20 | =cut | |||
21 | ||||
22 | 1 | 700ns | 700ns | $VERSION = '0.11'; |
23 | 1 | 500ns | 500ns | $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE'; |
24 | ||||
25 | =head1 SYNOPSIS | |||
26 | ||||
27 | package Foo; | |||
28 | use warnings; | |||
29 | use strict; | |||
30 | ||||
31 | use Carp qw(croak); # 'croak' will be removed | |||
32 | ||||
33 | sub bar { 23 } # 'bar' will be removed | |||
34 | ||||
35 | # remove all previously defined functions | |||
36 | use namespace::clean; | |||
37 | ||||
38 | sub baz { bar() } # 'baz' still defined, 'bar' still bound | |||
39 | ||||
40 | # begin to collection function names from here again | |||
41 | no namespace::clean; | |||
42 | ||||
43 | sub quux { baz() } # 'quux' will be removed | |||
44 | ||||
45 | # remove all functions defined after the 'no' unimport | |||
46 | use namespace::clean; | |||
47 | ||||
48 | # Will print: 'No', 'No', 'Yes' and 'No' | |||
49 | print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n"; | |||
50 | print +(__PACKAGE__->can('bar') ? 'Yes' : 'No'), "\n"; | |||
51 | print +(__PACKAGE__->can('baz') ? 'Yes' : 'No'), "\n"; | |||
52 | print +(__PACKAGE__->can('quux') ? 'Yes' : 'No'), "\n"; | |||
53 | ||||
54 | 1; | |||
55 | ||||
56 | =head1 DESCRIPTION | |||
57 | ||||
58 | =head2 Keeping packages clean | |||
59 | ||||
60 | When you define a function, or import one, into a Perl package, it will | |||
61 | naturally also be available as a method. This does not per se cause | |||
62 | problems, but it can complicate subclassing and, for example, plugin | |||
63 | classes that are included via multiple inheritance by loading them as | |||
64 | base classes. | |||
65 | ||||
66 | The C<namespace::clean> pragma will remove all previously declared or | |||
67 | imported symbols at the end of the current package's compile cycle. | |||
68 | Functions called in the package itself will still be bound by their | |||
69 | name, but they won't show up as methods on your class or instances. | |||
70 | ||||
71 | By unimporting via C<no> you can tell C<namespace::clean> to start | |||
72 | collecting functions for the next C<use namespace::clean;> specification. | |||
73 | ||||
74 | You can use the C<-except> flag to tell C<namespace::clean> that you | |||
75 | don't want it to remove a certain function or method. A common use would | |||
76 | be a module exporting an C<import> method along with some functions: | |||
77 | ||||
78 | use ModuleExportingImport; | |||
79 | use namespace::clean -except => [qw( import )]; | |||
80 | ||||
81 | If you just want to C<-except> a single sub, you can pass it directly. | |||
82 | For more than one value you have to use an array reference. | |||
83 | ||||
84 | =head2 Explicitely removing functions when your scope is compiled | |||
85 | ||||
86 | It is also possible to explicitely tell C<namespace::clean> what packages | |||
87 | to remove when the surrounding scope has finished compiling. Here is an | |||
88 | example: | |||
89 | ||||
90 | package Foo; | |||
91 | use strict; | |||
92 | ||||
93 | # blessed NOT available | |||
94 | ||||
95 | sub my_class { | |||
96 | use Scalar::Util qw( blessed ); | |||
97 | use namespace::clean qw( blessed ); | |||
98 | ||||
99 | # blessed available | |||
100 | return blessed shift; | |||
101 | } | |||
102 | ||||
103 | # blessed NOT available | |||
104 | ||||
105 | =head2 Moose | |||
106 | ||||
107 | When using C<namespace::clean> together with L<Moose> you want to keep | |||
108 | the installed C<meta> method. So your classes should look like: | |||
109 | ||||
110 | package Foo; | |||
111 | use Moose; | |||
112 | use namespace::clean -except => 'meta'; | |||
113 | ... | |||
114 | ||||
115 | Same goes for L<Moose::Role>. | |||
116 | ||||
117 | =head2 Cleaning other packages | |||
118 | ||||
119 | You can tell C<namespace::clean> that you want to clean up another package | |||
120 | instead of the one importing. To do this you have to pass in the C<-cleanee> | |||
121 | option like this: | |||
122 | ||||
123 | package My::MooseX::namespace::clean; | |||
124 | use strict; | |||
125 | ||||
126 | use namespace::clean (); # no cleanup, just load | |||
127 | ||||
128 | sub import { | |||
129 | namespace::clean->import( | |||
130 | -cleanee => scalar(caller), | |||
131 | -except => 'meta', | |||
132 | ); | |||
133 | } | |||
134 | ||||
135 | If you don't care about C<namespace::clean>s discover-and-C<-except> logic, and | |||
136 | just want to remove subroutines, try L</clean_subroutines>. | |||
137 | ||||
138 | =head1 METHODS | |||
139 | ||||
140 | You shouldn't need to call any of these. Just C<use> the package at the | |||
141 | appropriate place. | |||
142 | ||||
143 | =cut | |||
144 | ||||
145 | =head2 clean_subroutines | |||
146 | ||||
147 | This exposes the actual subroutine-removal logic. | |||
148 | ||||
149 | namespace::clean->clean_subroutines($cleanee, qw( subA subB )); | |||
150 | ||||
151 | will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the | |||
152 | subroutines B<immediately> and not wait for scope end. If you want to have this | |||
153 | effect at a specific time (e.g. C<namespace::clean> acts on scope compile end) | |||
154 | it is your responsibility to make sure it runs at that time. | |||
155 | ||||
156 | =cut | |||
157 | ||||
158 | # spent 1.63ms within namespace::clean::__ANON__[/usr/local/share/perl/5.10.0/namespace/clean.pm:182] which was called 8 times, avg 204µs/call:
# 7 times (1.59ms+0s) by namespace::clean::clean_subroutines at line 186, avg 227µs/call
# once (49µs+0s) by namespace::clean::import or namespace::clean::__ANON__[/usr/local/share/perl/5.10.0/namespace/clean.pm:246] at line 245 | |||
159 | ||||
160 | 1047 | 1.60ms | 2µs | my $cleanee = shift; |
161 | my $store = shift; | |||
162 | SYMBOL: | |||
163 | for my $f (@_) { | |||
164 | ||||
165 | # ignore already removed symbols | |||
166 | next SYMBOL if $store->{exclude}{ $f }; | |||
167 | 3 | 30µs | 10µs | no strict 'refs'; # spent 23µs making 1 call to strict::unimport |
168 | ||||
169 | # keep original value to restore non-code slots | |||
170 | 3 | 666µs | 222µs | { no warnings 'uninitialized'; # fix possible unimports # spent 23µs making 1 call to warnings::unimport |
171 | local *__tmp = *{ ${ "${cleanee}::" }{ $f } }; | |||
172 | delete ${ "${cleanee}::" }{ $f }; | |||
173 | } | |||
174 | ||||
175 | SLOT: | |||
176 | # restore non-code slots to symbol | |||
177 | for my $t (qw( SCALAR ARRAY HASH IO FORMAT )) { | |||
178 | next SLOT unless defined *__tmp{ $t }; | |||
179 | *{ "${cleanee}::$f" } = *__tmp{ $t }; | |||
180 | } | |||
181 | } | |||
182 | 1 | 4µs | 4µs | }; |
183 | ||||
184 | # spent 1.70ms (116µs+1.59) within namespace::clean::clean_subroutines which was called 7 times, avg 243µs/call:
# 7 times (116µs+1.59ms) by namespace::autoclean::import or namespace::autoclean::__ANON__[/usr/local/share/perl/5.10.0/namespace/autoclean.pm:57] at line 56 of /usr/local/share/perl/5.10.0/namespace/autoclean.pm, avg 243µs/call | |||
185 | 14 | 114µs | 8µs | my ($nc, $cleanee, @subs) = @_; |
186 | $RemoveSubs->($cleanee, {}, @subs); # spent 1.59ms making 7 calls to namespace::clean::__ANON__[/usr/local/share/perl/5.10.0/namespace/clean.pm:182], avg 227µs/call | |||
187 | } | |||
188 | ||||
189 | =head2 import | |||
190 | ||||
191 | Makes a snapshot of the current defined functions and installs a | |||
192 | L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups. | |||
193 | ||||
194 | =cut | |||
195 | ||||
196 | # spent 254µs (49+205) within namespace::clean::import which was called
# once (49µs+205µs) by namespace::autoclean::BEGIN at line 16 of /usr/local/share/perl/5.10.0/namespace/autoclean.pm | |||
197 | 19 | 66µs | 3µs | my ($pragma, @args) = @_; |
198 | ||||
199 | my (%args, $is_explicit); | |||
200 | ||||
201 | ARG: | |||
202 | while (@args) { | |||
203 | ||||
204 | if ($args[0] =~ /^\-/) { | |||
205 | my $key = shift @args; | |||
206 | my $value = shift @args; | |||
207 | $args{ $key } = $value; | |||
208 | } | |||
209 | else { | |||
210 | $is_explicit++; | |||
211 | last ARG; | |||
212 | } | |||
213 | } | |||
214 | ||||
215 | my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller; | |||
216 | if ($is_explicit) { | |||
217 | on_scope_end { | |||
218 | $RemoveSubs->($cleanee, {}, @args); | |||
219 | }; | |||
220 | } | |||
221 | else { | |||
222 | ||||
223 | # calling class, all current functions and our storage | |||
224 | my $functions = $pragma->get_functions($cleanee); # spent 138µs making 1 call to namespace::clean::get_functions | |||
225 | my $store = $pragma->get_class_store($cleanee); # spent 19µs making 1 call to namespace::clean::get_class_store | |||
226 | ||||
227 | # except parameter can be array ref or single value | |||
228 | my %except = map {( $_ => 1 )} ( | |||
229 | $args{ -except } | |||
230 | ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } ) | |||
231 | : () | |||
232 | ); | |||
233 | ||||
234 | # register symbols for removal, if they have a CODE entry | |||
235 | for my $f (keys %$functions) { | |||
236 | next if $except{ $f }; | |||
237 | next unless $functions->{ $f } | |||
238 | and *{ $functions->{ $f } }{CODE}; | |||
239 | $store->{remove}{ $f } = 1; | |||
240 | } | |||
241 | ||||
242 | # register EOF handler on first call to import | |||
243 | unless ($store->{handler_is_installed}) { | |||
244 | # spent 58µs (10+49) within namespace::clean::__ANON__[/usr/local/share/perl/5.10.0/namespace/clean.pm:246] which was called
# once (10µs+49µs) by B::Hooks::EndOfScope::__ANON__[/usr/local/share/perl/5.10.0/B/Hooks/EndOfScope.pm:47] at line 47 of /usr/local/share/perl/5.10.0/B/Hooks/EndOfScope.pm | |||
245 | 1 | 8µs | 8µs | $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} }); # spent 49µs making 1 call to namespace::clean::__ANON__[/usr/local/share/perl/5.10.0/namespace/clean.pm:182] |
246 | }; # spent 48µs making 1 call to B::Hooks::EndOfScope::on_scope_end | |||
247 | $store->{handler_is_installed} = 1; | |||
248 | } | |||
249 | ||||
250 | return 1; | |||
251 | } | |||
252 | } | |||
253 | ||||
254 | =head2 unimport | |||
255 | ||||
256 | This method will be called when you do a | |||
257 | ||||
258 | no namespace::clean; | |||
259 | ||||
260 | It will start a new section of code that defines functions to clean up. | |||
261 | ||||
262 | =cut | |||
263 | ||||
264 | sub unimport { | |||
265 | my ($pragma, %args) = @_; | |||
266 | ||||
267 | # the calling class, the current functions and our storage | |||
268 | my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller; | |||
269 | my $functions = $pragma->get_functions($cleanee); | |||
270 | my $store = $pragma->get_class_store($cleanee); | |||
271 | ||||
272 | # register all unknown previous functions as excluded | |||
273 | for my $f (keys %$functions) { | |||
274 | next if $store->{remove}{ $f } | |||
275 | or $store->{exclude}{ $f }; | |||
276 | $store->{exclude}{ $f } = 1; | |||
277 | } | |||
278 | ||||
279 | return 1; | |||
280 | } | |||
281 | ||||
282 | =head2 get_class_store | |||
283 | ||||
284 | This returns a reference to a hash in a passed package containing | |||
285 | information about function names included and excluded from removal. | |||
286 | ||||
287 | =cut | |||
288 | ||||
289 | # spent 19µs within namespace::clean::get_class_store which was called
# once (19µs+0s) by namespace::clean::import at line 225 | |||
290 | 2 | 13µs | 6µs | my ($pragma, $class) = @_; |
291 | 3 | 150µs | 50µs | no strict 'refs'; # spent 20µs making 1 call to strict::unimport |
292 | return \%{ "${class}::${STORAGE_VAR}" }; | |||
293 | } | |||
294 | ||||
295 | =head2 get_functions | |||
296 | ||||
297 | Takes a class as argument and returns all currently defined functions | |||
298 | in it as a hash reference with the function name as key and a typeglob | |||
299 | reference to the symbol as value. | |||
300 | ||||
301 | =cut | |||
302 | ||||
303 | # spent 138µs (47+91) within namespace::clean::get_functions which was called
# once (47µs+91µs) by namespace::clean::import at line 224 | |||
304 | 13 | 57µs | 4µs | my ($pragma, $class) = @_; |
305 | ||||
306 | return { | |||
307 | map { @$_ } # key => value | |||
308 | grep { *{ $_->[1] }{CODE} } # only functions # spent 91µs making 5 calls to Symbol::qualify_to_ref, avg 18µs/call | |||
309 | map { [$_, qualify_to_ref( $_, $class )] } # get globref | |||
310 | grep { $_ !~ /::$/ } # no packages | |||
311 | 3 | 91µs | 30µs | do { no strict 'refs'; keys %{ "${class}::" } } # symbol entries # spent 21µs making 1 call to strict::unimport |
312 | }; | |||
313 | } | |||
314 | ||||
315 | =head1 IMPLEMENTATION DETAILS | |||
316 | ||||
317 | This module works through the effect that a | |||
318 | ||||
319 | delete $SomePackage::{foo}; | |||
320 | ||||
321 | will remove the C<foo> symbol from C<$SomePackage> for run time lookups | |||
322 | (e.g., method calls) but will leave the entry alive to be called by | |||
323 | already resolved names in the package itself. C<namespace::clean> will | |||
324 | restore and therefor in effect keep all glob slots that aren't C<CODE>. | |||
325 | ||||
326 | A test file has been added to the perl core to ensure that this behaviour | |||
327 | will be stable in future releases. | |||
328 | ||||
329 | Just for completeness sake, if you want to remove the symbol completely, | |||
330 | use C<undef> instead. | |||
331 | ||||
332 | =head1 SEE ALSO | |||
333 | ||||
334 | L<B::Hooks::EndOfScope> | |||
335 | ||||
336 | =head1 AUTHOR AND COPYRIGHT | |||
337 | ||||
338 | Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to | |||
339 | Matt S Trout for the inspiration on the whole idea. | |||
340 | ||||
341 | =head1 LICENSE | |||
342 | ||||
343 | This program is free software; you can redistribute it and/or modify | |||
344 | it under the same terms as perl itself. | |||
345 | ||||
346 | =cut | |||
347 | ||||
348 | 3 | 34µs | 11µs | no warnings; # spent 26µs making 1 call to warnings::unimport |
349 | 1 | 5µs | 5µs | 'Danger! Laws of Thermodynamics may not apply.' |