← Index
NYTProf Performance Profile   « line view »
For examples/Atom-timer.pl
  Run on Mon Aug 12 14:45:28 2013
Reported on Mon Aug 12 14:46:15 2013

Filename/Users/dde/perl5/perlbrew/perls/5.18.0t/lib/site_perl/5.18.0/namespace/clean.pm
StatementsExecuted 354 statements in 1.78ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
221265µs520µsnamespace::clean::::__ANON__[:252]namespace::clean::__ANON__[:252]
11138µs149µsnamespace::clean::::importnamespace::clean::import
11117µs39µsnamespace::clean::::get_functionsnamespace::clean::get_functions
11113µs32µsnamespace::clean::::get_class_storenamespace::clean::get_class_store
11111µs15µsnamespace::clean::::BEGIN@3namespace::clean::BEGIN@3
1119µs30µsnamespace::clean::::BEGIN@147namespace::clean::BEGIN@147
1119µs20µsnamespace::clean::::BEGIN@445namespace::clean::BEGIN@445
1119µs56µsnamespace::clean::::BEGIN@11namespace::clean::BEGIN@11
1117µs39µsnamespace::clean::::BEGIN@146namespace::clean::BEGIN@146
1116µs432µsnamespace::clean::::clean_subroutinesnamespace::clean::clean_subroutines
1116µs17µsnamespace::clean::::BEGIN@149namespace::clean::BEGIN@149
1115µs99µsnamespace::clean::::__ANON__[:316]namespace::clean::__ANON__[:316]
1115µs15µsnamespace::clean::::BEGIN@4namespace::clean::BEGIN@4
1113µs3µsnamespace::clean::::BEGIN@6namespace::clean::BEGIN@6
0000s0snamespace::clean::::__ANON__[:199]namespace::clean::__ANON__[:199]
0000s0snamespace::clean::::__ANON__[:289]namespace::clean::__ANON__[:289]
0000s0snamespace::clean::::unimportnamespace::clean::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package namespace::clean;
2
3220µs218µs
# spent 15µs (11+4) within namespace::clean::BEGIN@3 which was called: # once (11µs+4µs) by namespace::autoclean::BEGIN@16 at line 3
use warnings;
# spent 15µs making 1 call to namespace::clean::BEGIN@3 # spent 4µs making 1 call to warnings::import
4222µs224µs
# spent 15µs (5+10) within namespace::clean::BEGIN@4 which was called: # once (5µs+10µs) by namespace::autoclean::BEGIN@16 at line 4
use strict;
# spent 15µs making 1 call to namespace::clean::BEGIN@4 # spent 10µs making 1 call to strict::import
5
6234µs13µs
# spent 3µs within namespace::clean::BEGIN@6 which was called: # once (3µs+0s) by namespace::autoclean::BEGIN@16 at line 6
use Package::Stash;
# spent 3µs making 1 call to namespace::clean::BEGIN@6
7
81400nsour $VERSION = '0.24';
91100nsour $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
10
112108µs278µs
# spent 56µs (9+47) within namespace::clean::BEGIN@11 which was called: # once (9µs+47µs) by namespace::autoclean::BEGIN@16 at line 11
use B::Hooks::EndOfScope 'on_scope_end';
# spent 56µs making 1 call to namespace::clean::BEGIN@11 # spent 23µs making 1 call to Sub::Exporter::Progressive::__ANON__[Sub/Exporter/Progressive.pm:40]
12
13=head1 NAME
14
15namespace::clean - Keep imports and functions out of your namespace
16
17=head1 SYNOPSIS
18
19 package Foo;
20 use warnings;
21 use strict;
22
23 use Carp qw(croak); # 'croak' will be removed
24
25 sub bar { 23 } # 'bar' will be removed
26
27 # remove all previously defined functions
28 use namespace::clean;
29
30 sub baz { bar() } # 'baz' still defined, 'bar' still bound
31
32 # begin to collection function names from here again
33 no namespace::clean;
34
35 sub quux { baz() } # 'quux' will be removed
36
37 # remove all functions defined after the 'no' unimport
38 use namespace::clean;
39
40 # Will print: 'No', 'No', 'Yes' and 'No'
41 print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n";
42 print +(__PACKAGE__->can('bar') ? 'Yes' : 'No'), "\n";
43 print +(__PACKAGE__->can('baz') ? 'Yes' : 'No'), "\n";
44 print +(__PACKAGE__->can('quux') ? 'Yes' : 'No'), "\n";
45
46 1;
47
48=head1 DESCRIPTION
49
50=head2 Keeping packages clean
51
52When you define a function, or import one, into a Perl package, it will
53naturally also be available as a method. This does not per se cause
54problems, but it can complicate subclassing and, for example, plugin
55classes that are included via multiple inheritance by loading them as
56base classes.
57
58The C<namespace::clean> pragma will remove all previously declared or
59imported symbols at the end of the current package's compile cycle.
60Functions called in the package itself will still be bound by their
61name, but they won't show up as methods on your class or instances.
62
63By unimporting via C<no> you can tell C<namespace::clean> to start
64collecting functions for the next C<use namespace::clean;> specification.
65
66You can use the C<-except> flag to tell C<namespace::clean> that you
67don't want it to remove a certain function or method. A common use would
68be a module exporting an C<import> method along with some functions:
69
70 use ModuleExportingImport;
71 use namespace::clean -except => [qw( import )];
72
73If you just want to C<-except> a single sub, you can pass it directly.
74For more than one value you have to use an array reference.
75
76=head2 Explicitly removing functions when your scope is compiled
77
78It is also possible to explicitly tell C<namespace::clean> what packages
79to remove when the surrounding scope has finished compiling. Here is an
80example:
81
82 package Foo;
83 use strict;
84
85 # blessed NOT available
86
87 sub my_class {
88 use Scalar::Util qw( blessed );
89 use namespace::clean qw( blessed );
90
91 # blessed available
92 return blessed shift;
93 }
94
95 # blessed NOT available
96
97=head2 Moose
98
99When using C<namespace::clean> together with L<Moose> you want to keep
100the installed C<meta> method. So your classes should look like:
101
102 package Foo;
103 use Moose;
104 use namespace::clean -except => 'meta';
105 ...
106
107Same goes for L<Moose::Role>.
108
109=head2 Cleaning other packages
110
111You can tell C<namespace::clean> that you want to clean up another package
112instead of the one importing. To do this you have to pass in the C<-cleanee>
113option like this:
114
115 package My::MooseX::namespace::clean;
116 use strict;
117
118 use namespace::clean (); # no cleanup, just load
119
120 sub import {
121 namespace::clean->import(
122 -cleanee => scalar(caller),
123 -except => 'meta',
124 );
125 }
126
127If you don't care about C<namespace::clean>s discover-and-C<-except> logic, and
128just want to remove subroutines, try L</clean_subroutines>.
129
130=head1 METHODS
131
132=head2 clean_subroutines
133
134This exposes the actual subroutine-removal logic.
135
136 namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
137
138will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
139subroutines B<immediately> and not wait for scope end. If you want to have this
140effect at a specific time (e.g. C<namespace::clean> acts on scope compile end)
141it is your responsibility to make sure it runs at that time.
142
143=cut
144
145# Constant to optimise away the unused code branches
146232µs270µs
# spent 39µs (7+31) within namespace::clean::BEGIN@146 which was called: # once (7µs+31µs) by namespace::autoclean::BEGIN@16 at line 146
use constant FIXUP_NEEDED => $] < 5.015_005_1;
# spent 39µs making 1 call to namespace::clean::BEGIN@146 # spent 31µs making 1 call to constant::import
147223µs252µs
# spent 30µs (9+21) within namespace::clean::BEGIN@147 which was called: # once (9µs+21µs) by namespace::autoclean::BEGIN@16 at line 147
use constant FIXUP_RENAME_SUB => $] > 5.008_008_9 && $] < 5.013_005_1;
# spent 30µs making 1 call to namespace::clean::BEGIN@147 # spent 21µs making 1 call to constant::import
148{
1493894µs228µs
# spent 17µs (6+11) within namespace::clean::BEGIN@149 which was called: # once (6µs+11µs) by namespace::autoclean::BEGIN@16 at line 149
no strict;
# spent 17µs making 1 call to namespace::clean::BEGIN@149 # spent 11µs making 1 call to strict::unimport
15011µs delete ${__PACKAGE__."::"}{FIXUP_NEEDED};
1511800ns delete ${__PACKAGE__."::"}{FIXUP_RENAME_SUB};
152}
153
154# Debugger fixup necessary before perl 5.15.5
155#
156# In perl 5.8.9-5.12, it assumes that sub_fullname($sub) can
157# always be used to find the CV again.
158# In perl 5.8.8 and 5.14, it assumes that the name of the glob
159# passed to entersub can be used to find the CV.
160# since we are deleting the glob where the subroutine was originally
161# defined, those assumptions no longer hold.
162#
163# So in 5.8.9-5.12 we need to move it elsewhere and point the
164# CV's name to the new glob.
165#
166# In 5.8.8 and 5.14 we move it elsewhere and rename the
167# original glob by assigning the new glob back to it.
16810smy $sub_utils_loaded;
169my $DebuggerFixup = sub {
170 my ($f, $sub, $cleanee_stash, $deleted_stash) = @_;
171
172 if (FIXUP_RENAME_SUB) {
173 if (! defined $sub_utils_loaded ) {
174 $sub_utils_loaded = do {
175
176 # when changing version also change in Makefile.PL
177 my $sn_ver = 0.04;
178 eval { require Sub::Name; Sub::Name->VERSION($sn_ver) }
179 or die "Sub::Name $sn_ver required when running under -d or equivalent: $@";
180
181 # when changing version also change in Makefile.PL
182 my $si_ver = 0.04;
183 eval { require Sub::Identify; Sub::Identify->VERSION($si_ver) }
184 or die "Sub::Identify $si_ver required when running under -d or equivalent: $@";
185
186 1;
187 } ? 1 : 0;
188 }
189
190 if ( Sub::Identify::sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) {
191 my $new_fq = $deleted_stash->name . "::$f";
192 Sub::Name::subname($new_fq, $sub);
193 $deleted_stash->add_symbol("&$f", $sub);
194 }
195 }
196 else {
197 $deleted_stash->add_symbol("&$f", $sub);
198 }
19912µs};
200
201
# spent 520µs (265+254) within namespace::clean::__ANON__[/Users/dde/perl5/perlbrew/perls/5.18.0t/lib/site_perl/5.18.0/namespace/clean.pm:252] which was called 2 times, avg 260µs/call: # once (217µs+209µs) by namespace::clean::clean_subroutines at line 256 # once (48µs+45µs) by namespace::clean::__ANON__[/Users/dde/perl5/perlbrew/perls/5.18.0t/lib/site_perl/5.18.0/namespace/clean.pm:316] at line 315
my $RemoveSubs = sub {
2022600ns my $cleanee = shift;
2032200ns my $store = shift;
204216µs28µs my $cleanee_stash = Package::Stash->new($cleanee);
# spent 8µs making 2 calls to Package::Stash::XS::new, avg 4µs/call
2052200ns my $deleted_stash;
206
207 SYMBOL:
20828µs for my $f (@_) {
209
210 # ignore already removed symbols
211164µs next SYMBOL if $store->{exclude}{ $f };
212
2131682µs3467µs my $sub = $cleanee_stash->get_symbol("&$f")
# spent 53µs making 16 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 13µs making 16 calls to Package::Stash::XS::namespace, avg 812ns/call # spent 1µs making 2 calls to Package::Stash::XS::name, avg 500ns/call
214 or next SYMBOL;
215
216162µs my $need_debugger_fixup =
217 FIXUP_NEEDED
218 &&
219 $^P
220 &&
221 ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB'
222 ;
223
224 if (FIXUP_NEEDED && $need_debugger_fixup) {
225 # convince the Perl debugger to work
226 # see the comment on top of $DebuggerFixup
227 $DebuggerFixup->(
228 $f,
229 $sub,
230 $cleanee_stash,
231 $deleted_stash ||= Package::Stash->new("namespace::clean::deleted::$cleanee"),
232 );
233 }
234
235648µs my @symbols = map {
2361613µs my $name = $_ . $f;
23764240µs128170µs my $def = $cleanee_stash->get_symbol($name);
# spent 150µs making 64 calls to Package::Stash::XS::get_symbol, avg 2µs/call # spent 20µs making 64 calls to Package::Stash::XS::namespace, avg 305ns/call
2386411µs defined($def) ? [$name, $def] : ()
239 } '$', '@', '%', '';
240
2411670µs3248µs $cleanee_stash->remove_glob($f);
# spent 43µs making 16 calls to Package::Stash::XS::remove_glob, avg 3µs/call # spent 5µs making 16 calls to Package::Stash::XS::namespace, avg 306ns/call
242
243 # if this perl needs no renaming trick we need to
244 # rename the original glob after the fact
245 # (see commend of $DebuggerFixup
246 if (FIXUP_NEEDED && !FIXUP_RENAME_SUB && $need_debugger_fixup) {
247 *$globref = $deleted_stash->namespace->{$f};
248 }
249
2501621µs $cleanee_stash->add_symbol(@$_) for @symbols;
251 }
25212µs};
253
254
# spent 432µs (6+426) within namespace::clean::clean_subroutines which was called: # once (6µs+426µs) by namespace::autoclean::__ANON__[/Users/dde/perl5/perlbrew/perls/5.18.0t/lib/site_perl/5.18.0/namespace/autoclean.pm:57] at line 56 of namespace/autoclean.pm
sub clean_subroutines {
25511µs my ($nc, $cleanee, @subs) = @_;
25615µs1426µs $RemoveSubs->($cleanee, {}, @subs);
# spent 426µs making 1 call to namespace::clean::__ANON__[namespace/clean.pm:252]
257}
258
259=head2 import
260
261Makes a snapshot of the current defined functions and installs a
262L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
263
264=cut
265
266
# spent 149µs (38+111) within namespace::clean::import which was called: # once (38µs+111µs) by namespace::autoclean::BEGIN@16 at line 16 of namespace/autoclean.pm
sub import {
2671600ns my ($pragma, @args) = @_;
268
26910s my (%args, $is_explicit);
270
271 ARG:
2721400ns while (@args) {
273
274 if ($args[0] =~ /^\-/) {
275 my $key = shift @args;
276 my $value = shift @args;
277 $args{ $key } = $value;
278 }
279 else {
280 $is_explicit++;
281 last ARG;
282 }
283 }
284
28511µs my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
2861100ns if ($is_explicit) {
287 on_scope_end {
288 $RemoveSubs->($cleanee, {}, @args);
289 };
290 }
291 else {
292
293 # calling class, all current functions and our storage
29412µs139µs my $functions = $pragma->get_functions($cleanee);
# spent 39µs making 1 call to namespace::clean::get_functions
29512µs132µs my $store = $pragma->get_class_store($cleanee);
# spent 32µs making 1 call to namespace::clean::get_class_store
29615µs13µs my $stash = Package::Stash->new($cleanee);
# spent 3µs making 1 call to Package::Stash::XS::new
297
298 # except parameter can be array ref or single value
299 my %except = map {( $_ => 1 )} (
300 $args{ -except }
301 ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } )
30211µs : ()
303 );
304
305 # register symbols for removal, if they have a CODE entry
30611µs for my $f (keys %$functions) {
3072300ns next if $except{ $f };
308214µs515µs next unless $stash->has_symbol("&$f");
# spent 10µs making 2 calls to Package::Stash::XS::has_symbol, avg 5µs/call # spent 4µs making 2 calls to Package::Stash::XS::namespace, avg 2µs/call # spent 400ns making 1 call to Package::Stash::XS::name
30925µs $store->{remove}{ $f } = 1;
310 }
311
312 # register EOF handler on first call to import
3131200ns unless ($store->{handler_is_installed}) {
314
# spent 99µs (5+94) within namespace::clean::__ANON__[/Users/dde/perl5/perlbrew/perls/5.18.0t/lib/site_perl/5.18.0/namespace/clean.pm:316] which was called: # once (5µs+94µs) by B::Hooks::EndOfScope::XS::__ANON__[/Users/dde/perl5/perlbrew/perls/5.18.0t/lib/site_perl/5.18.0/B/Hooks/EndOfScope/XS.pm:26] at line 26 of B/Hooks/EndOfScope/XS.pm
on_scope_end {
31515µs194µs $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} });
# spent 94µs making 1 call to namespace::clean::__ANON__[namespace/clean.pm:252]
31615µs127µs };
# spent 27µs making 1 call to B::Hooks::EndOfScope::XS::on_scope_end
3171400ns $store->{handler_is_installed} = 1;
318 }
319
32014µs return 1;
321 }
322}
323
324=head2 unimport
325
326This method will be called when you do a
327
328 no namespace::clean;
329
330It will start a new section of code that defines functions to clean up.
331
332=cut
333
334sub unimport {
335 my ($pragma, %args) = @_;
336
337 # the calling class, the current functions and our storage
338 my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
339 my $functions = $pragma->get_functions($cleanee);
340 my $store = $pragma->get_class_store($cleanee);
341
342 # register all unknown previous functions as excluded
343 for my $f (keys %$functions) {
344 next if $store->{remove}{ $f }
345 or $store->{exclude}{ $f };
346 $store->{exclude}{ $f } = 1;
347 }
348
349 return 1;
350}
351
352=head2 get_class_store
353
354This returns a reference to a hash in a passed package containing
355information about function names included and excluded from removal.
356
357=cut
358
359
# spent 32µs (13+19) within namespace::clean::get_class_store which was called: # once (13µs+19µs) by namespace::clean::import at line 295
sub get_class_store {
3601400ns my ($pragma, $class) = @_;
36116µs13µs my $stash = Package::Stash->new($class);
# spent 3µs making 1 call to Package::Stash::XS::new
3621700ns my $var = "%$STORAGE_VAR";
363117µs517µs $stash->add_symbol($var, {})
# spent 8µs making 1 call to Package::Stash::XS::has_symbol # spent 5µs making 1 call to Package::Stash::XS::add_symbol # spent 4µs making 2 calls to Package::Stash::XS::namespace, avg 2µs/call # spent 400ns making 1 call to Package::Stash::XS::name
364 unless $stash->has_symbol($var);
36519µs24µs return $stash->get_symbol($var);
# spent 4µs making 1 call to Package::Stash::XS::get_symbol # spent 300ns making 1 call to Package::Stash::XS::namespace
366}
367
368=head2 get_functions
369
370Takes a class as argument and returns all currently defined functions
371in it as a hash reference with the function name as key and a typeglob
372reference to the symbol as value.
373
374=cut
375
376
# spent 39µs (17+22) within namespace::clean::get_functions which was called: # once (17µs+22µs) by namespace::clean::import at line 294
sub get_functions {
3771300ns my ($pragma, $class) = @_;
378
37918µs14µs my $stash = Package::Stash->new($class);
# spent 4µs making 1 call to Package::Stash::XS::new
380 return {
381134µs726µs map { $_ => $stash->get_symbol("&$_") }
# spent 11µs making 1 call to Package::Stash::XS::list_all_symbols # spent 7µs making 3 calls to Package::Stash::XS::namespace, avg 2µs/call # spent 7µs making 2 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 500ns making 1 call to Package::Stash::XS::name
382 $stash->list_all_symbols('CODE')
383 };
384}
385
386=head1 IMPLEMENTATION DETAILS
387
388This module works through the effect that a
389
390 delete $SomePackage::{foo};
391
392will remove the C<foo> symbol from C<$SomePackage> for run time lookups
393(e.g., method calls) but will leave the entry alive to be called by
394already resolved names in the package itself. C<namespace::clean> will
395restore and therefor in effect keep all glob slots that aren't C<CODE>.
396
397A test file has been added to the perl core to ensure that this behaviour
398will be stable in future releases.
399
400Just for completeness sake, if you want to remove the symbol completely,
401use C<undef> instead.
402
403=head1 SEE ALSO
404
405L<B::Hooks::EndOfScope>
406
407=head1 THANKS
408
409Many thanks to Matt S Trout for the inspiration on the whole idea.
410
411=head1 AUTHORS
412
413=over
414
415=item *
416
417Robert 'phaylon' Sedlacek <rs@474.at>
418
419=item *
420
421Florian Ragwitz <rafl@debian.org>
422
423=item *
424
425Jesse Luehrs <doy@tozt.net>
426
427=item *
428
429Peter Rabbitson <ribasushi@cpan.org>
430
431=item *
432
433Father Chrysostomos <sprout@cpan.org>
434
435=back
436
437=head1 COPYRIGHT AND LICENSE
438
439This software is copyright (c) 2011 by L</AUTHORS>
440
441This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.
442
443=cut
444
445230µs232µs
# spent 20µs (9+12) within namespace::clean::BEGIN@445 which was called: # once (9µs+12µs) by namespace::autoclean::BEGIN@16 at line 445
no warnings;
# spent 20µs making 1 call to namespace::clean::BEGIN@445 # spent 12µs making 1 call to warnings::unimport
44615µs'Danger! Laws of Thermodynamics may not apply.'