| 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 | namespace::clean::__ANON__[:221] |
| 43 | 3 | 1 | 4.56ms | 48.0ms | namespace::clean::__ANON__[:274] |
| 41 | 26 | 26 | 1.46ms | 5.40ms | namespace::clean::import |
| 25 | 1 | 1 | 615µs | 1.76ms | namespace::clean::get_functions |
| 25 | 1 | 1 | 356µs | 908µs | namespace::clean::get_class_store |
| 25 | 1 | 1 | 160µs | 44.1ms | namespace::clean::__ANON__[:338] |
| 16 | 1 | 1 | 89µs | 3.71ms | namespace::clean::__ANON__[:311] |
| 32 | 1 | 1 | 48µs | 48µs | namespace::clean::CORE:match (opcode) |
| 2 | 2 | 2 | 26µs | 505µs | namespace::clean::clean_subroutines |
| 1 | 1 | 1 | 16µs | 156µs | namespace::clean::BEGIN@14 |
| 1 | 1 | 1 | 15µs | 30µs | namespace::clean::BEGIN@3 |
| 1 | 1 | 1 | 11µs | 60µs | namespace::clean::BEGIN@168 |
| 1 | 1 | 1 | 11µs | 19µs | namespace::clean::BEGIN@7 |
| 1 | 1 | 1 | 11µs | 29µs | namespace::clean::BEGIN@467 |
| 1 | 1 | 1 | 9µs | 13µs | namespace::clean::BEGIN@171 |
| 1 | 1 | 1 | 8µs | 12µs | namespace::clean::BEGIN@4 |
| 1 | 1 | 1 | 8µs | 32µs | namespace::clean::BEGIN@169 |
| 1 | 1 | 1 | 8µs | 36µs | namespace::clean::BEGIN@6 |
| 0 | 0 | 0 | 0s | 0s | namespace::clean::unimport |
| 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 |