Profile of namespace/clean.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:43 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/namespace/clean.pm
Statements | Executed 5149 statements in 31.6ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
145 | 1 | 1 | 18.2ms | 39.8ms | namespace::clean::::__ANON__[:221]namespace::clean::__ANON__[:221]
43 | 3 | 1 | 4.56ms | 48.0ms | namespace::clean::::__ANON__[:274]namespace::clean::__ANON__[:274]
41 | 26 | 26 | 1.46ms | 5.40ms | namespace::clean::::importnamespace::clean::import
25 | 1 | 1 | 615µs | 1.76ms | namespace::clean::::get_functionsnamespace::clean::get_functions
25 | 1 | 1 | 356µs | 908µs | namespace::clean::::get_class_storenamespace::clean::get_class_store
25 | 1 | 1 | 160µs | 44.1ms | namespace::clean::::__ANON__[:338]namespace::clean::__ANON__[:338]
16 | 1 | 1 | 89µs | 3.71ms | namespace::clean::::__ANON__[:311]namespace::clean::__ANON__[:311]
32 | 1 | 1 | 48µs | 48µs | namespace::clean::::CORE:matchnamespace::clean::CORE:match (opcode)
2 | 2 | 2 | 26µs | 505µs | namespace::clean::::clean_subroutinesnamespace::clean::clean_subroutines
1 | 1 | 1 | 16µs | 156µs | namespace::clean::::BEGIN@14namespace::clean::BEGIN@14
1 | 1 | 1 | 15µs | 30µs | namespace::clean::::BEGIN@3namespace::clean::BEGIN@3
1 | 1 | 1 | 11µs | 60µs | namespace::clean::::BEGIN@168namespace::clean::BEGIN@168
1 | 1 | 1 | 11µs | 19µs | namespace::clean::::BEGIN@7namespace::clean::BEGIN@7
1 | 1 | 1 | 11µs | 29µs | namespace::clean::::BEGIN@467namespace::clean::BEGIN@467
1 | 1 | 1 | 9µs | 13µs | namespace::clean::::BEGIN@171namespace::clean::BEGIN@171
1 | 1 | 1 | 8µs | 12µs | namespace::clean::::BEGIN@4namespace::clean::BEGIN@4
1 | 1 | 1 | 8µs | 32µs | namespace::clean::::BEGIN@169namespace::clean::BEGIN@169
1 | 1 | 1 | 8µs | 36µs | namespace::clean::::BEGIN@6namespace::clean::BEGIN@6
0 | 0 | 0 | 0s | 0s | namespace::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package namespace::clean;
2 |  |  |  |  |
3 | 3 | 20µs | 2 | 45µs | # spent 30µs (15+15) within namespace::clean::BEGIN@3 which was called: # once (15µs+15µs) by namespace::autoclean::BEGIN@16 at line 3 use warnings; # spent 30µs making 1 call to namespace::clean::BEGIN@3 # spent 15µs making 1 call to warnings::import
4 | 3 | 21µs | 2 | 16µs | # spent 12µs (8+4) within namespace::clean::BEGIN@4 which was called: # once (8µs+4µs) by namespace::autoclean::BEGIN@16 at line 4 use strict; # spent 12µs making 1 call to namespace::clean::BEGIN@4 # spent 4µs making 1 call to strict::import
5 |  |  |  |  |
6 | 3 | 18µs | 2 | 64µs | # spent 36µs (8+28) within namespace::clean::BEGIN@6 which was called: # once (8µs+28µs) by namespace::autoclean::BEGIN@16 at line 6 use vars qw( $STORAGE_VAR ); # spent 36µs making 1 call to namespace::clean::BEGIN@6 # spent 28µs making 1 call to vars::import
7 | 3 | 116µs | 2 | 28µs | # spent 19µs (11+8) within namespace::clean::BEGIN@7 which was called: # once (11µs+8µs) by namespace::autoclean::BEGIN@16 at line 7 use Package::Stash; # spent 19µs making 1 call to namespace::clean::BEGIN@7 # spent 8µs making 1 call to Package::DeprecationManager::__ANON__[Package/DeprecationManager.pm:61]
8 |  |  |  |  |
9 | 1 | 400ns |  |  | our $VERSION = '0.23';
10 |  |  |  |  |
11 | 1 | 500ns |  |  | $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
12 |  |  |  |  |
13 |  |  |  |  | # FIXME - all of this buggery will migrate to B::H::EOS soon
14 |  |  |  |  | # spent 156µs (16+140) within namespace::clean::BEGIN@14 which was called: # once (16µs+140µs) by namespace::autoclean::BEGIN@16 at line 33 BEGIN {
15 |  |  |  |  | # when changing also change in Makefile.PL
16 | 1 | 400ns |  |  | my $b_h_eos_req = '0.10';
17 |  |  |  |  |
18 | 1 | 7µs | 1 | 127µs | if (! $ENV{NAMESPACE_CLEAN_USE_PP} and eval { # spent 127µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756]
19 | 1 | 500ns |  |  | require B::Hooks::EndOfScope;
20 | 1 | 20µs | 1 | 13µs | B::Hooks::EndOfScope->VERSION($b_h_eos_req); # spent 13µs making 1 call to UNIVERSAL::VERSION
21 | 1 | 700ns |  |  | 1
22 |  |  |  |  | } ) {
23 |  |  |  |  | B::Hooks::EndOfScope->import('on_scope_end');
24 |  |  |  |  | }
25 |  |  |  |  | elsif ($] < 5.009_003_1) {
26 |  |  |  |  | require namespace::clean::_PP_OSE_5_8;
27 |  |  |  |  | *on_scope_end = \&namespace::clean::_PP_OSE_5_8::on_scope_end;
28 |  |  |  |  | }
29 |  |  |  |  | else {
30 |  |  |  |  | require namespace::clean::_PP_OSE;
31 |  |  |  |  | *on_scope_end = \&namespace::clean::_PP_OSE::on_scope_end;
32 |  |  |  |  | }
33 | 1 | 80µs | 1 | 156µs | } # spent 156µs making 1 call to namespace::clean::BEGIN@14
34 |  |  |  |  |
35 |  |  |  |  | =head1 NAME
36 |  |  |  |  |
37 |  |  |  |  | namespace::clean - Keep imports and functions out of your namespace
38 |  |  |  |  |
39 |  |  |  |  | =head1 SYNOPSIS
40 |  |  |  |  |
41 |  |  |  |  | package Foo;
42 |  |  |  |  | use warnings;
43 |  |  |  |  | use strict;
44 |  |  |  |  |
45 |  |  |  |  | use Carp qw(croak); # 'croak' will be removed
46 |  |  |  |  |
47 |  |  |  |  | sub bar { 23 } # 'bar' will be removed
48 |  |  |  |  |
49 |  |  |  |  | # remove all previously defined functions
50 |  |  |  |  | use namespace::clean;
51 |  |  |  |  |
52 |  |  |  |  | sub baz { bar() } # 'baz' still defined, 'bar' still bound
53 |  |  |  |  |
54 |  |  |  |  | # begin to collection function names from here again
55 |  |  |  |  | no namespace::clean;
56 |  |  |  |  |
57 |  |  |  |  | sub quux { baz() } # 'quux' will be removed
58 |  |  |  |  |
59 |  |  |  |  | # remove all functions defined after the 'no' unimport
60 |  |  |  |  | use namespace::clean;
61 |  |  |  |  |
62 |  |  |  |  | # Will print: 'No', 'No', 'Yes' and 'No'
63 |  |  |  |  | print +(__PACKAGE__->can('croak') ? 'Yes' : 'No'), "\n";
64 |  |  |  |  | print +(__PACKAGE__->can('bar') ? 'Yes' : 'No'), "\n";
65 |  |  |  |  | print +(__PACKAGE__->can('baz') ? 'Yes' : 'No'), "\n";
66 |  |  |  |  | print +(__PACKAGE__->can('quux') ? 'Yes' : 'No'), "\n";
67 |  |  |  |  |
68 |  |  |  |  | 1;
69 |  |  |  |  |
70 |  |  |  |  | =head1 DESCRIPTION
71 |  |  |  |  |
72 |  |  |  |  | =head2 Keeping packages clean
73 |  |  |  |  |
74 |  |  |  |  | When you define a function, or import one, into a Perl package, it will
75 |  |  |  |  | naturally also be available as a method. This does not per se cause
76 |  |  |  |  | problems, but it can complicate subclassing and, for example, plugin
77 |  |  |  |  | classes that are included via multiple inheritance by loading them as
78 |  |  |  |  | base classes.
79 |  |  |  |  |
80 |  |  |  |  | The C<namespace::clean> pragma will remove all previously declared or
81 |  |  |  |  | imported symbols at the end of the current package's compile cycle.
82 |  |  |  |  | Functions called in the package itself will still be bound by their
83 |  |  |  |  | name, but they won't show up as methods on your class or instances.
84 |  |  |  |  |
85 |  |  |  |  | By unimporting via C<no> you can tell C<namespace::clean> to start
86 |  |  |  |  | collecting functions for the next C<use namespace::clean;> specification.
87 |  |  |  |  |
88 |  |  |  |  | You can use the C<-except> flag to tell C<namespace::clean> that you
89 |  |  |  |  | don't want it to remove a certain function or method. A common use would
90 |  |  |  |  | be a module exporting an C<import> method along with some functions:
91 |  |  |  |  |
92 |  |  |  |  | use ModuleExportingImport;
93 |  |  |  |  | use namespace::clean -except => [qw( import )];
94 |  |  |  |  |
95 |  |  |  |  | If you just want to C<-except> a single sub, you can pass it directly.
96 |  |  |  |  | For more than one value you have to use an array reference.
97 |  |  |  |  |
98 |  |  |  |  | =head2 Explicitly removing functions when your scope is compiled
99 |  |  |  |  |
100 |  |  |  |  | It is also possible to explicitly tell C<namespace::clean> what packages
101 |  |  |  |  | to remove when the surrounding scope has finished compiling. Here is an
102 |  |  |  |  | example:
103 |  |  |  |  |
104 |  |  |  |  | package Foo;
105 |  |  |  |  | use strict;
106 |  |  |  |  |
107 |  |  |  |  | # blessed NOT available
108 |  |  |  |  |
109 |  |  |  |  | sub my_class {
110 |  |  |  |  | use Scalar::Util qw( blessed );
111 |  |  |  |  | use namespace::clean qw( blessed );
112 |  |  |  |  |
113 |  |  |  |  | # blessed available
114 |  |  |  |  | return blessed shift;
115 |  |  |  |  | }
116 |  |  |  |  |
117 |  |  |  |  | # blessed NOT available
118 |  |  |  |  |
119 |  |  |  |  | =head2 Moose
120 |  |  |  |  |
121 |  |  |  |  | When using C<namespace::clean> together with L<Moose> you want to keep
122 |  |  |  |  | the installed C<meta> method. So your classes should look like:
123 |  |  |  |  |
124 |  |  |  |  | package Foo;
125 |  |  |  |  | use Moose;
126 |  |  |  |  | use namespace::clean -except => 'meta';
127 |  |  |  |  | ...
128 |  |  |  |  |
129 |  |  |  |  | Same goes for L<Moose::Role>.
130 |  |  |  |  |
131 |  |  |  |  | =head2 Cleaning other packages
132 |  |  |  |  |
133 |  |  |  |  | You can tell C<namespace::clean> that you want to clean up another package
134 |  |  |  |  | instead of the one importing. To do this you have to pass in the C<-cleanee>
135 |  |  |  |  | option like this:
136 |  |  |  |  |
137 |  |  |  |  | package My::MooseX::namespace::clean;
138 |  |  |  |  | use strict;
139 |  |  |  |  |
140 |  |  |  |  | use namespace::clean (); # no cleanup, just load
141 |  |  |  |  |
142 |  |  |  |  | sub import {
143 |  |  |  |  | namespace::clean->import(
144 |  |  |  |  | -cleanee => scalar(caller),
145 |  |  |  |  | -except => 'meta',
146 |  |  |  |  | );
147 |  |  |  |  | }
148 |  |  |  |  |
149 |  |  |  |  | If you don't care about C<namespace::clean>s discover-and-C<-except> logic, and
150 |  |  |  |  | just want to remove subroutines, try L</clean_subroutines>.
151 |  |  |  |  |
152 |  |  |  |  | =head1 METHODS
153 |  |  |  |  |
154 |  |  |  |  | =head2 clean_subroutines
155 |  |  |  |  |
156 |  |  |  |  | This exposes the actual subroutine-removal logic.
157 |  |  |  |  |
158 |  |  |  |  | namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
159 |  |  |  |  |
160 |  |  |  |  | will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
161 |  |  |  |  | subroutines B<immediately> and not wait for scope end. If you want to have this
162 |  |  |  |  | effect at a specific time (e.g. C<namespace::clean> acts on scope compile end)
163 |  |  |  |  | it is your responsibility to make sure it runs at that time.
164 |  |  |  |  |
165 |  |  |  |  | =cut
166 |  |  |  |  |
167 |  |  |  |  | # Constant to optimise away the unused code branches
168 | 3 | 31µs | 2 | 109µs | # spent 60µs (11+49) within namespace::clean::BEGIN@168 which was called: # once (11µs+49µs) by namespace::autoclean::BEGIN@16 at line 168 use constant FIXUP_NEEDED => $] < 5.015_005_1; # spent 60µs making 1 call to namespace::clean::BEGIN@168 # spent 49µs making 1 call to constant::import
169 | 3 | 20µs | 2 | 56µs | # spent 32µs (8+24) within namespace::clean::BEGIN@169 which was called: # once (8µs+24µs) by namespace::autoclean::BEGIN@16 at line 169 use constant FIXUP_RENAME_SUB => $] > 5.008_008_9 && $] < 5.013_005_1; # spent 32µs making 1 call to namespace::clean::BEGIN@169 # spent 24µs making 1 call to constant::import
170 |  |  |  |  | {
171 | 4 | 883µs | 2 | 17µs | # spent 13µs (9+4) within namespace::clean::BEGIN@171 which was called: # once (9µs+4µs) by namespace::autoclean::BEGIN@16 at line 171 no strict; # spent 13µs making 1 call to namespace::clean::BEGIN@171 # spent 4µs making 1 call to strict::unimport
172 | 1 | 2µs |  |  | delete ${__PACKAGE__."::"}{FIXUP_NEEDED};
173 | 1 | 900ns |  |  | delete ${__PACKAGE__."::"}{FIXUP_RENAME_SUB};
174 |  |  |  |  | }
175 |  |  |  |  |
176 |  |  |  |  | # Debugger fixup necessary before perl 5.15.5
177 |  |  |  |  | #
178 |  |  |  |  | # In perl 5.8.9-5.12, it assumes that sub_fullname($sub) can
179 |  |  |  |  | # always be used to find the CV again.
180 |  |  |  |  | # In perl 5.8.8 and 5.14, it assumes that the name of the glob
181 |  |  |  |  | # passed to entersub can be used to find the CV.
182 |  |  |  |  | # since we are deleting the glob where the subroutine was originally
183 |  |  |  |  | # defined, those assumptions no longer hold.
184 |  |  |  |  | #
185 |  |  |  |  | # So in 5.8.9-5.12 we need to move it elsewhere and point the
186 |  |  |  |  | # CV's name to the new glob.
187 |  |  |  |  | #
188 |  |  |  |  | # In 5.8.8 and 5.14 we move it elsewhere and rename the
189 |  |  |  |  | # original glob by assigning the new glob back to it.
190 | 1 | 100ns |  |  | my $sub_utils_loaded;
191 |  |  |  |  | # spent 39.8ms (18.2+21.6) within namespace::clean::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/namespace/clean.pm:221] which was called 145 times, avg 274µs/call: # 145 times (18.2ms+21.6ms) by namespace::clean::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/namespace/clean.pm:274] at line 246, avg 274µs/call my $DebuggerFixup = sub {
192 | 145 | 116µs |  |  | my ($f, $sub, $cleanee_stash, $deleted_stash) = @_;
193 |  |  |  |  |
194 | 145 | 384µs |  |  | if (FIXUP_RENAME_SUB) {
195 | 145 | 36µs |  |  | if (! defined $sub_utils_loaded ) {
196 | 1 | 2µs |  |  | $sub_utils_loaded = do {
197 |  |  |  |  |
198 |  |  |  |  | # when changing version also change in Makefile.PL
199 | 1 | 200ns |  |  | my $sn_ver = 0.04;
200 | 3 | 24µs | 1 | 11µs | eval { require Sub::Name; Sub::Name->VERSION($sn_ver) } # spent 11µs making 1 call to UNIVERSAL::VERSION
201 |  |  |  |  | or die "Sub::Name $sn_ver required when running under -d or equivalent: $@";
202 |  |  |  |  |
203 |  |  |  |  | # when changing version also change in Makefile.PL
204 | 1 | 400ns |  |  | my $si_ver = 0.04;
205 | 3 | 15.9ms | 1 | 50µs | eval { require Sub::Identify; Sub::Identify->VERSION($si_ver) } # spent 50µs making 1 call to UNIVERSAL::VERSION
206 |  |  |  |  | or die "Sub::Identify $si_ver required when running under -d or equivalent: $@";
207 |  |  |  |  |
208 | 1 | 2µs |  |  | 1;
209 |  |  |  |  | } ? 1 : 0;
210 |  |  |  |  | }
211 |  |  |  |  |
212 | 145 | 623µs | 290 | 803µs | if ( Sub::Identify::sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) { # spent 713µs making 145 calls to Sub::Identify::sub_fullname, avg 5µs/call # spent 89µs making 145 calls to Package::Stash::XS::name, avg 616ns/call
213 |  |  |  |  | my $new_fq = $deleted_stash->name . "::$f";
214 |  |  |  |  | Sub::Name::subname($new_fq, $sub);
215 |  |  |  |  | $deleted_stash->add_symbol("&$f", $sub);
216 |  |  |  |  | }
217 |  |  |  |  | }
218 |  |  |  |  | else {
219 |  |  |  |  | $deleted_stash->add_symbol("&$f", $sub);
220 |  |  |  |  | }
221 | 1 | 3µs |  |  | };
222 |  |  |  |  |
223 |  |  |  |  | # spent 48.0ms (4.56+43.4) within namespace::clean::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/namespace/clean.pm:274] which was called 43 times, avg 1.12ms/call: # 25 times (2.66ms+41.3ms) by namespace::clean::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/namespace/clean.pm:338] at line 337, avg 1.76ms/call # 16 times (1.70ms+1.92ms) by namespace::clean::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/namespace/clean.pm:311] at line 310, avg 226µs/call # 2 times (210µs+269µs) by namespace::clean::clean_subroutines at line 278, avg 239µs/call my $RemoveSubs = sub {
224 | 43 | 40µs |  |  | my $cleanee = shift;
225 | 43 | 21µs |  |  | my $store = shift;
226 | 43 | 648µs | 43 | 413µs | my $cleanee_stash = Package::Stash->new($cleanee); # spent 413µs making 43 calls to Package::Stash::XS::new, avg 10µs/call
227 | 43 | 8µs |  |  | my $deleted_stash;
228 |  |  |  |  |
229 |  |  |  |  | SYMBOL:
230 | 43 | 223µs |  |  | for my $f (@_) {
231 |  |  |  |  |
232 |  |  |  |  | # ignore already removed symbols
233 | 184 | 112µs |  |  | next SYMBOL if $store->{exclude}{ $f };
234 |  |  |  |  |
235 | 184 | 1.31ms | 411 | 1.17ms | my $sub = $cleanee_stash->get_symbol("&$f") # spent 846µs making 184 calls to Package::Stash::XS::get_symbol, avg 5µs/call # spent 293µs making 184 calls to Package::Stash::XS::namespace, avg 2µs/call # spent 30µs making 43 calls to Package::Stash::XS::name, avg 709ns/call
236 |  |  |  |  | or next SYMBOL;
237 |  |  |  |  |
238 | 145 | 554µs | 145 | 77µs | my $need_debugger_fixup = # spent 77µs making 145 calls to Package::Stash::XS::namespace, avg 534ns/call
239 |  |  |  |  | FIXUP_NEEDED
240 |  |  |  |  | &&
241 |  |  |  |  | $^P
242 |  |  |  |  | &&
243 |  |  |  |  | ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB'
244 |  |  |  |  | ;
245 |  |  |  |  |
246 | 145 | 574µs | 188 | 40.0ms | if (FIXUP_NEEDED && $need_debugger_fixup) { # spent 39.8ms making 145 calls to namespace::clean::__ANON__[namespace/clean.pm:221], avg 274µs/call # spent 208µs making 43 calls to Package::Stash::XS::new, avg 5µs/call
247 |  |  |  |  | # convince the Perl debugger to work
248 |  |  |  |  | # see the comment on top of $DebuggerFixup
249 |  |  |  |  | $DebuggerFixup->(
250 |  |  |  |  | $f,
251 |  |  |  |  | $sub,
252 |  |  |  |  | $cleanee_stash,
253 |  |  |  |  | $deleted_stash ||= Package::Stash->new("namespace::clean::deleted::$cleanee"),
254 |  |  |  |  | );
255 |  |  |  |  | }
256 |  |  |  |  |
257 | 580 | 208µs |  |  | my @symbols = map {
258 | 145 | 235µs |  |  | my $name = $_ . $f;
259 | 580 | 2.86ms | 1160 | 1.95ms | my $def = $cleanee_stash->get_symbol($name); # spent 1.70ms making 580 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 250µs making 580 calls to Package::Stash::XS::namespace, avg 431ns/call
260 | 580 | 197µs |  |  | defined($def) ? [$name, $def] : ()
261 |  |  |  |  | } '$', '@', '%', '';
262 |  |  |  |  |
263 | 145 | 725µs | 290 | 487µs | $cleanee_stash->remove_glob($f); # spent 425µs making 145 calls to Package::Stash::XS::remove_glob, avg 3µs/call # spent 62µs making 145 calls to Package::Stash::XS::namespace, avg 430ns/call
264 |  |  |  |  |
265 |  |  |  |  | # if this perl needs no renaming trick we need to
266 |  |  |  |  | # rename the original glob after the fact
267 |  |  |  |  | # (see commend of $DebuggerFixup
268 | 145 | 17µs |  |  | if (FIXUP_NEEDED && !FIXUP_RENAME_SUB && $need_debugger_fixup) {
269 |  |  |  |  | *$globref = $deleted_stash->namespace->{$f};
270 |  |  |  |  | }
271 |  |  |  |  |
272 | 290 | 394µs |  |  | $cleanee_stash->add_symbol(@$_) for @symbols;
273 |  |  |  |  | }
274 | 1 | 3µs |  |  | };
275 |  |  |  |  |
276 |  |  |  |  | # spent 505µs (26+479) within namespace::clean::clean_subroutines which was called 2 times, avg 253µs/call: # once (18µs+278µs) by namespace::autoclean::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/namespace/autoclean.pm:57] at line 56 of namespace/autoclean.pm # once (8µs+201µs) by DBIx::Class::SQLMaker::BEGIN@64 at line 80 of DBIx/Class/SQLMaker.pm sub clean_subroutines {
277 | 2 | 6µs |  |  | my ($nc, $cleanee, @subs) = @_;
278 | 2 | 21µs | 2 | 479µs | $RemoveSubs->($cleanee, {}, @subs); # spent 479µs making 2 calls to namespace::clean::__ANON__[namespace/clean.pm:274], avg 239µs/call
279 |  |  |  |  | }
280 |  |  |  |  |
281 |  |  |  |  | =head2 import
282 |  |  |  |  |
283 |  |  |  |  | Makes a snapshot of the current defined functions and installs a
284 |  |  |  |  | L<B::Hooks::EndOfScope> hook in the current scope to invoke the cleanups.
285 |  |  |  |  |
286 |  |  |  |  | =cut
287 |  |  |  |  |
288 |  |  |  |  | # spent 5.40ms (1.46+3.94) within namespace::clean::import which was called 41 times, avg 132µs/call: # 16 times (346µs+358µs) by DBIx::Class::Carp::import at line 113 of DBIx/Class/Carp.pm, avg 44µs/call # once (56µs+190µs) by SQL::Translator::Parser::DBIx::Class::BEGIN@21 at line 21 of SQL/Translator/Parser/DBIx/Class.pm # once (60µs+184µs) by DBIx::Class::ResultSet::BEGIN@22 at line 22 of DBIx/Class/ResultSet.pm # once (63µs+175µs) by DBIx::Class::Storage::DBI::BEGIN@17 at line 17 of DBIx/Class/Storage/DBI.pm # once (56µs+175µs) by DBIx::Class::Storage::TxnScopeGuard::BEGIN@10 at line 10 of DBIx/Class/Storage/TxnScopeGuard.pm # once (53µs+171µs) by DBIx::Class::Schema::BEGIN@12 at line 12 of DBIx/Class/Schema.pm # once (49µs+163µs) by DBIx::Class::Row::BEGIN@24 at line 24 of DBIx/Class/Row.pm # once (51µs+156µs) by DBIx::Class::Schema::Versioned::BEGIN@207 at line 207 of DBIx/Class/Schema/Versioned.pm # once (45µs+156µs) by DBIx::Class::InflateColumn::DateTime::BEGIN@8 at line 8 of DBIx/Class/InflateColumn/DateTime.pm # once (50µs+148µs) by DBIx::Class::ResultSource::BEGIN@14 at line 14 of DBIx/Class/ResultSource.pm # once (43µs+151µs) by DBIx::Class::Relationship::HasMany::BEGIN@7 at line 7 of DBIx/Class/Relationship/HasMany.pm # once (43µs+146µs) by DBIx::Class::Storage::DBI::Cursor::BEGIN@9 at line 9 of DBIx/Class/Storage/DBI/Cursor.pm # once (37µs+150µs) by namespace::autoclean::BEGIN@16 at line 16 of namespace/autoclean.pm # once (43µs+141µs) by DBIx::Class::Storage::DBIHacks::BEGIN@19 at line 19 of DBIx/Class/Storage/DBIHacks.pm # once (41µs+142µs) by DBIx::Class::ResultSourceHandle::BEGIN@11 at line 11 of DBIx/Class/ResultSourceHandle.pm # once (43µs+133µs) by DBIx::Class::Relationship::Base::BEGIN@10 at line 10 of DBIx/Class/Relationship/Base.pm # once (41µs+132µs) by DBIx::Class::SQLMaker::BEGIN@48 at line 48 of DBIx/Class/SQLMaker.pm # once (39µs+132µs) by DBIx::Class::Storage::DBI::SQLite::BEGIN@11 at line 11 of DBIx/Class/Storage/DBI/SQLite.pm # once (38µs+131µs) by DBIx::Class::SQLMaker::LimitDialects::BEGIN@7 at line 7 of DBIx/Class/SQLMaker/LimitDialects.pm # once (43µs+123µs) by DBIx::Class::Storage::BEGIN@19 at line 19 of DBIx/Class/Storage.pm # once (38µs+125µs) by DBIx::Class::ResultSourceProxy::BEGIN@10 at line 10 of DBIx/Class/ResultSourceProxy.pm # once (37µs+125µs) by DBIx::Class::AccessorGroup::BEGIN@8 at line 8 of DBIx/Class/AccessorGroup.pm # once (38µs+115µs) by DBIx::Class::Relationship::HasOne::BEGIN@8 at line 8 of DBIx/Class/Relationship/HasOne.pm # once (35µs+118µs) by DBIx::Class::ResultSourceProxy::Table::BEGIN@10 at line 10 of DBIx/Class/ResultSourceProxy/Table.pm # once (35µs+106µs) by DBIx::Class::Relationship::ManyToMany::BEGIN@11 at line 11 of DBIx/Class/Relationship/ManyToMany.pm # once (35µs+94µs) by DBIx::Class::Relationship::BelongsTo::BEGIN@10 at line 10 of DBIx/Class/Relationship/BelongsTo.pm sub import {
289 | 41 | 64µs |  |  | my ($pragma, @args) = @_;
290 |  |  |  |  |
291 | 41 | 19µs |  |  | my (%args, $is_explicit);
292 |  |  |  |  |
293 |  |  |  |  | ARG:
294 | 41 | 27µs |  |  | while (@args) {
295 |  |  |  |  |
296 | 32 | 132µs | 32 | 48µs | if ($args[0] =~ /^\-/) { # spent 48µs making 32 calls to namespace::clean::CORE:match, avg 1µs/call
297 | 16 | 14µs |  |  | my $key = shift @args;
298 | 16 | 11µs |  |  | my $value = shift @args;
299 | 16 | 18µs |  |  | $args{ $key } = $value;
300 |  |  |  |  | }
301 |  |  |  |  | else {
302 | 16 | 5µs |  |  | $is_explicit++;
303 | 16 | 21µs |  |  | last ARG;
304 |  |  |  |  | }
305 |  |  |  |  | }
306 |  |  |  |  |
307 | 41 | 69µs |  |  | my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
308 | 41 | 130µs | 16 | 311µs | if ($is_explicit) { # spent 311µs making 16 calls to B::Hooks::EndOfScope::on_scope_end, avg 19µs/call
309 |  |  |  |  | # spent 3.71ms (89µs+3.62) within namespace::clean::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/namespace/clean.pm:311] which was called 16 times, avg 232µs/call: # 16 times (89µs+3.62ms) by B::Hooks::EndOfScope::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/B/Hooks/EndOfScope.pm:26] at line 26 of B/Hooks/EndOfScope.pm, avg 232µs/call on_scope_end {
310 | 16 | 98µs | 16 | 3.62ms | $RemoveSubs->($cleanee, {}, @args); # spent 3.62ms making 16 calls to namespace::clean::__ANON__[namespace/clean.pm:274], avg 226µs/call
311 |  |  |  |  | };
312 |  |  |  |  | }
313 |  |  |  |  | else {
314 |  |  |  |  |
315 |  |  |  |  | # calling class, all current functions and our storage
316 | 25 | 99µs | 25 | 1.76ms | my $functions = $pragma->get_functions($cleanee); # spent 1.76ms making 25 calls to namespace::clean::get_functions, avg 71µs/call
317 | 25 | 71µs | 25 | 908µs | my $store = $pragma->get_class_store($cleanee); # spent 908µs making 25 calls to namespace::clean::get_class_store, avg 36µs/call
318 | 25 | 151µs | 25 | 92µs | my $stash = Package::Stash->new($cleanee); # spent 92µs making 25 calls to Package::Stash::XS::new, avg 4µs/call
319 |  |  |  |  |
320 |  |  |  |  | # except parameter can be array ref or single value
321 |  |  |  |  | my %except = map {( $_ => 1 )} (
322 |  |  |  |  | $args{ -except }
323 |  |  |  |  | ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } )
324 | 25 | 38µs |  |  | : ()
325 |  |  |  |  | );
326 |  |  |  |  |
327 |  |  |  |  | # register symbols for removal, if they have a CODE entry
328 | 25 | 67µs |  |  | for my $f (keys %$functions) {
329 | 132 | 31µs |  |  | next if $except{ $f };
330 | 132 | 680µs | 289 | 613µs | next unless $stash->has_symbol("&$f"); # spent 463µs making 132 calls to Package::Stash::XS::has_symbol, avg 4µs/call # spent 138µs making 132 calls to Package::Stash::XS::namespace, avg 1µs/call # spent 11µs making 25 calls to Package::Stash::XS::name, avg 456ns/call
331 | 132 | 150µs |  |  | $store->{remove}{ $f } = 1;
332 |  |  |  |  | }
333 |  |  |  |  |
334 |  |  |  |  | # register EOF handler on first call to import
335 | 25 | 20µs |  |  | unless ($store->{handler_is_installed}) {
336 |  |  |  |  | # spent 44.1ms (160µs+43.9) within namespace::clean::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/namespace/clean.pm:338] which was called 25 times, avg 1.76ms/call: # 25 times (160µs+43.9ms) by B::Hooks::EndOfScope::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/B/Hooks/EndOfScope.pm:26] at line 26 of B/Hooks/EndOfScope.pm, avg 1.76ms/call on_scope_end {
337 | 25 | 162µs | 25 | 43.9ms | $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} }); # spent 43.9ms making 25 calls to namespace::clean::__ANON__[namespace/clean.pm:274], avg 1.76ms/call
338 | 25 | 104µs | 25 | 355µs | }; # spent 355µs making 25 calls to B::Hooks::EndOfScope::on_scope_end, avg 14µs/call
339 | 25 | 23µs |  |  | $store->{handler_is_installed} = 1;
340 |  |  |  |  | }
341 |  |  |  |  |
342 | 25 | 130µs |  |  | return 1;
343 |  |  |  |  | }
344 |  |  |  |  | }
345 |  |  |  |  |
346 |  |  |  |  | =head2 unimport
347 |  |  |  |  |
348 |  |  |  |  | This method will be called when you do a
349 |  |  |  |  |
350 |  |  |  |  | no namespace::clean;
351 |  |  |  |  |
352 |  |  |  |  | It will start a new section of code that defines functions to clean up.
353 |  |  |  |  |
354 |  |  |  |  | =cut
355 |  |  |  |  |
356 |  |  |  |  | sub unimport {
357 |  |  |  |  | my ($pragma, %args) = @_;
358 |  |  |  |  |
359 |  |  |  |  | # the calling class, the current functions and our storage
360 |  |  |  |  | my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
361 |  |  |  |  | my $functions = $pragma->get_functions($cleanee);
362 |  |  |  |  | my $store = $pragma->get_class_store($cleanee);
363 |  |  |  |  |
364 |  |  |  |  | # register all unknown previous functions as excluded
365 |  |  |  |  | for my $f (keys %$functions) {
366 |  |  |  |  | next if $store->{remove}{ $f }
367 |  |  |  |  | or $store->{exclude}{ $f };
368 |  |  |  |  | $store->{exclude}{ $f } = 1;
369 |  |  |  |  | }
370 |  |  |  |  |
371 |  |  |  |  | return 1;
372 |  |  |  |  | }
373 |  |  |  |  |
374 |  |  |  |  | =head2 get_class_store
375 |  |  |  |  |
376 |  |  |  |  | This returns a reference to a hash in a passed package containing
377 |  |  |  |  | information about function names included and excluded from removal.
378 |  |  |  |  |
379 |  |  |  |  | =cut
380 |  |  |  |  |
381 |  |  |  |  | # spent 908µs (356+552) within namespace::clean::get_class_store which was called 25 times, avg 36µs/call: # 25 times (356µs+552µs) by namespace::clean::import at line 317, avg 36µs/call sub get_class_store {
382 | 25 | 26µs |  |  | my ($pragma, $class) = @_;
383 | 25 | 169µs | 25 | 99µs | my $stash = Package::Stash->new($class); # spent 99µs making 25 calls to Package::Stash::XS::new, avg 4µs/call
384 | 25 | 32µs |  |  | my $var = "%$STORAGE_VAR";
385 | 25 | 500µs | 125 | 484µs | $stash->add_symbol($var, {}) # spent 185µs making 25 calls to Package::Stash::XS::add_symbol, avg 7µs/call # spent 181µs making 25 calls to Package::Stash::XS::has_symbol, avg 7µs/call # spent 98µs making 25 calls to Package::Stash::XS::namespace, avg 4µs/call # spent 21µs making 50 calls to Package::Stash::XS::name, avg 412ns/call
386 |  |  |  |  | unless $stash->has_symbol($var);
387 | 25 | 193µs | 50 | 98µs | return $stash->get_symbol($var); # spent 87µs making 25 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 11µs making 25 calls to Package::Stash::XS::namespace, avg 436ns/call
388 |  |  |  |  | }
389 |  |  |  |  |
390 |  |  |  |  | =head2 get_functions
391 |  |  |  |  |
392 |  |  |  |  | Takes a class as argument and returns all currently defined functions
393 |  |  |  |  | in it as a hash reference with the function name as key and a typeglob
394 |  |  |  |  | reference to the symbol as value.
395 |  |  |  |  |
396 |  |  |  |  | =cut
397 |  |  |  |  |
398 |  |  |  |  | # spent 1.76ms (615µs+1.15) within namespace::clean::get_functions which was called 25 times, avg 71µs/call: # 25 times (615µs+1.15ms) by namespace::clean::import at line 316, avg 71µs/call sub get_functions {
399 | 25 | 26µs |  |  | my ($pragma, $class) = @_;
400 |  |  |  |  |
401 | 25 | 495µs | 25 | 367µs | my $stash = Package::Stash->new($class); # spent 367µs making 25 calls to Package::Stash::XS::new, avg 15µs/call
402 |  |  |  |  | return {
403 | 25 | 1.27ms | 339 | 1.04ms | map { $_ => $stash->get_symbol("&$_") } # spent 448µs making 132 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 335µs making 25 calls to Package::Stash::XS::list_all_symbols, avg 13µs/call # spent 234µs making 157 calls to Package::Stash::XS::namespace, avg 1µs/call # spent 23µs making 25 calls to Package::Stash::XS::name, avg 916ns/call
404 |  |  |  |  | $stash->list_all_symbols('CODE')
405 |  |  |  |  | };
406 |  |  |  |  | }
407 |  |  |  |  |
408 |  |  |  |  | =head1 IMPLEMENTATION DETAILS
409 |  |  |  |  |
410 |  |  |  |  | This module works through the effect that a
411 |  |  |  |  |
412 |  |  |  |  | delete $SomePackage::{foo};
413 |  |  |  |  |
414 |  |  |  |  | will remove the C<foo> symbol from C<$SomePackage> for run time lookups
415 |  |  |  |  | (e.g., method calls) but will leave the entry alive to be called by
416 |  |  |  |  | already resolved names in the package itself. C<namespace::clean> will
417 |  |  |  |  | restore and therefor in effect keep all glob slots that aren't C<CODE>.
418 |  |  |  |  |
419 |  |  |  |  | A test file has been added to the perl core to ensure that this behaviour
420 |  |  |  |  | will be stable in future releases.
421 |  |  |  |  |
422 |  |  |  |  | Just for completeness sake, if you want to remove the symbol completely,
423 |  |  |  |  | use C<undef> instead.
424 |  |  |  |  |
425 |  |  |  |  | =head1 SEE ALSO
426 |  |  |  |  |
427 |  |  |  |  | L<B::Hooks::EndOfScope>
428 |  |  |  |  |
429 |  |  |  |  | =head1 THANKS
430 |  |  |  |  |
431 |  |  |  |  | Many thanks to Matt S Trout for the inspiration on the whole idea.
432 |  |  |  |  |
433 |  |  |  |  | =head1 AUTHORS
434 |  |  |  |  |
435 |  |  |  |  | =over
436 |  |  |  |  |
437 |  |  |  |  | =item *
438 |  |  |  |  |
439 |  |  |  |  | Robert 'phaylon' Sedlacek <rs@474.at>
440 |  |  |  |  |
441 |  |  |  |  | =item *
442 |  |  |  |  |
443 |  |  |  |  | Florian Ragwitz <rafl@debian.org>
444 |  |  |  |  |
445 |  |  |  |  | =item *
446 |  |  |  |  |
447 |  |  |  |  | Jesse Luehrs <doy@tozt.net>
448 |  |  |  |  |
449 |  |  |  |  | =item *
450 |  |  |  |  |
451 |  |  |  |  | Peter Rabbitson <ribasushi@cpan.org>
452 |  |  |  |  |
453 |  |  |  |  | =item *
454 |  |  |  |  |
455 |  |  |  |  | Father Chrysostomos <sprout@cpan.org>
456 |  |  |  |  |
457 |  |  |  |  | =back
458 |  |  |  |  |
459 |  |  |  |  | =head1 COPYRIGHT AND LICENSE
460 |  |  |  |  |
461 |  |  |  |  | This software is copyright (c) 2011 by L</AUTHORS>
462 |  |  |  |  |
463 |  |  |  |  | This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.
464 |  |  |  |  |
465 |  |  |  |  | =cut
466 |  |  |  |  |
467 | 3 | 25µs | 2 | 47µs | # spent 29µs (11+18) within namespace::clean::BEGIN@467 which was called: # once (11µs+18µs) by namespace::autoclean::BEGIN@16 at line 467 no warnings; # spent 29µs making 1 call to namespace::clean::BEGIN@467 # spent 18µs making 1 call to warnings::unimport
468 | 1 | 6µs |  |  | 'Danger! Laws of Thermodynamics may not apply.'
|  |  |  |  | # spent 48µs within namespace::clean::CORE:match which was called 32 times, avg 1µs/call: # 32 times (48µs+0s) by namespace::clean::import at line 296, avg 1µs/call sub namespace::clean::CORE:match; # opcode