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 |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
145 | 1 | 1 | 18.2ms | 39.8ms | __ANON__[:221] | namespace::clean::
43 | 3 | 1 | 4.56ms | 48.0ms | __ANON__[:274] | namespace::clean::
41 | 26 | 26 | 1.46ms | 5.40ms | import | namespace::clean::
25 | 1 | 1 | 615µs | 1.76ms | get_functions | namespace::clean::
25 | 1 | 1 | 356µs | 908µs | get_class_store | namespace::clean::
25 | 1 | 1 | 160µs | 44.1ms | __ANON__[:338] | namespace::clean::
16 | 1 | 1 | 89µs | 3.71ms | __ANON__[:311] | namespace::clean::
32 | 1 | 1 | 48µs | 48µs | CORE:match (opcode) | namespace::clean::
2 | 2 | 2 | 26µs | 505µs | clean_subroutines | namespace::clean::
1 | 1 | 1 | 16µs | 156µs | BEGIN@14 | namespace::clean::
1 | 1 | 1 | 15µs | 30µs | BEGIN@3 | namespace::clean::
1 | 1 | 1 | 11µs | 60µs | BEGIN@168 | namespace::clean::
1 | 1 | 1 | 11µs | 19µs | BEGIN@7 | namespace::clean::
1 | 1 | 1 | 11µs | 29µs | BEGIN@467 | namespace::clean::
1 | 1 | 1 | 9µs | 13µs | BEGIN@171 | namespace::clean::
1 | 1 | 1 | 8µs | 12µs | BEGIN@4 | namespace::clean::
1 | 1 | 1 | 8µs | 32µs | BEGIN@169 | namespace::clean::
1 | 1 | 1 | 8µs | 36µs | BEGIN@6 | namespace::clean::
0 | 0 | 0 | 0s | 0s | unimport | namespace::clean::
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 # 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 # 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 # 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 # 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 | ||||
15 | # when changing also change in Makefile.PL | ||||
16 | 5 | 29µs | my $b_h_eos_req = '0.10'; | ||
17 | |||||
18 | 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 | require B::Hooks::EndOfScope; | ||||
20 | 1 | 13µs | B::Hooks::EndOfScope->VERSION($b_h_eos_req); # spent 13µs making 1 call to UNIVERSAL::VERSION | ||
21 | 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 # 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 # 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 # 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 | ||||
192 | 590 | 17.1ms | my ($f, $sub, $cleanee_stash, $deleted_stash) = @_; | ||
193 | |||||
194 | if (FIXUP_RENAME_SUB) { | ||||
195 | if (! defined $sub_utils_loaded ) { | ||||
196 | $sub_utils_loaded = do { | ||||
197 | |||||
198 | # when changing version also change in Makefile.PL | ||||
199 | my $sn_ver = 0.04; | ||||
200 | 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 | my $si_ver = 0.04; | ||||
205 | 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; | ||||
209 | } ? 1 : 0; | ||||
210 | } | ||||
211 | |||||
212 | 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 | ||||
224 | 3338 | 8.12ms | my $cleanee = shift; | ||
225 | my $store = shift; | ||||
226 | 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 | my $deleted_stash; | ||||
228 | |||||
229 | SYMBOL: | ||||
230 | for my $f (@_) { | ||||
231 | |||||
232 | # ignore already removed symbols | ||||
233 | next SYMBOL if $store->{exclude}{ $f }; | ||||
234 | |||||
235 | 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 | 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 | 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 | my @symbols = map { | ||||
258 | my $name = $_ . $f; | ||||
259 | 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 | defined($def) ? [$name, $def] : () | ||||
261 | } '$', '@', '%', ''; | ||||
262 | |||||
263 | 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 | if (FIXUP_NEEDED && !FIXUP_RENAME_SUB && $need_debugger_fixup) { | ||||
269 | *$globref = $deleted_stash->namespace->{$f}; | ||||
270 | } | ||||
271 | |||||
272 | $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 | ||||
277 | 4 | 27µs | my ($nc, $cleanee, @subs) = @_; | ||
278 | 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 | ||||
289 | 938 | 2.07ms | my ($pragma, @args) = @_; | ||
290 | |||||
291 | my (%args, $is_explicit); | ||||
292 | |||||
293 | ARG: | ||||
294 | while (@args) { | ||||
295 | |||||
296 | 32 | 48µs | if ($args[0] =~ /^\-/) { # spent 48µs making 32 calls to namespace::clean::CORE:match, avg 1µs/call | ||
297 | my $key = shift @args; | ||||
298 | my $value = shift @args; | ||||
299 | $args{ $key } = $value; | ||||
300 | } | ||||
301 | else { | ||||
302 | $is_explicit++; | ||||
303 | last ARG; | ||||
304 | } | ||||
305 | } | ||||
306 | |||||
307 | my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller; | ||||
308 | 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 | ||||
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 | 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 | 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 | 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 | : () | ||||
325 | ); | ||||
326 | |||||
327 | # register symbols for removal, if they have a CODE entry | ||||
328 | for my $f (keys %$functions) { | ||||
329 | next if $except{ $f }; | ||||
330 | 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 | $store->{remove}{ $f } = 1; | ||||
332 | } | ||||
333 | |||||
334 | # register EOF handler on first call to import | ||||
335 | 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 | ||||
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 | 355µs | }; # spent 355µs making 25 calls to B::Hooks::EndOfScope::on_scope_end, avg 14µs/call | ||
339 | $store->{handler_is_installed} = 1; | ||||
340 | } | ||||
341 | |||||
342 | 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 | ||||
382 | 125 | 920µs | my ($pragma, $class) = @_; | ||
383 | 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 | my $var = "%$STORAGE_VAR"; | ||||
385 | 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 | 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 | ||||
399 | 75 | 1.79ms | my ($pragma, $class) = @_; | ||
400 | |||||
401 | 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 | 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 # 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 |