← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:31 2010

File /usr/local/lib/perl5/site_perl/5.10.1/namespace/clean.pm
Statements Executed 2067
Statement Execution Time 2.97ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
4111.35ms2.99msnamespace::clean::::__ANON__[:211]namespace::clean::__ANON__[:211]
411551µs1.55msnamespace::clean::::get_functionsnamespace::clean::get_functions
111451µs726µsnamespace::clean::::BEGIN@15namespace::clean::BEGIN@15
111349µs2.03msnamespace::clean::::BEGIN@14namespace::clean::BEGIN@14
444306µs1.96msnamespace::clean::::importnamespace::clean::import
41127µs3.01msnamespace::clean::::__ANON__[:275]namespace::clean::__ANON__[:275]
1122223µs23µsnamespace::clean::::CORE:matchnamespace::clean::CORE:match (opcode)
41120µs20µsnamespace::clean::::get_class_storenamespace::clean::get_class_store
11116µs26µsnamespace::clean::::BEGIN@9namespace::clean::BEGIN@9
11111µs34µsnamespace::clean::::BEGIN@16namespace::clean::BEGIN@16
11110µs54µsnamespace::clean::::BEGIN@13namespace::clean::BEGIN@13
11110µs27µsnamespace::clean::::BEGIN@190namespace::clean::BEGIN@190
1119µs20µsnamespace::clean::::BEGIN@383namespace::clean::BEGIN@383
1119µs23µsnamespace::clean::::BEGIN@340namespace::clean::BEGIN@340
1119µs23µsnamespace::clean::::BEGIN@170namespace::clean::BEGIN@170
1118µs23µsnamespace::clean::::BEGIN@320namespace::clean::BEGIN@320
1117µs65µsnamespace::clean::::BEGIN@12namespace::clean::BEGIN@12
1117µs9µsnamespace::clean::::BEGIN@10namespace::clean::BEGIN@10
0000s0snamespace::clean::::__ANON__[:248]namespace::clean::__ANON__[:248]
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
3=head1 NAME
4
5namespace::clean - Keep imports and functions out of your namespace
6
7=cut
8
9323µs236µs
# spent 26µs (16+10) within namespace::clean::BEGIN@9 which was called # once (16µs+10µs) by MooseX::Types::Base::BEGIN@15 at line 9
use warnings;
# spent 26µs making 1 call to namespace::clean::BEGIN@9 # spent 10µs making 1 call to warnings::import
10322µs211µs
# spent 9µs (7+2) within namespace::clean::BEGIN@10 which was called # once (7µs+2µs) by MooseX::Types::Base::BEGIN@15 at line 10
use strict;
# spent 9µs making 1 call to namespace::clean::BEGIN@10 # spent 2µs making 1 call to strict::import
11
12326µs2124µs
# spent 65µs (7+58) within namespace::clean::BEGIN@12 which was called # once (7µs+58µs) by MooseX::Types::Base::BEGIN@15 at line 12
use vars qw( $VERSION $STORAGE_VAR $SCOPE_HOOK_KEY $SCOPE_EXPLICIT );
# spent 65µs making 1 call to namespace::clean::BEGIN@12 # spent 58µs making 1 call to vars::import
13326µs299µs
# spent 54µs (10+44) within namespace::clean::BEGIN@13 which was called # once (10µs+44µs) by MooseX::Types::Base::BEGIN@15 at line 13
use Symbol qw( qualify_to_ref gensym );
# spent 54µs making 1 call to namespace::clean::BEGIN@13 # spent 44µs making 1 call to Exporter::import
143118µs22.21ms
# spent 2.03ms (349µs+1.68) within namespace::clean::BEGIN@14 which was called # once (349µs+1.68ms) by MooseX::Types::Base::BEGIN@15 at line 14
use B::Hooks::EndOfScope;
# spent 2.03ms making 1 call to namespace::clean::BEGIN@14 # spent 176µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756]
153111µs2763µs
# spent 726µs (451+275) within namespace::clean::BEGIN@15 which was called # once (451µs+275µs) by MooseX::Types::Base::BEGIN@15 at line 15
use Sub::Identify qw(sub_fullname);
# spent 726µs making 1 call to namespace::clean::BEGIN@15 # spent 38µs making 1 call to Exporter::import
163106µs257µs
# spent 34µs (11+23) within namespace::clean::BEGIN@16 which was called # once (11µs+23µs) by MooseX::Types::Base::BEGIN@15 at line 16
use Sub::Name qw(subname);
# spent 34µs making 1 call to namespace::clean::BEGIN@16 # spent 23µs making 1 call to Exporter::import
17
18=head1 VERSION
19
200.13
21
22=cut
23
241600ns$VERSION = '0.13';
251200ns$STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
26
27=head1 SYNOPSIS
28
29 package Foo;
30 use warnings;
31 use strict;
32
33 use Carp qw(croak); # 'croak' will be removed
34
35 sub bar { 23 } # 'bar' will be removed
36
37 # remove all previously defined functions
38 use namespace::clean;
39
40 sub baz { bar() } # 'baz' still defined, 'bar' still bound
41
42 # begin to collection function names from here again
43 no namespace::clean;
44
45 sub quux { baz() } # 'quux' will be removed
46
47 # remove all functions defined after the 'no' unimport
48 use namespace::clean;
49
50 # Will print: 'No', 'No', 'Yes' and 'No'
51 print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n";
52 print +(__PACKAGE__->can('bar') ? 'Yes' : 'No'), "\n";
53 print +(__PACKAGE__->can('baz') ? 'Yes' : 'No'), "\n";
54 print +(__PACKAGE__->can('quux') ? 'Yes' : 'No'), "\n";
55
56 1;
57
58=head1 DESCRIPTION
59
60=head2 Keeping packages clean
61
62When you define a function, or import one, into a Perl package, it will
63naturally also be available as a method. This does not per se cause
64problems, but it can complicate subclassing and, for example, plugin
65classes that are included via multiple inheritance by loading them as
66base classes.
67
68The C<namespace::clean> pragma will remove all previously declared or
69imported symbols at the end of the current package's compile cycle.
70Functions called in the package itself will still be bound by their
71name, but they won't show up as methods on your class or instances.
72
73By unimporting via C<no> you can tell C<namespace::clean> to start
74collecting functions for the next C<use namespace::clean;> specification.
75
76You can use the C<-except> flag to tell C<namespace::clean> that you
77don't want it to remove a certain function or method. A common use would
78be a module exporting an C<import> method along with some functions:
79
80 use ModuleExportingImport;
81 use namespace::clean -except => [qw( import )];
82
83If you just want to C<-except> a single sub, you can pass it directly.
84For more than one value you have to use an array reference.
85
86=head2 Explicitely removing functions when your scope is compiled
87
88It is also possible to explicitely tell C<namespace::clean> what packages
89to remove when the surrounding scope has finished compiling. Here is an
90example:
91
92 package Foo;
93 use strict;
94
95 # blessed NOT available
96
97 sub my_class {
98 use Scalar::Util qw( blessed );
99 use namespace::clean qw( blessed );
100
101 # blessed available
102 return blessed shift;
103 }
104
105 # blessed NOT available
106
107=head2 Moose
108
109When using C<namespace::clean> together with L<Moose> you want to keep
110the installed C<meta> method. So your classes should look like:
111
112 package Foo;
113 use Moose;
114 use namespace::clean -except => 'meta';
115 ...
116
117Same goes for L<Moose::Role>.
118
119=head2 Cleaning other packages
120
121You can tell C<namespace::clean> that you want to clean up another package
122instead of the one importing. To do this you have to pass in the C<-cleanee>
123option like this:
124
125 package My::MooseX::namespace::clean;
126 use strict;
127
128 use namespace::clean (); # no cleanup, just load
129
130 sub import {
131 namespace::clean->import(
132 -cleanee => scalar(caller),
133 -except => 'meta',
134 );
135 }
136
137If you don't care about C<namespace::clean>s discover-and-C<-except> logic, and
138just want to remove subroutines, try L</clean_subroutines>.
139
140=head1 METHODS
141
142You shouldn't need to call any of these. Just C<use> the package at the
143appropriate place.
144
145=cut
146
147=head2 clean_subroutines
148
149This exposes the actual subroutine-removal logic.
150
151 namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
152
153will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
154subroutines B<immediately> and not wait for scope end. If you want to have this
155effect at a specific time (e.g. C<namespace::clean> acts on scope compile end)
156it is your responsibility to make sure it runs at that time.
157
158=cut
159
160
# spent 2.99ms (1.35+1.64) within namespace::clean::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/namespace/clean.pm:211] which was called 4 times, avg 746µs/call: # 4 times (1.35ms+1.64ms) by namespace::clean::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/namespace/clean.pm:275] at line 274, avg 746µs/call
my $RemoveSubs = sub {
161
1621216µs my $cleanee = shift;
163 my $store = shift;
164 SYMBOL:
165 for my $f (@_) {
166360348µs my $fq = "${cleanee}::$f";
167
168 # ignore already removed symbols
169 next SYMBOL if $store->{exclude}{ $f };
170387µs238µs
# spent 23µs (9+15) within namespace::clean::BEGIN@170 which was called # once (9µs+15µs) by MooseX::Types::Base::BEGIN@15 at line 170
no strict 'refs';
# spent 23µs making 1 call to namespace::clean::BEGIN@170 # spent 15µs making 1 call to strict::unimport
171
172 next SYMBOL unless exists ${ "${cleanee}::" }{ $f };
173
174450280µs if (ref(\${ "${cleanee}::" }{ $f }) eq 'GLOB') {
175 # convince the Perl debugger to work
176 # it assumes that sub_fullname($sub) can always be used to find the CV again
177 # since we are deleting the glob where the subroutine was originally
178 # defined, that assumption no longer holds, so we need to move it
179 # elsewhere and point the CV's name to the new glob.
180 my $sub = \&$fq;
181 if ( sub_fullname($sub) eq $fq ) {
# spent 1.64ms making 90 calls to Sub::Identify::sub_fullname, avg 18µs/call
182 my $new_fq = "namespace::clean::deleted::$fq";
183 subname($new_fq, $sub);
184 *{$new_fq} = $sub;
185 }
186
187 local *__tmp;
188
189 # keep original value to restore non-code slots
1903421µs245µs
# spent 27µs (10+18) within namespace::clean::BEGIN@190 which was called # once (10µs+18µs) by MooseX::Types::Base::BEGIN@15 at line 190
{ no warnings 'uninitialized'; # fix possible unimports
# spent 27µs making 1 call to namespace::clean::BEGIN@190 # spent 18µs making 1 call to warnings::unimport
191180159µs *__tmp = *{ ${ "${cleanee}::" }{ $f } };
192 delete ${ "${cleanee}::" }{ $f };
193 }
194
195 SLOT:
196 # restore non-code slots to symbol.
197 # omit the FORMAT slot, since perl erroneously puts it into the
198 # SCALAR slot of the new glob.
199 for my $t (qw( SCALAR ARRAY HASH IO )) {
200450232µs next SLOT unless defined *__tmp{ $t };
201 *{ "${cleanee}::$f" } = *__tmp{ $t };
202 }
203 }
204 else {
205 # A non-glob in the stash is assumed to stand for some kind
206 # of function. So far they all do, but the core might change
207 # this some day. Watch perl5-porters.
208 delete ${ "${cleanee}::" }{ $f };
209 }
210 }
21113µs};
212
213sub clean_subroutines {
214 my ($nc, $cleanee, @subs) = @_;
215 $RemoveSubs->($cleanee, {}, @subs);
216}
217
218=head2 import
219
220Makes a snapshot of the current defined functions and installs a
221L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
222
223=cut
224
225
# spent 1.96ms (306µs+1.65) within namespace::clean::import which was called 4 times, avg 489µs/call: # once (91µs+628µs) by MooseX::Types::BEGIN@20 at line 20 of MooseX/Types.pm # once (103µs+604µs) by MooseX::Types::Base::BEGIN@15 at line 15 of MooseX/Types/Base.pm # once (66µs+294µs) by MooseX::Types::Moose::BEGIN@15 at line 15 of MooseX/Types/Moose.pm # once (46µs+125µs) by MooseX::Types::CheckedUtilExports::BEGIN@17 at line 17 of MooseX/Types/CheckedUtilExports.pm
sub import {
2262017µs my ($pragma, @args) = @_;
227
228 my (%args, $is_explicit);
229
230 ARG:
231 while (@args) {
232
2331632µs48µs if ($args[0] =~ /^\-/) {
# spent 8µs making 4 calls to namespace::clean::CORE:match, avg 2µs/call
234 my $key = shift @args;
235 my $value = shift @args;
236 $args{ $key } = $value;
237 }
238 else {
239 $is_explicit++;
240 last ARG;
241 }
242 }
243
244 my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
24524120µs if ($is_explicit) {
246 on_scope_end {
247 $RemoveSubs->($cleanee, {}, @args);
248 };
249 }
250 else {
251
252 # calling class, all current functions and our storage
253 my $functions = $pragma->get_functions($cleanee);
# spent 1.55ms making 4 calls to namespace::clean::get_functions, avg 388µs/call
254 my $store = $pragma->get_class_store($cleanee);
# spent 20µs making 4 calls to namespace::clean::get_class_store, avg 5µs/call
255
256 # except parameter can be array ref or single value
257 my %except = map {( $_ => 1 )} (
258 $args{ -except }
259 ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } )
260 : ()
261 );
262
263 # register symbols for removal, if they have a CODE entry
264 for my $f (keys %$functions) {
26527275µs next if $except{ $f };
266 next unless $functions->{ $f }
267 and *{ $functions->{ $f } }{CODE};
268 $store->{remove}{ $f } = 1;
269 }
270
271 # register EOF handler on first call to import
272818µs unless ($store->{handler_is_installed}) {
273
# spent 3.01ms (27µs+2.99) within namespace::clean::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/namespace/clean.pm:275] which was called 4 times, avg 753µs/call: # 4 times (27µs+2.99ms) by B::Hooks::EndOfScope::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/B/Hooks/EndOfScope.pm:47] at line 47 of B/Hooks/EndOfScope.pm, avg 753µs/call
on_scope_end {
274426µs42.99ms $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} });
# spent 2.99ms making 4 calls to namespace::clean::__ANON__[namespace/clean.pm:211], avg 746µs/call
275 };
# spent 73µs making 4 calls to B::Hooks::EndOfScope::on_scope_end, avg 18µs/call
276 $store->{handler_is_installed} = 1;
277 }
278
279 return 1;
280 }
281}
282
283=head2 unimport
284
285This method will be called when you do a
286
287 no namespace::clean;
288
289It will start a new section of code that defines functions to clean up.
290
291=cut
292
293sub unimport {
294 my ($pragma, %args) = @_;
295
296 # the calling class, the current functions and our storage
297 my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
298 my $functions = $pragma->get_functions($cleanee);
299 my $store = $pragma->get_class_store($cleanee);
300
301 # register all unknown previous functions as excluded
302 for my $f (keys %$functions) {
303 next if $store->{remove}{ $f }
304 or $store->{exclude}{ $f };
305 $store->{exclude}{ $f } = 1;
306 }
307
308 return 1;
309}
310
311=head2 get_class_store
312
313This returns a reference to a hash in a passed package containing
314information about function names included and excluded from removal.
315
316=cut
317
318
# spent 20µs within namespace::clean::get_class_store which was called 4 times, avg 5µs/call: # 4 times (20µs+0s) by namespace::clean::import at line 254, avg 5µs/call
sub get_class_store {
319823µs my ($pragma, $class) = @_;
3203120µs238µs
# spent 23µs (8+15) within namespace::clean::BEGIN@320 which was called # once (8µs+15µs) by MooseX::Types::Base::BEGIN@15 at line 320
no strict 'refs';
# spent 23µs making 1 call to namespace::clean::BEGIN@320 # spent 15µs making 1 call to strict::unimport
321 return \%{ "${class}::${STORAGE_VAR}" };
322}
323
324=head2 get_functions
325
326Takes a class as argument and returns all currently defined functions
327in it as a hash reference with the function name as key and a typeglob
328reference to the symbol as value.
329
330=cut
331
332
# spent 1.55ms (551µs+1.00) within namespace::clean::get_functions which was called 4 times, avg 388µs/call: # 4 times (551µs+1.00ms) by namespace::clean::import at line 253, avg 388µs/call
sub get_functions {
3338122µs my ($pragma, $class) = @_;
334
335 return {
336 map { @$_ } # key => value
337 grep { *{ $_->[1] }{CODE} } # only functions
# spent 985µs making 103 calls to Symbol::qualify_to_ref, avg 10µs/call
338 map { [$_, qualify_to_ref( $_, $class )] } # get globref
# spent 15µs making 108 calls to namespace::clean::CORE:match, avg 139ns/call
339 grep { $_ !~ /::$/ } # no packages
340218403µs237µs
# spent 23µs (9+14) within namespace::clean::BEGIN@340 which was called # once (9µs+14µs) by MooseX::Types::Base::BEGIN@15 at line 340
do { no strict 'refs'; keys %{ "${class}::" } } # symbol entries
# spent 23µs making 1 call to namespace::clean::BEGIN@340 # spent 14µs making 1 call to strict::unimport
341 };
342}
343
344=head1 BUGS
345
346C<namespace::clean> will clobber any formats that have the same name as
347a deleted sub. This is due to a bug in perl that makes it impossible to
348re-assign the FORMAT ref into a new glob.
349
350=head1 IMPLEMENTATION DETAILS
351
352This module works through the effect that a
353
354 delete $SomePackage::{foo};
355
356will remove the C<foo> symbol from C<$SomePackage> for run time lookups
357(e.g., method calls) but will leave the entry alive to be called by
358already resolved names in the package itself. C<namespace::clean> will
359restore and therefor in effect keep all glob slots that aren't C<CODE>.
360
361A test file has been added to the perl core to ensure that this behaviour
362will be stable in future releases.
363
364Just for completeness sake, if you want to remove the symbol completely,
365use C<undef> instead.
366
367=head1 SEE ALSO
368
369L<B::Hooks::EndOfScope>
370
371=head1 AUTHOR AND COPYRIGHT
372
373Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
374Matt S Trout for the inspiration on the whole idea.
375
376=head1 LICENSE
377
378This program is free software; you can redistribute it and/or modify
379it under the same terms as perl itself.
380
381=cut
382
383332µs230µs
# spent 20µs (9+10) within namespace::clean::BEGIN@383 which was called # once (9µs+10µs) by MooseX::Types::Base::BEGIN@15 at line 383
no warnings;
# spent 20µs making 1 call to namespace::clean::BEGIN@383 # spent 10µs making 1 call to warnings::unimport
38415µs'Danger! Laws of Thermodynamics may not apply.'
# spent 23µs within namespace::clean::CORE:match which was called 112 times, avg 202ns/call: # 108 times (15µs+0s) by namespace::clean::get_functions at line 338 of namespace/clean.pm, avg 139ns/call # 4 times (8µs+0s) by namespace::clean::import at line 233 of namespace/clean.pm, avg 2µs/call
sub namespace::clean::CORE:match; # xsub