← 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
StatementsExecuted 5149 statements in 31.6ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1451118.2ms39.8msnamespace::clean::::__ANON__[:221]namespace::clean::__ANON__[:221]
43314.56ms48.0msnamespace::clean::::__ANON__[:274]namespace::clean::__ANON__[:274]
4126261.46ms5.40msnamespace::clean::::importnamespace::clean::import
2511615µs1.76msnamespace::clean::::get_functionsnamespace::clean::get_functions
2511356µs908µsnamespace::clean::::get_class_storenamespace::clean::get_class_store
2511160µs44.1msnamespace::clean::::__ANON__[:338]namespace::clean::__ANON__[:338]
161189µs3.71msnamespace::clean::::__ANON__[:311]namespace::clean::__ANON__[:311]
321148µs48µsnamespace::clean::::CORE:matchnamespace::clean::CORE:match (opcode)
22226µs505µsnamespace::clean::::clean_subroutinesnamespace::clean::clean_subroutines
11116µs156µsnamespace::clean::::BEGIN@14namespace::clean::BEGIN@14
11115µs30µsnamespace::clean::::BEGIN@3namespace::clean::BEGIN@3
11111µs60µsnamespace::clean::::BEGIN@168namespace::clean::BEGIN@168
11111µs19µsnamespace::clean::::BEGIN@7namespace::clean::BEGIN@7
11111µs29µsnamespace::clean::::BEGIN@467namespace::clean::BEGIN@467
1119µs13µsnamespace::clean::::BEGIN@171namespace::clean::BEGIN@171
1118µs12µsnamespace::clean::::BEGIN@4namespace::clean::BEGIN@4
1118µs32µsnamespace::clean::::BEGIN@169namespace::clean::BEGIN@169
1118µs36µsnamespace::clean::::BEGIN@6namespace::clean::BEGIN@6
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
3320µs245µ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
4321µs216µ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
6318µs264µ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
73116µs228µ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;
8
91400nsour $VERSION = '0.23';
10
111500ns$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
161400ns my $b_h_eos_req = '0.10';
17
1817µs1127µs if (! $ENV{NAMESPACE_CLEAN_USE_PP} and eval {
# spent 127µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756]
191500ns require B::Hooks::EndOfScope;
20120µs113µs B::Hooks::EndOfScope->VERSION($b_h_eos_req);
# spent 13µs making 1 call to UNIVERSAL::VERSION
211700ns 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 }
33180µs1156µs}
# spent 156µs making 1 call to namespace::clean::BEGIN@14
34
35=head1 NAME
36
37namespace::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
74When you define a function, or import one, into a Perl package, it will
75naturally also be available as a method. This does not per se cause
76problems, but it can complicate subclassing and, for example, plugin
77classes that are included via multiple inheritance by loading them as
78base classes.
79
80The C<namespace::clean> pragma will remove all previously declared or
81imported symbols at the end of the current package's compile cycle.
82Functions called in the package itself will still be bound by their
83name, but they won't show up as methods on your class or instances.
84
85By unimporting via C<no> you can tell C<namespace::clean> to start
86collecting functions for the next C<use namespace::clean;> specification.
87
88You can use the C<-except> flag to tell C<namespace::clean> that you
89don't want it to remove a certain function or method. A common use would
90be a module exporting an C<import> method along with some functions:
91
92 use ModuleExportingImport;
93 use namespace::clean -except => [qw( import )];
94
95If you just want to C<-except> a single sub, you can pass it directly.
96For more than one value you have to use an array reference.
97
98=head2 Explicitly removing functions when your scope is compiled
99
100It is also possible to explicitly tell C<namespace::clean> what packages
101to remove when the surrounding scope has finished compiling. Here is an
102example:
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
121When using C<namespace::clean> together with L<Moose> you want to keep
122the 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
129Same goes for L<Moose::Role>.
130
131=head2 Cleaning other packages
132
133You can tell C<namespace::clean> that you want to clean up another package
134instead of the one importing. To do this you have to pass in the C<-cleanee>
135option 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
149If you don't care about C<namespace::clean>s discover-and-C<-except> logic, and
150just want to remove subroutines, try L</clean_subroutines>.
151
152=head1 METHODS
153
154=head2 clean_subroutines
155
156This exposes the actual subroutine-removal logic.
157
158 namespace::clean->clean_subroutines($cleanee, qw( subA subB ));
159
160will remove C<subA> and C<subB> from C<$cleanee>. Note that this will remove the
161subroutines B<immediately> and not wait for scope end. If you want to have this
162effect at a specific time (e.g. C<namespace::clean> acts on scope compile end)
163it is your responsibility to make sure it runs at that time.
164
165=cut
166
167# Constant to optimise away the unused code branches
168331µs2109µ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
169320µs256µ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{
1714883µs217µ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
17212µs delete ${__PACKAGE__."::"}{FIXUP_NEEDED};
1731900ns 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.
1901100nsmy $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 {
192145116µs my ($f, $sub, $cleanee_stash, $deleted_stash) = @_;
193
194145384µs if (FIXUP_RENAME_SUB) {
19514536µs if (! defined $sub_utils_loaded ) {
19612µs $sub_utils_loaded = do {
197
198 # when changing version also change in Makefile.PL
1991200ns my $sn_ver = 0.04;
200324µs111µ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
2041400ns my $si_ver = 0.04;
205315.9ms150µ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
20812µs 1;
209 } ? 1 : 0;
210 }
211
212145623µs290803µ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 }
22113µ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 {
2244340µs my $cleanee = shift;
2254321µs my $store = shift;
22643648µs43413µs my $cleanee_stash = Package::Stash->new($cleanee);
# spent 413µs making 43 calls to Package::Stash::XS::new, avg 10µs/call
227438µs my $deleted_stash;
228
229 SYMBOL:
23043223µs for my $f (@_) {
231
232 # ignore already removed symbols
233184112µs next SYMBOL if $store->{exclude}{ $f };
234
2351841.31ms4111.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
238145554µs14577µ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
246145574µs18840.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
257580208µs my @symbols = map {
258145235µs my $name = $_ . $f;
2595802.86ms11601.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
260580197µs defined($def) ? [$name, $def] : ()
261 } '$', '@', '%', '';
262
263145725µs290487µ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
26814517µs if (FIXUP_NEEDED && !FIXUP_RENAME_SUB && $need_debugger_fixup) {
269 *$globref = $deleted_stash->namespace->{$f};
270 }
271
272290394µs $cleanee_stash->add_symbol(@$_) for @symbols;
273 }
27413µ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 {
27726µs my ($nc, $cleanee, @subs) = @_;
278221µs2479µ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
283Makes a snapshot of the current defined functions and installs a
284L<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 {
2894164µs my ($pragma, @args) = @_;
290
2914119µs my (%args, $is_explicit);
292
293 ARG:
2944127µs while (@args) {
295
29632132µs3248µs if ($args[0] =~ /^\-/) {
# spent 48µs making 32 calls to namespace::clean::CORE:match, avg 1µs/call
2971614µs my $key = shift @args;
2981611µs my $value = shift @args;
2991618µs $args{ $key } = $value;
300 }
301 else {
302165µs $is_explicit++;
3031621µs last ARG;
304 }
305 }
306
3074169µs my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
30841130µs16311µ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 {
3101698µs163.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
3162599µs251.76ms my $functions = $pragma->get_functions($cleanee);
# spent 1.76ms making 25 calls to namespace::clean::get_functions, avg 71µs/call
3172571µs25908µs my $store = $pragma->get_class_store($cleanee);
# spent 908µs making 25 calls to namespace::clean::get_class_store, avg 36µs/call
31825151µs2592µ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 } )
3242538µs : ()
325 );
326
327 # register symbols for removal, if they have a CODE entry
3282567µs for my $f (keys %$functions) {
32913231µs next if $except{ $f };
330132680µs289613µ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
331132150µs $store->{remove}{ $f } = 1;
332 }
333
334 # register EOF handler on first call to import
3352520µ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 {
33725162µs2543.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
33825104µs25355µs };
# spent 355µs making 25 calls to B::Hooks::EndOfScope::on_scope_end, avg 14µs/call
3392523µs $store->{handler_is_installed} = 1;
340 }
341
34225130µs return 1;
343 }
344}
345
346=head2 unimport
347
348This method will be called when you do a
349
350 no namespace::clean;
351
352It will start a new section of code that defines functions to clean up.
353
354=cut
355
356sub 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
376This returns a reference to a hash in a passed package containing
377information 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 {
3822526µs my ($pragma, $class) = @_;
38325169µs2599µs my $stash = Package::Stash->new($class);
# spent 99µs making 25 calls to Package::Stash::XS::new, avg 4µs/call
3842532µs my $var = "%$STORAGE_VAR";
38525500µs125484µ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);
38725193µs5098µ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
392Takes a class as argument and returns all currently defined functions
393in it as a hash reference with the function name as key and a typeglob
394reference 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 {
3992526µs my ($pragma, $class) = @_;
400
40125495µs25367µs my $stash = Package::Stash->new($class);
# spent 367µs making 25 calls to Package::Stash::XS::new, avg 15µs/call
402 return {
403251.27ms3391.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
410This module works through the effect that a
411
412 delete $SomePackage::{foo};
413
414will 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
416already resolved names in the package itself. C<namespace::clean> will
417restore and therefor in effect keep all glob slots that aren't C<CODE>.
418
419A test file has been added to the perl core to ensure that this behaviour
420will be stable in future releases.
421
422Just for completeness sake, if you want to remove the symbol completely,
423use C<undef> instead.
424
425=head1 SEE ALSO
426
427L<B::Hooks::EndOfScope>
428
429=head1 THANKS
430
431Many thanks to Matt S Trout for the inspiration on the whole idea.
432
433=head1 AUTHORS
434
435=over
436
437=item *
438
439Robert 'phaylon' Sedlacek <rs@474.at>
440
441=item *
442
443Florian Ragwitz <rafl@debian.org>
444
445=item *
446
447Jesse Luehrs <doy@tozt.net>
448
449=item *
450
451Peter Rabbitson <ribasushi@cpan.org>
452
453=item *
454
455Father Chrysostomos <sprout@cpan.org>
456
457=back
458
459=head1 COPYRIGHT AND LICENSE
460
461This software is copyright (c) 2011 by L</AUTHORS>
462
463This 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
467325µs247µ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
46816µ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