← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:47 2015

Filename/usr/share/perl5/namespace/clean.pm
StatementsExecuted 221 statements in 3.04ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111884µs2.27msnamespace::clean::::BEGIN@6namespace::clean::BEGIN@6
111876µs5.99msnamespace::clean::::BEGIN@11namespace::clean::BEGIN@11
111106µs234µsnamespace::clean::::__ANON__[:252]namespace::clean::__ANON__[:252]
11146µs226µsnamespace::clean::::importnamespace::clean::import
11132µs89µsnamespace::clean::::get_functionsnamespace::clean::get_functions
11117µs38µsnamespace::clean::::get_class_storenamespace::clean::get_class_store
11112µs17µsnamespace::clean::::BEGIN@3namespace::clean::BEGIN@3
1119µs23µsnamespace::clean::::BEGIN@445namespace::clean::BEGIN@445
1118µs41µsnamespace::clean::::BEGIN@146namespace::clean::BEGIN@146
1116µs29µsnamespace::clean::::BEGIN@147namespace::clean::BEGIN@147
1116µs15µsnamespace::clean::::BEGIN@4namespace::clean::BEGIN@4
1116µs16µsnamespace::clean::::BEGIN@149namespace::clean::BEGIN@149
1116µs239µsnamespace::clean::::__ANON__[:316]namespace::clean::__ANON__[:316]
0000s0snamespace::clean::::__ANON__[:199]namespace::clean::__ANON__[:199]
0000s0snamespace::clean::::__ANON__[:289]namespace::clean::__ANON__[:289]
0000s0snamespace::clean::::clean_subroutinesnamespace::clean::clean_subroutines
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
3226µs222µs
# spent 17µs (12+5) within namespace::clean::BEGIN@3 which was called: # once (12µs+5µs) by Class::Load::BEGIN@19 at line 3
use warnings;
# spent 17µs making 1 call to namespace::clean::BEGIN@3 # spent 5µs making 1 call to warnings::import
4220µs225µs
# spent 15µs (6+10) within namespace::clean::BEGIN@4 which was called: # once (6µs+10µs) by Class::Load::BEGIN@19 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
62720µs12.27ms
# spent 2.27ms (884µs+1.39) within namespace::clean::BEGIN@6 which was called: # once (884µs+1.39ms) by Class::Load::BEGIN@19 at line 6
use Package::Stash;
# spent 2.27ms making 1 call to namespace::clean::BEGIN@6
7
81400nsour $VERSION = '0.25';
91100nsour $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
10
112788µs26.02ms
# spent 5.99ms (876µs+5.12) within namespace::clean::BEGIN@11 which was called: # once (876µs+5.12ms) by Class::Load::BEGIN@19 at line 11
use B::Hooks::EndOfScope 'on_scope_end';
# spent 5.99ms making 1 call to namespace::clean::BEGIN@11 # spent 28µ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
146233µs274µs
# spent 41µs (8+33) within namespace::clean::BEGIN@146 which was called: # once (8µs+33µs) by Class::Load::BEGIN@19 at line 146
use constant FIXUP_NEEDED => $] < 5.015_005_1;
# spent 41µs making 1 call to namespace::clean::BEGIN@146 # spent 33µs making 1 call to constant::import
147225µs251µs
# spent 29µs (6+23) within namespace::clean::BEGIN@147 which was called: # once (6µs+23µs) by Class::Load::BEGIN@19 at line 147
use constant FIXUP_RENAME_SUB => $] > 5.008_008_9 && $] < 5.013_005_1;
# spent 29µs making 1 call to namespace::clean::BEGIN@147 # spent 23µs making 1 call to constant::import
148{
1493945µs226µs
# spent 16µs (6+10) within namespace::clean::BEGIN@149 which was called: # once (6µs+10µs) by Class::Load::BEGIN@19 at line 149
no strict;
# spent 16µs making 1 call to namespace::clean::BEGIN@149 # spent 10µs making 1 call to strict::unimport
15012µs delete ${__PACKAGE__."::"}{FIXUP_NEEDED};
1511700ns 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.
1681200nsmy $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 }
19913µs};
200
201
# spent 234µs (106+128) within namespace::clean::__ANON__[/usr/share/perl5/namespace/clean.pm:252] which was called: # once (106µs+128µs) by namespace::clean::__ANON__[/usr/share/perl5/namespace/clean.pm:316] at line 315
my $RemoveSubs = sub {
2021500ns my $cleanee = shift;
2031100ns my $store = shift;
204110µs15µs my $cleanee_stash = Package::Stash->new($cleanee);
# spent 5µs making 1 call to Package::Stash::XS::new
2051100ns my $deleted_stash;
206
207 SYMBOL:
20814µs for my $f (@_) {
209
210 # ignore already removed symbols
21182µs next SYMBOL if $store->{exclude}{ $f };
212
213842µs1735µs my $sub = $cleanee_stash->get_symbol("&$f")
# spent 29µs making 8 calls to Package::Stash::XS::get_symbol, avg 4µs/call # spent 6µs making 8 calls to Package::Stash::XS::namespace, avg 788ns/call # spent 500ns making 1 call to Package::Stash::XS::name
214 or next SYMBOL;
215
21681µ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
235329µs my @symbols = map {
23689µs my $name = $_ . $f;
23732110µs6483µs my $def = $cleanee_stash->get_symbol($name);
# spent 74µs making 32 calls to Package::Stash::XS::get_symbol, avg 2µs/call # spent 10µs making 32 calls to Package::Stash::XS::namespace, avg 297ns/call
238327µs defined($def) ? [$name, $def] : ()
239 } '$', '@', '%', '';
240
241831µs1622µs $cleanee_stash->remove_glob($f);
# spent 20µs making 8 calls to Package::Stash::XS::remove_glob, avg 3µs/call # spent 2µs making 8 calls to Package::Stash::XS::namespace, avg 288ns/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
25089µs $cleanee_stash->add_symbol(@$_) for @symbols;
251 }
25211µs};
253
254sub clean_subroutines {
255 my ($nc, $cleanee, @subs) = @_;
256 $RemoveSubs->($cleanee, {}, @subs);
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 226µs (46+180) within namespace::clean::import which was called: # once (46µs+180µs) by Class::Load::BEGIN@19 at line 19 of Class/Load.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;
2861200ns 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µs189µs my $functions = $pragma->get_functions($cleanee);
# spent 89µs making 1 call to namespace::clean::get_functions
29512µs138µs my $store = $pragma->get_class_store($cleanee);
# spent 38µ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
30612µs for my $f (keys %$functions) {
3078800ns next if $except{ $f };
308839µs1734µs next unless $stash->has_symbol("&$f");
# spent 28µs making 8 calls to Package::Stash::XS::has_symbol, avg 3µs/call # spent 6µs making 8 calls to Package::Stash::XS::namespace, avg 775ns/call # spent 500ns making 1 call to Package::Stash::XS::name
30986µs $store->{remove}{ $f } = 1;
310 }
311
312 # register EOF handler on first call to import
31311µs unless ($store->{handler_is_installed}) {
314
# spent 239µs (6+234) within namespace::clean::__ANON__[/usr/share/perl5/namespace/clean.pm:316] which was called: # once (6µs+234µs) by B::Hooks::EndOfScope::XS::__ANON__[/usr/share/perl5/B/Hooks/EndOfScope/XS.pm:26] at line 26 of B/Hooks/EndOfScope/XS.pm
on_scope_end {
31515µs1234µs $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} });
# spent 234µs making 1 call to namespace::clean::__ANON__[namespace/clean.pm:252]
31613µs124µs };
# spent 24µs making 1 call to B::Hooks::EndOfScope::XS::on_scope_end
3171500ns $store->{handler_is_installed} = 1;
318 }
319
320110µ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 38µs (17+21) within namespace::clean::get_class_store which was called: # once (17µs+21µs) by namespace::clean::import at line 295
sub get_class_store {
3601500ns my ($pragma, $class) = @_;
36116µs13µs my $stash = Package::Stash->new($class);
# spent 3µs making 1 call to Package::Stash::XS::new
3621500ns my $var = "%$STORAGE_VAR";
363124µs518µs $stash->add_symbol($var, {})
# spent 7µs making 1 call to Package::Stash::XS::has_symbol # spent 6µ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 89µs (32+57) within namespace::clean::get_functions which was called: # once (32µs+57µs) by namespace::clean::import at line 294
sub get_functions {
3771300ns my ($pragma, $class) = @_;
378
379118µs112µs my $stash = Package::Stash->new($class);
# spent 12µs making 1 call to Package::Stash::XS::new
380 return {
381173µs1958µs map { $_ => $stash->get_symbol("&$_") }
# spent 26µs making 8 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 19µs making 1 call to Package::Stash::XS::list_all_symbols # spent 13µs making 9 calls to Package::Stash::XS::namespace, avg 1µs/call # spent 700ns 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µs238µs
# spent 23µs (9+14) within namespace::clean::BEGIN@445 which was called: # once (9µs+14µs) by Class::Load::BEGIN@19 at line 445
no warnings;
# spent 23µs making 1 call to namespace::clean::BEGIN@445 # spent 14µs making 1 call to warnings::unimport
44614µs'Danger! Laws of Thermodynamics may not apply.'
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.