Profile of namespace/clean.pm

Filename	/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/namespace/clean.pm
Statements	Executed 6429 statements in 14.5ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
18	1	1	3.34ms	6.94ms	namespace::clean::::__ANON__[:130]namespace::clean::__ANON__[:130]
1	1	1	2.07ms	13.9ms	namespace::clean::::BEGIN@11namespace::clean::BEGIN@11
1	1	1	1.56ms	6.05ms	namespace::clean::::BEGIN@16namespace::clean::BEGIN@16
18	18	18	847µs	3.75ms	namespace::clean::::importnamespace::clean::import
1	1	1	648µs	857µs	namespace::clean::::BEGIN@38namespace::clean::BEGIN@38
18	1	1	601µs	1.69ms	namespace::clean::::get_functionsnamespace::clean::get_functions
18	1	1	167µs	395µs	namespace::clean::::get_class_storenamespace::clean::get_class_store
18	1	1	156µs	7.09ms	namespace::clean::::__ANON__[:185]namespace::clean::__ANON__[:185]
1	1	1	23µs	59µs	namespace::clean::::BEGIN@3namespace::clean::BEGIN@3
1	1	1	5µs	7µs	namespace::clean::::BEGIN@4namespace::clean::BEGIN@4
1	1	1	1µs	1µs	namespace::clean::::CORE:matchnamespace::clean::CORE:match (opcode)
0	0	0	0s	0s	namespace::clean::::__ANON__[:160]namespace::clean::__ANON__[:160]
0	0	0	0s	0s	namespace::clean::::clean_subroutinesnamespace::clean::clean_subroutines
0	0	0	0s	0s	namespace::clean::::unimportnamespace::clean::unimport

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package namespace::clean;
2
3	2	21µs	2	95µs	# spent 59µs (23+36) within namespace::clean::BEGIN@3 which was called: # once (23µs+36µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 3 use warnings; # spent 59µs making 1 call to namespace::clean::BEGIN@3 # spent 36µs making 1 call to warnings::import
4	2	59µs	2	9µs	# spent 7µs (5+2) within namespace::clean::BEGIN@4 which was called: # once (5µs+2µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 4 use strict; # spent 7µs making 1 call to namespace::clean::BEGIN@4 # spent 2µs making 1 call to strict::import
5
6	1	1µs			our $VERSION = '0.27';
7	1	6µs	1	1µs	$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases # spent 1µs making 1 call to namespace::clean::CORE:match
8
9	1	0s			our $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
10
11	2	1.96ms	2	13.9ms	# spent 13.9ms (2.07+11.8) within namespace::clean::BEGIN@11 which was called: # once (2.07ms+11.8ms) by JSON::Schema::Modern::Error::BEGIN@21 at line 11 use B::Hooks::EndOfScope 'on_scope_end'; # spent 13.9ms making 1 call to namespace::clean::BEGIN@11 # spent 19µs making 1 call to Sub::Exporter::Progressive::__ANON__[Sub/Exporter/Progressive.pm:47]
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 6.05ms (1.56+4.50) within namespace::clean::BEGIN@16 which was called: # once (1.56ms+4.50ms) by JSON::Schema::Modern::Error::BEGIN@21 at line 36 BEGIN {
17	1	0s			my $provider;
18
19	1	2µs			if ( "$]" < 5.008007 ) {
20					require Package::Stash::PP;
21					$provider = 'Package::Stash::PP';
22					}
23					else {
24	1	1.33ms			require Package::Stash;
25	1	0s			$provider = 'Package::Stash';
26					}
27	1	48µs			eval <<"EOS" or die $@; # spent 653µs executing statements in string eval # includes 301µs spent executing 72 calls to 1 sub defined therein.
28
29					sub stash_for (\$) {
30					$provider->new(\$_[0]);
31					}
32
33					1;
34
35					EOS
36	1	21µs	1	6.05ms	} # spent 6.05ms making 1 call to namespace::clean::BEGIN@16
37
38	2	1.03ms	2	888µs	# spent 857µs (648+209) within namespace::clean::BEGIN@38 which was called: # once (648µs+209µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 38 use namespace::clean::_Util qw( DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT ); # spent 857µs making 1 call to namespace::clean::BEGIN@38 # spent 31µ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					# While the errors manifest themselves inside perl5db.pl, they are caused by
54					# problems inside the interpreter. If enabled ($^P & 0x01) and existent,
55					# the DB::sub sub will be called by the interpreter for any sub call rather
56					# that call the sub directly. It is provided the real sub to call in $DB::sub,
57					# but the value given has the issues described above. We only have to enable
58					# the workaround if DB::sub will be used.
59					#
60					# Can not tie constants to the current value of $^P directly,
61					# as the debugger can be enabled during runtime (kinda dubious)
62					#
63
64					# spent 6.94ms (3.34+3.60) within namespace::clean::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/namespace/clean.pm:130] which was called 18 times, avg 386µs/call: # 18 times (3.34ms+3.60ms) by namespace::clean::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/namespace/clean.pm:185] at line 184, avg 386µs/call my $RemoveSubs = sub {
65	18	11µs			my $cleanee = shift;
66	18	6µs			my $store = shift;
67	18	29µs	18	257µs	my $cleanee_stash = stash_for($cleanee); # spent 257µs making 18 calls to namespace::clean::stash_for, avg 14µs/call
68	18	4µs			my $deleted_stash;
69
70					SYMBOL:
71	18	120µs			for my $f (@_) {
72
73					# ignore already removed symbols
74	283	52µs			next SYMBOL if $store->{exclude}{ $f };
75
76	283	1.18ms	584	867µs	my $sub = $cleanee_stash->get_symbol("&$f") # spent 730µs making 283 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 128µs making 283 calls to Package::Stash::XS::namespace, avg 452ns/call # spent 9µs making 18 calls to Package::Stash::XS::name, avg 500ns/call
77					or next SYMBOL;
78
79					my $need_debugger_fixup =
80					( DEBUGGER_NEEDS_CV_RENAME or DEBUGGER_NEEDS_CV_PIVOT )
81					&&
82					$^P & 0x01
83					&&
84					defined &DB::sub
85					&&
86	283	45µs			ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB'
87					&&
88					( $deleted_stash \|\|= stash_for("namespace::clean::deleted::$cleanee") )
89					;
90
91					# convince the Perl debugger to work
92					# see the comment on top
93					if ( DEBUGGER_NEEDS_CV_RENAME and $need_debugger_fixup ) {
94					#
95					# Note - both get_subname and set_subname are only compiled when CV_RENAME
96					# is true ( the 5.8.9 ~ 5.12 range ). On other perls this entire block is
97					# constant folded away, and so are the definitions in ::_Util
98					#
99					# Do not be surprised that they are missing without DEBUGGER_NEEDS_CV_RENAME
100					#
101					namespace::clean::_Util::get_subname( $sub ) eq ( $cleanee_stash->name . "::$f" )
102					and
103					$deleted_stash->add_symbol(
104					"&$f",
105					namespace::clean::_Util::set_subname( $deleted_stash->name . "::$f", $sub ),
106					);
107					}
108					elsif ( DEBUGGER_NEEDS_CV_PIVOT and $need_debugger_fixup ) {
109					$deleted_stash->add_symbol("&$f", $sub);
110					}
111
112					my @symbols = map {
113	1415	347µs			my $name = $_ . $f;
114	1132	3.50ms	2264	2.32ms	my $def = $cleanee_stash->get_symbol($name); # spent 2.04ms making 1132 calls to Package::Stash::XS::get_symbol, avg 2µs/call # spent 280µs making 1132 calls to Package::Stash::XS::namespace, avg 247ns/call
115	1132	143µs			defined($def) ? [$name, $def] : ()
116					} '$', '@', '%', '';
117
118	283	1.05ms	566	632µs	$cleanee_stash->remove_glob($f); # spent 565µs making 283 calls to Package::Stash::XS::remove_glob, avg 2µs/call # spent 67µs making 283 calls to Package::Stash::XS::namespace, avg 237ns/call
119
120					# if this perl needs no renaming trick we need to
121					# rename the original glob after the fact
122					DEBUGGER_NEEDS_CV_PIVOT
123					and
124					$need_debugger_fixup
125					and
126					*$globref = $deleted_stash->namespace->{$f};
127
128	283	235µs			$cleanee_stash->add_symbol(@$_) for @symbols;
129					}
130	1	2µs			};
131
132					sub clean_subroutines {
133					my ($nc, $cleanee, @subs) = @_;
134					$RemoveSubs->($cleanee, {}, @subs);
135					}
136
137					# spent 3.75ms (847µs+2.90) within namespace::clean::import which was called 18 times, avg 208µs/call: # once (104µs+337µs) by JSON::Schema::Modern::BEGIN@37 at line 37 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern.pm # once (57µs+224µs) by OpenAPI::Modern::BEGIN@33 at line 33 of OpenAPI/Modern.pm # once (42µs+208µs) by JSON::Schema::Modern::Result::BEGIN@26 at line 26 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Result.pm # once (59µs+185µs) by JSON::Schema::Modern::Vocabulary::BEGIN@20 at line 20 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Vocabulary.pm # once (32µs+207µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 21 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Error.pm # once (44µs+187µs) by JSON::Schema::Modern::Vocabulary::Applicator::BEGIN@22 at line 22 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Vocabulary/Applicator.pm # once (42µs+179µs) by JSON::Schema::Modern::Document::OpenAPI::BEGIN@27 at line 27 of JSON/Schema/Modern/Document/OpenAPI.pm # once (48µs+168µs) by JSON::Schema::Modern::Vocabulary::Validation::BEGIN@21 at line 21 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Vocabulary/Validation.pm # once (50µs+147µs) by JSON::Schema::Modern::Document::BEGIN@25 at line 25 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Document.pm # once (41µs+149µs) by JSON::Schema::Modern::Vocabulary::Unevaluated::BEGIN@19 at line 19 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Vocabulary/Unevaluated.pm # once (32µs+140µs) by JSON::Schema::Modern::Vocabulary::Content::BEGIN@20 at line 20 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Vocabulary/Content.pm # once (39µs+128µs) by JSON::Schema::Modern::Vocabulary::Core::BEGIN@18 at line 18 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Vocabulary/Core.pm # once (68µs+99µs) by JSON::Schema::Modern::Annotation::BEGIN@20 at line 20 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Annotation.pm # once (56µs+105µs) by JSON::Schema::Modern::Vocabulary::MetaData::BEGIN@18 at line 18 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Vocabulary/MetaData.pm # once (34µs+122µs) by JSON::Schema::Modern::Vocabulary::FormatAssertion::BEGIN@19 at line 19 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Vocabulary/FormatAssertion.pm # once (34µs+108µs) by JSON::Schema::Modern::Vocabulary::OpenAPI::BEGIN@18 at line 18 of JSON/Schema/Modern/Vocabulary/OpenAPI.pm # once (37µs+104µs) by JSON::Schema::Modern::Vocabulary::FormatAnnotation::BEGIN@19 at line 19 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Vocabulary/FormatAnnotation.pm # once (28µs+106µs) by JSON::Schema::Modern::Utilities::BEGIN@25 at line 25 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Utilities.pm sub import {
138	18	10µs			my ($pragma, @args) = @_;
139
140	18	4µs			my (%args, $is_explicit);
141
142					ARG:
143	18	14µs			while (@args) {
144
145					if ($args[0] =~ /^\-/) {
146					my $key = shift @args;
147					my $value = shift @args;
148					$args{ $key } = $value;
149					}
150					else {
151					$is_explicit++;
152					last ARG;
153					}
154					}
155
156	18	20µs			my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
157	18	4µs			if ($is_explicit) {
158					on_scope_end {
159					$RemoveSubs->($cleanee, {}, @args);
160					};
161					}
162					else {
163
164					# calling class, all current functions and our storage
165	18	57µs	18	1.69ms	my $functions = $pragma->get_functions($cleanee); # spent 1.69ms making 18 calls to namespace::clean::get_functions, avg 94µs/call
166	18	26µs	18	395µs	my $store = $pragma->get_class_store($cleanee); # spent 395µs making 18 calls to namespace::clean::get_class_store, avg 22µs/call
167	18	42µs	18	41µs	my $stash = stash_for($cleanee); # spent 41µs making 18 calls to namespace::clean::stash_for, avg 2µs/call
168
169					# except parameter can be array ref or single value
170					my %except = map {( $_ => 1 )} (
171					$args{ -except }
172					? ( ref $args{ -except } eq 'ARRAY' ? @{ $args{ -except } } : $args{ -except } )
173	18	16µs			: ()
174					);
175
176					# register symbols for removal, if they have a CODE entry
177	18	36µs			for my $f (keys %$functions) {
178	283	31µs			next if $except{ $f };
179	283	823µs	584	581µs	next unless $stash->has_symbol("&$f"); # spent 510µs making 283 calls to Package::Stash::XS::has_symbol, avg 2µs/call # spent 67µs making 283 calls to Package::Stash::XS::namespace, avg 237ns/call # spent 4µs making 18 calls to Package::Stash::XS::name, avg 222ns/call
180	283	144µs			$store->{remove}{ $f } = 1;
181					}
182
183					# spent 7.09ms (156µs+6.94) within namespace::clean::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/namespace/clean.pm:185] which was called 18 times, avg 394µs/call: # 18 times (156µs+6.94ms) by B::Hooks::EndOfScope::XS::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/B/Hooks/EndOfScope/XS.pm:26] at line 26 of B/Hooks/EndOfScope/XS.pm, avg 394µs/call on_scope_end {
184	18	114µs	18	6.94ms	$RemoveSubs->($cleanee, $store, keys %{ $store->{remove} }); # spent 6.94ms making 18 calls to namespace::clean::__ANON__[namespace/clean.pm:130], avg 386µs/call
185	18	63µs	18	268µs	}; # spent 268µs making 18 calls to B::Hooks::EndOfScope::XS::on_scope_end, avg 15µs/call
186
187	18	85µs			return 1;
188					}
189					}
190
191					sub unimport {
192					my ($pragma, %args) = @_;
193
194					# the calling class, the current functions and our storage
195					my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
196					my $functions = $pragma->get_functions($cleanee);
197					my $store = $pragma->get_class_store($cleanee);
198
199					# register all unknown previous functions as excluded
200					for my $f (keys %$functions) {
201					next if $store->{remove}{ $f }
202					or $store->{exclude}{ $f };
203					$store->{exclude}{ $f } = 1;
204					}
205
206					return 1;
207					}
208
209					# spent 395µs (167+228) within namespace::clean::get_class_store which was called 18 times, avg 22µs/call: # 18 times (167µs+228µs) by namespace::clean::import at line 166, avg 22µs/call sub get_class_store {
210	18	10µs			my ($pragma, $class) = @_;
211	18	12µs	18	67µs	my $stash = stash_for($class); # spent 67µs making 18 calls to namespace::clean::stash_for, avg 4µs/call
212	18	12µs			my $var = "%$STORAGE_VAR";
213	18	200µs	90	169µs	$stash->add_symbol($var, {}) # spent 65µs making 18 calls to Package::Stash::XS::has_symbol, avg 4µs/call # spent 61µs making 18 calls to Package::Stash::XS::add_symbol, avg 3µs/call # spent 37µs making 36 calls to Package::Stash::XS::namespace, avg 1µs/call # spent 6µs making 18 calls to Package::Stash::XS::name, avg 333ns/call
214					unless $stash->has_symbol($var);
215	18	84µs	36	37µs	return $stash->get_symbol($var); # spent 35µs making 18 calls to Package::Stash::XS::get_symbol, avg 2µs/call # spent 2µs making 18 calls to Package::Stash::XS::namespace, avg 111ns/call
216					}
217
218					# spent 1.69ms (601µs+1.09) within namespace::clean::get_functions which was called 18 times, avg 94µs/call: # 18 times (601µs+1.09ms) by namespace::clean::import at line 165, avg 94µs/call sub get_functions {
219	18	12µs			my ($pragma, $class) = @_;
220
221	18	29µs	18	248µs	my $stash = stash_for($class); # spent 248µs making 18 calls to namespace::clean::stash_for, avg 14µs/call
222					return {
223	18	1.40ms	620	983µs	map { $_ => $stash->get_symbol("&$_") } # spent 586µs making 283 calls to Package::Stash::XS::get_symbol, avg 2µs/call # spent 254µs making 18 calls to Package::Stash::XS::list_all_symbols, avg 14µs/call # spent 133µs making 301 calls to Package::Stash::XS::namespace, avg 442ns/call # spent 10µs making 18 calls to Package::Stash::XS::name, avg 556ns/call
224					$stash->list_all_symbols('CODE')
225					};
226					}
227
228	1	6µs			'Danger! Laws of Thermodynamics may not apply.'
229
230					__END__

					# spent 1µs within namespace::clean::CORE:match which was called: # once (1µs+0s) by JSON::Schema::Modern::Error::BEGIN@21 at line 7 sub namespace::clean::CORE:match; # opcode