| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/namespace/clean.pm |
| Statements | Executed 4295 statements in 6.60ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 20 | 1 | 1 | 1.87ms | 3.70ms | namespace::clean::__ANON__[:121] |
| 20 | 20 | 20 | 687µs | 2.83ms | namespace::clean::import |
| 20 | 1 | 1 | 411µs | 1.09ms | namespace::clean::get_functions |
| 20 | 1 | 1 | 181µs | 450µs | namespace::clean::get_class_store |
| 1 | 1 | 1 | 174µs | 1.51ms | namespace::clean::BEGIN@11 |
| 1 | 1 | 1 | 173µs | 318µs | namespace::clean::BEGIN@38 |
| 20 | 1 | 1 | 86µs | 3.79ms | namespace::clean::__ANON__[:178] |
| 1 | 1 | 1 | 32µs | 32µs | namespace::clean::BEGIN@16 |
| 1 | 1 | 1 | 8µs | 12µs | namespace::clean::BEGIN@3 |
| 1 | 1 | 1 | 4µs | 6µs | namespace::clean::BEGIN@4 |
| 1 | 1 | 1 | 600ns | 600ns | namespace::clean::CORE:match (opcode) |
| 0 | 0 | 0 | 0s | 0s | namespace::clean::__ANON__[:151] |
| 0 | 0 | 0 | 0s | 0s | namespace::clean::clean_subroutines |
| 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 | 2 | 15µs | 2 | 16µs | # spent 12µs (8+4) within namespace::clean::BEGIN@3 which was called:
# once (8µs+4µs) by Search::Elasticsearch::BEGIN@6 at line 3 # spent 12µs making 1 call to namespace::clean::BEGIN@3
# spent 4µs making 1 call to warnings::import |
| 4 | 2 | 43µs | 2 | 7µs | # spent 6µs (4+1) within namespace::clean::BEGIN@4 which was called:
# once (4µs+1µs) by Search::Elasticsearch::BEGIN@6 at line 4 # spent 6µs making 1 call to namespace::clean::BEGIN@4
# spent 1µs making 1 call to strict::import |
| 5 | |||||
| 6 | 1 | 300ns | our $VERSION = '0.26'; | ||
| 7 | 1 | 7µs | 1 | 600ns | $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases # spent 600ns making 1 call to namespace::clean::CORE:match |
| 8 | |||||
| 9 | 1 | 100ns | our $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE'; | ||
| 10 | |||||
| 11 | 2 | 99µs | 2 | 1.53ms | # spent 1.51ms (174µs+1.33) within namespace::clean::BEGIN@11 which was called:
# once (174µs+1.33ms) by Search::Elasticsearch::BEGIN@6 at line 11 # spent 1.51ms making 1 call to namespace::clean::BEGIN@11
# spent 21µs making 1 call to Sub::Exporter::Progressive::__ANON__[Sub/Exporter/Progressive.pm:40] |
| 12 | |||||
| 13 | # FIXME This is a crock of shit, needs to go away | ||||
| 14 | # currently here to work around https://rt.cpan.org/Ticket/Display.html?id=74151 | ||||
| 15 | # kill with fire when PS::XS is *finally* fixed | ||||
| 16 | # spent 32µs within namespace::clean::BEGIN@16 which was called:
# once (32µs+0s) by Search::Elasticsearch::BEGIN@6 at line 36 | ||||
| 17 | 1 | 100ns | my $provider; | ||
| 18 | |||||
| 19 | 1 | 500ns | if ( $] < 5.008007 ) { | ||
| 20 | require Package::Stash::PP; | ||||
| 21 | $provider = 'Package::Stash::PP'; | ||||
| 22 | } | ||||
| 23 | else { | ||||
| 24 | 1 | 400ns | require Package::Stash; | ||
| 25 | 1 | 300ns | $provider = 'Package::Stash'; | ||
| 26 | } | ||||
| 27 | 1 | 29µs | eval <<"EOS" or die $@; # spent 531µs executing statements in string eval # includes 198µs spent executing 80 calls to 1 sub defined therein. | ||
| 28 | |||||
| 29 | sub stash_for (\$) { | ||||
| 30 | $provider->new(\$_[0]); | ||||
| 31 | } | ||||
| 32 | |||||
| 33 | 1; | ||||
| 34 | |||||
| 35 | EOS | ||||
| 36 | 1 | 14µs | 1 | 32µs | } # spent 32µs making 1 call to namespace::clean::BEGIN@16 |
| 37 | |||||
| 38 | 2 | 523µs | 2 | 340µs | # spent 318µs (173+144) within namespace::clean::BEGIN@38 which was called:
# once (173µs+144µs) by Search::Elasticsearch::BEGIN@6 at line 38 # spent 318µs making 1 call to namespace::clean::BEGIN@38
# spent 22µs making 1 call to Exporter::import |
| 39 | |||||
| 40 | # Built-in debugger CV-retrieval fixups necessary before perl 5.15.5: | ||||
| 41 | # since we are deleting the glob where the subroutine was originally | ||||
| 42 | # defined, the assumptions below no longer hold. | ||||
| 43 | # | ||||
| 44 | # In 5.8.9 ~ 5.13.5 (inclusive) the debugger assumes that a CV can | ||||
| 45 | # always be found under sub_fullname($sub) | ||||
| 46 | # Workaround: use sub naming to properly name the sub hidden in the package's | ||||
| 47 | # deleted-stash | ||||
| 48 | # | ||||
| 49 | # In the rest of the range ( ... ~ 5.8.8 and 5.13.6 ~ 5.15.4 ) the debugger | ||||
| 50 | # assumes the name of the glob passed to entersub can be used to find the CV | ||||
| 51 | # Workaround: realias the original glob to the deleted-stash slot | ||||
| 52 | # | ||||
| 53 | # Can not tie constants to the current value of $^P directly, | ||||
| 54 | # as the debugger can be enabled during runtime (kinda dubious) | ||||
| 55 | # | ||||
| 56 | |||||
| 57 | # spent 3.70ms (1.87+1.83) within namespace::clean::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/namespace/clean.pm:121] which was called 20 times, avg 185µs/call:
# 20 times (1.87ms+1.83ms) by namespace::clean::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/namespace/clean.pm:178] at line 177, avg 185µs/call | ||||
| 58 | 20 | 10µs | my $cleanee = shift; | ||
| 59 | 20 | 5µs | my $store = shift; | ||
| 60 | 20 | 22µs | 20 | 139µs | my $cleanee_stash = stash_for($cleanee); # spent 139µs making 20 calls to namespace::clean::stash_for, avg 7µs/call |
| 61 | 20 | 4µs | my $deleted_stash; | ||
| 62 | |||||
| 63 | SYMBOL: | ||||
| 64 | 20 | 64µs | for my $f (@_) { | ||
| 65 | |||||
| 66 | # ignore already removed symbols | ||||
| 67 | 177 | 37µs | next SYMBOL if $store->{exclude}{ $f }; | ||
| 68 | |||||
| 69 | 177 | 621µs | 374 | 448µs | my $sub = $cleanee_stash->get_symbol("&$f") # spent 363µs making 177 calls to Package::Stash::XS::get_symbol, avg 2µs/call
# spent 78µs making 177 calls to Package::Stash::XS::namespace, avg 444ns/call
# spent 7µs making 20 calls to Package::Stash::XS::name, avg 350ns/call |
| 70 | or next SYMBOL; | ||||
| 71 | |||||
| 72 | my $need_debugger_fixup = | ||||
| 73 | ( DEBUGGER_NEEDS_CV_RENAME or DEBUGGER_NEEDS_CV_PIVOT ) | ||||
| 74 | && | ||||
| 75 | $^P | ||||
| 76 | && | ||||
| 77 | 177 | 25µs | ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB' | ||
| 78 | && | ||||
| 79 | ( $deleted_stash ||= stash_for("namespace::clean::deleted::$cleanee") ) | ||||
| 80 | ; | ||||
| 81 | |||||
| 82 | # convince the Perl debugger to work | ||||
| 83 | # see the comment on top | ||||
| 84 | if ( DEBUGGER_NEEDS_CV_RENAME and $need_debugger_fixup ) { | ||||
| 85 | # | ||||
| 86 | # Note - both get_subname and set_subname are only compiled when CV_RENAME | ||||
| 87 | # is true ( the 5.8.9 ~ 5.12 range ). On other perls this entire block is | ||||
| 88 | # constant folded away, and so are the definitions in ::_Util | ||||
| 89 | # | ||||
| 90 | # Do not be surprised that they are missing without DEBUGGER_NEEDS_CV_RENAME | ||||
| 91 | # | ||||
| 92 | namespace::clean::_Util::get_subname( $sub ) eq ( $cleanee_stash->name . "::$f" ) | ||||
| 93 | and | ||||
| 94 | $deleted_stash->add_symbol( | ||||
| 95 | "&$f", | ||||
| 96 | namespace::clean::_Util::set_subname( $deleted_stash->name . "::$f", $sub ), | ||||
| 97 | ); | ||||
| 98 | } | ||||
| 99 | elsif ( DEBUGGER_NEEDS_CV_PIVOT and $need_debugger_fixup ) { | ||||
| 100 | $deleted_stash->add_symbol("&$f", $sub); | ||||
| 101 | } | ||||
| 102 | |||||
| 103 | my @symbols = map { | ||||
| 104 | 885 | 266µs | my $name = $_ . $f; | ||
| 105 | 708 | 1.74ms | 1416 | 1.06ms | my $def = $cleanee_stash->get_symbol($name); # spent 979µs making 708 calls to Package::Stash::XS::get_symbol, avg 1µs/call
# spent 84µs making 708 calls to Package::Stash::XS::namespace, avg 119ns/call |
| 106 | 708 | 103µs | defined($def) ? [$name, $def] : () | ||
| 107 | } '$', '@', '%', ''; | ||||
| 108 | |||||
| 109 | 177 | 548µs | 354 | 369µs | $cleanee_stash->remove_glob($f); # spent 347µs making 177 calls to Package::Stash::XS::remove_glob, avg 2µs/call
# spent 22µs making 177 calls to Package::Stash::XS::namespace, avg 125ns/call |
| 110 | |||||
| 111 | # if this perl needs no renaming trick we need to | ||||
| 112 | # rename the original glob after the fact | ||||
| 113 | DEBUGGER_NEEDS_CV_PIVOT | ||||
| 114 | and | ||||
| 115 | $need_debugger_fixup | ||||
| 116 | and | ||||
| 117 | *$globref = $deleted_stash->namespace->{$f}; | ||||
| 118 | |||||
| 119 | 177 | 95µs | $cleanee_stash->add_symbol(@$_) for @symbols; | ||
| 120 | } | ||||
| 121 | 1 | 2µs | }; | ||
| 122 | |||||
| 123 | sub clean_subroutines { | ||||
| 124 | my ($nc, $cleanee, @subs) = @_; | ||||
| 125 | $RemoveSubs->($cleanee, {}, @subs); | ||||
| 126 | } | ||||
| 127 | |||||
| 128 | # spent 2.83ms (687µs+2.14) within namespace::clean::import which was called 20 times, avg 142µs/call:
# once (81µs+236µs) by Search::Elasticsearch::Role::Transport::BEGIN@9 at line 9 of Search/Elasticsearch/Role/Transport.pm
# once (42µs+156µs) by Search::Elasticsearch::CxnPool::Static::BEGIN@7 at line 7 of Search/Elasticsearch/CxnPool/Static.pm
# once (43µs+135µs) by Search::Elasticsearch::Role::Cxn::BEGIN@13 at line 13 of Search/Elasticsearch/Role/Cxn.pm
# once (44µs+132µs) by Search::Elasticsearch::Role::CxnPool::Static::BEGIN@7 at line 7 of Search/Elasticsearch/Role/CxnPool/Static.pm
# once (36µs+136µs) by Search::Elasticsearch::Role::Client::Direct::BEGIN@10 at line 10 of Search/Elasticsearch/Role/Client/Direct.pm
# once (39µs+125µs) by Search::Elasticsearch::Role::CxnPool::BEGIN@9 at line 9 of Search/Elasticsearch/Role/CxnPool.pm
# once (39µs+120µs) by Search::Elasticsearch::Transport::BEGIN@9 at line 9 of Search/Elasticsearch/Transport.pm
# once (35µs+107µs) by Search::Elasticsearch::Serializer::JSON::BEGIN@9 at line 9 of Search/Elasticsearch/Serializer/JSON.pm
# once (35µs+101µs) by Search::Elasticsearch::Role::Serializer::JSON::BEGIN@9 at line 9 of Search/Elasticsearch/Role/Serializer/JSON.pm
# once (34µs+101µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@7 at line 7 of Search/Elasticsearch/Cxn/HTTPTiny.pm
# once (31µs+92µs) by Search::Elasticsearch::Client::5_0::Direct::BEGIN@8 at line 8 of Search/Elasticsearch/Client/5_0/Direct.pm
# once (33µs+83µs) by Search::Elasticsearch::Cxn::Factory::BEGIN@5 at line 5 of Search/Elasticsearch/Cxn/Factory.pm
# once (28µs+86µs) by Search::Elasticsearch::Role::Logger::BEGIN@8 at line 8 of Search/Elasticsearch/Role/Logger.pm
# once (21µs+88µs) by Search::Elasticsearch::BEGIN@6 at line 6 of Search/Elasticsearch.pm
# once (26µs+78µs) by Search::Elasticsearch::Role::API::BEGIN@8 at line 8 of Search/Elasticsearch/Role/API.pm
# once (26µs+78µs) by Search::Elasticsearch::Logger::LogAny::BEGIN@6 at line 6 of Search/Elasticsearch/Logger/LogAny.pm
# once (25µs+75µs) by Search::Elasticsearch::Role::Is_Sync::BEGIN@4 at line 4 of Search/Elasticsearch/Role/Is_Sync.pm
# once (24µs+74µs) by Search::Elasticsearch::Client::5_0::Role::API::BEGIN@7 at line 7 of Search/Elasticsearch/Client/5_0/Role/API.pm
# once (22µs+72µs) by BenchmarkAnything::Storage::Search::Elasticsearch::Serializer::JSON::DontTouchMyUTF8::BEGIN@16 at line 16 of BenchmarkAnything/Storage/Search/Elasticsearch/Serializer/JSON/DontTouchMyUTF8.pm
# once (22µs+69µs) by Search::Elasticsearch::Role::Client::BEGIN@4 at line 4 of Search/Elasticsearch/Role/Client.pm | ||||
| 129 | 20 | 13µs | my ($pragma, @args) = @_; | ||
| 130 | |||||
| 131 | 20 | 4µs | my (%args, $is_explicit); | ||
| 132 | |||||
| 133 | ARG: | ||||
| 134 | 20 | 15µs | while (@args) { | ||
| 135 | |||||
| 136 | if ($args[0] =~ /^\-/) { | ||||
| 137 | my $key = shift @args; | ||||
| 138 | my $value = shift @args; | ||||
| 139 | $args{ $key } = $value; | ||||
| 140 | } | ||||
| 141 | else { | ||||
| 142 | $is_explicit++; | ||||
| 143 | last ARG; | ||||
| 144 | } | ||||
| 145 | } | ||||
| 146 | |||||
| 147 | 20 | 26µs | my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller; | ||
| 148 | 20 | 6µs | if ($is_explicit) { | ||
| 149 | on_scope_end { | ||||
| 150 | $RemoveSubs->($cleanee, {}, @args); | ||||
| 151 | }; | ||||
| 152 | } | ||||
| 153 | else { | ||||
| 154 | |||||
| 155 | # calling class, all current functions and our storage | ||||
| 156 | 20 | 51µs | 20 | 1.09ms | my $functions = $pragma->get_functions($cleanee); # spent 1.09ms making 20 calls to namespace::clean::get_functions, avg 55µs/call |
| 157 | 20 | 37µs | 20 | 450µs | my $store = $pragma->get_class_store($cleanee); # spent 450µs making 20 calls to namespace::clean::get_class_store, avg 22µs/call |
| 158 | 20 | 16µs | 20 | 52µs | my $stash = stash_for($cleanee); # spent 52µs making 20 calls to namespace::clean::stash_for, avg 3µs/call |
| 159 | |||||
| 160 | # except parameter can be array ref or single value | ||||
| 161 | my %except = map {( $_ => 1 )} ( | ||||
| 162 | $args{ -except } | ||||
| 163 | ? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } ) | ||||
| 164 | 20 | 30µs | : () | ||
| 165 | ); | ||||
| 166 | |||||
| 167 | # register symbols for removal, if they have a CODE entry | ||||
| 168 | 20 | 40µs | for my $f (keys %$functions) { | ||
| 169 | 177 | 21µs | next if $except{ $f }; | ||
| 170 | 177 | 464µs | 374 | 344µs | next unless $stash->has_symbol("&$f"); # spent 287µs making 177 calls to Package::Stash::XS::has_symbol, avg 2µs/call
# spent 54µs making 177 calls to Package::Stash::XS::namespace, avg 306ns/call
# spent 3µs making 20 calls to Package::Stash::XS::name, avg 170ns/call |
| 171 | 177 | 83µs | $store->{remove}{ $f } = 1; | ||
| 172 | } | ||||
| 173 | |||||
| 174 | # register EOF handler on first call to import | ||||
| 175 | 20 | 11µs | unless ($store->{handler_is_installed}) { | ||
| 176 | # spent 3.79ms (86µs+3.70) within namespace::clean::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/namespace/clean.pm:178] which was called 20 times, avg 189µs/call:
# 20 times (86µs+3.70ms) by B::Hooks::EndOfScope::XS::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/B/Hooks/EndOfScope/XS.pm:17] at line 17 of B/Hooks/EndOfScope/XS.pm, avg 189µs/call | ||||
| 177 | 20 | 88µs | 20 | 3.70ms | $RemoveSubs->($cleanee, $store, keys %{ $store->{remove} }); # spent 3.70ms making 20 calls to namespace::clean::__ANON__[namespace/clean.pm:121], avg 185µs/call |
| 178 | 20 | 56µs | 20 | 264µs | }; # spent 264µs making 20 calls to B::Hooks::EndOfScope::XS::on_scope_end, avg 13µs/call |
| 179 | 20 | 12µs | $store->{handler_is_installed} = 1; | ||
| 180 | } | ||||
| 181 | |||||
| 182 | 20 | 93µs | return 1; | ||
| 183 | } | ||||
| 184 | } | ||||
| 185 | |||||
| 186 | sub unimport { | ||||
| 187 | my ($pragma, %args) = @_; | ||||
| 188 | |||||
| 189 | # the calling class, the current functions and our storage | ||||
| 190 | my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller; | ||||
| 191 | my $functions = $pragma->get_functions($cleanee); | ||||
| 192 | my $store = $pragma->get_class_store($cleanee); | ||||
| 193 | |||||
| 194 | # register all unknown previous functions as excluded | ||||
| 195 | for my $f (keys %$functions) { | ||||
| 196 | next if $store->{remove}{ $f } | ||||
| 197 | or $store->{exclude}{ $f }; | ||||
| 198 | $store->{exclude}{ $f } = 1; | ||||
| 199 | } | ||||
| 200 | |||||
| 201 | return 1; | ||||
| 202 | } | ||||
| 203 | |||||
| 204 | # spent 450µs (181+269) within namespace::clean::get_class_store which was called 20 times, avg 22µs/call:
# 20 times (181µs+269µs) by namespace::clean::import at line 157, avg 22µs/call | ||||
| 205 | 20 | 7µs | my ($pragma, $class) = @_; | ||
| 206 | 20 | 13µs | 20 | 64µs | my $stash = stash_for($class); # spent 64µs making 20 calls to namespace::clean::stash_for, avg 3µs/call |
| 207 | 20 | 14µs | my $var = "%$STORAGE_VAR"; | ||
| 208 | 20 | 252µs | 100 | 218µs | $stash->add_symbol($var, {}) # spent 88µs making 20 calls to Package::Stash::XS::add_symbol, avg 4µs/call
# spent 82µs making 20 calls to Package::Stash::XS::has_symbol, avg 4µs/call
# spent 44µs making 40 calls to Package::Stash::XS::namespace, avg 1µs/call
# spent 4µs making 20 calls to Package::Stash::XS::name, avg 220ns/call |
| 209 | unless $stash->has_symbol($var); | ||||
| 210 | 20 | 90µs | 40 | 38µs | return $stash->get_symbol($var); # spent 36µs making 20 calls to Package::Stash::XS::get_symbol, avg 2µs/call
# spent 3µs making 20 calls to Package::Stash::XS::namespace, avg 140ns/call |
| 211 | } | ||||
| 212 | |||||
| 213 | # spent 1.09ms (411µs+679µs) within namespace::clean::get_functions which was called 20 times, avg 55µs/call:
# 20 times (411µs+679µs) by namespace::clean::import at line 156, avg 55µs/call | ||||
| 214 | 20 | 9µs | my ($pragma, $class) = @_; | ||
| 215 | |||||
| 216 | 20 | 26µs | 20 | 196µs | my $stash = stash_for($class); # spent 196µs making 20 calls to namespace::clean::stash_for, avg 10µs/call |
| 217 | return { | ||||
| 218 | 20 | 854µs | 414 | 604µs | map { $_ => $stash->get_symbol("&$_") } # spent 293µs making 177 calls to Package::Stash::XS::get_symbol, avg 2µs/call
# spent 191µs making 20 calls to Package::Stash::XS::list_all_symbols, avg 10µs/call
# spent 112µs making 197 calls to Package::Stash::XS::namespace, avg 571ns/call
# spent 7µs making 20 calls to Package::Stash::XS::name, avg 365ns/call |
| 219 | $stash->list_all_symbols('CODE') | ||||
| 220 | }; | ||||
| 221 | } | ||||
| 222 | |||||
| 223 | 1 | 4µs | 'Danger! Laws of Thermodynamics may not apply.' | ||
| 224 | |||||
| 225 | __END__ | ||||
# spent 600ns within namespace::clean::CORE:match which was called:
# once (600ns+0s) by Search::Elasticsearch::BEGIN@6 at line 7 |