Profile of namespace/clean.pm

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

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
18	1	1	4.16ms	8.41ms	namespace::clean::::__ANON__[:130]namespace::clean::__ANON__[:130]
1	1	1	1.12ms	3.10ms	namespace::clean::::BEGIN@16namespace::clean::BEGIN@16
18	18	18	1.09ms	5.24ms	namespace::clean::::importnamespace::clean::import
1	1	1	896µs	11.3ms	namespace::clean::::BEGIN@11namespace::clean::BEGIN@11
18	1	1	771µs	2.36ms	namespace::clean::::get_functionsnamespace::clean::get_functions
1	1	1	556µs	796µs	namespace::clean::::BEGIN@38namespace::clean::BEGIN@38
18	1	1	245µs	624µs	namespace::clean::::get_class_storenamespace::clean::get_class_store
18	1	1	121µs	8.53ms	namespace::clean::::__ANON__[:185]namespace::clean::__ANON__[:185]
1	1	1	44µs	77µs	namespace::clean::::BEGIN@3namespace::clean::BEGIN@3
1	1	1	5µs	6µ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	23µs	2	110µs	# spent 77µs (44+33) within namespace::clean::BEGIN@3 which was called: # once (44µs+33µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 3 use warnings; # spent 77µs making 1 call to namespace::clean::BEGIN@3 # spent 33µs making 1 call to warnings::import
4	2	61µs	2	7µs	# spent 6µs (5+1000ns) within namespace::clean::BEGIN@4 which was called: # once (5µs+1000ns) by JSON::Schema::Modern::Error::BEGIN@21 at line 4 use strict; # spent 6µs making 1 call to namespace::clean::BEGIN@4 # spent 1µs making 1 call to strict::import
5
6	1	0s			our $VERSION = '0.27';
7	1	7µ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	780µs	2	11.3ms	# spent 11.3ms (896µs+10.4) within namespace::clean::BEGIN@11 which was called: # once (896µs+10.4ms) by JSON::Schema::Modern::Error::BEGIN@21 at line 11 use B::Hooks::EndOfScope 'on_scope_end'; # spent 11.3ms making 1 call to namespace::clean::BEGIN@11 # spent 86µ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 3.10ms (1.12+1.97) within namespace::clean::BEGIN@16 which was called: # once (1.12ms+1.97ms) by JSON::Schema::Modern::Error::BEGIN@21 at line 36 BEGIN {
17	1	0s			my $provider;
18
19	1	4µs			if ( "$]" < 5.008007 ) {
20					require Package::Stash::PP;
21					$provider = 'Package::Stash::PP';
22					}
23					else {
24	1	849µs			require Package::Stash;
25	1	1µs			$provider = 'Package::Stash';
26					}
27	1	52µs			eval <<"EOS" or die $@; # spent 739µs executing statements in string eval # includes 338µ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	29µs	1	3.10ms	} # spent 3.10ms making 1 call to namespace::clean::BEGIN@16
37
38	2	868µs	2	838µs	# spent 796µs (556+240) within namespace::clean::BEGIN@38 which was called: # once (556µs+240µ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 796µs making 1 call to namespace::clean::BEGIN@38 # spent 42µ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 8.41ms (4.16+4.25) within namespace::clean::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/namespace/clean.pm:130] which was called 18 times, avg 467µs/call: # 18 times (4.16ms+4.25ms) by namespace::clean::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/namespace/clean.pm:185] at line 184, avg 467µs/call my $RemoveSubs = sub {
65	18	14µs			my $cleanee = shift;
66	18	12µs			my $store = shift;
67	18	37µs	18	272µs	my $cleanee_stash = stash_for($cleanee); # spent 272µs making 18 calls to namespace::clean::stash_for, avg 15µs/call
68	18	3µs			my $deleted_stash;
69
70					SYMBOL:
71	18	86µs			for my $f (@_) {
72
73					# ignore already removed symbols
74	279	62µs			next SYMBOL if $store->{exclude}{ $f };
75
76	279	1.75ms	576	1.06ms	my $sub = $cleanee_stash->get_symbol("&$f") # spent 905µs making 279 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 144µs making 279 calls to Package::Stash::XS::namespace, avg 516ns/call # spent 10µs making 18 calls to Package::Stash::XS::name, avg 556ns/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	279	47µ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	1395	421µs			my $name = $_ . $f;
114	1116	4.14ms	2232	2.71ms	my $def = $cleanee_stash->get_symbol($name); # spent 2.41ms making 1116 calls to Package::Stash::XS::get_symbol, avg 2µs/call # spent 305µs making 1116 calls to Package::Stash::XS::namespace, avg 273ns/call
115	1116	158µs			defined($def) ? [$name, $def] : ()
116					} '$', '@', '%', '';
117
118	279	1.15ms	558	731µs	$cleanee_stash->remove_glob($f); # spent 661µs making 279 calls to Package::Stash::XS::remove_glob, avg 2µs/call # spent 70µs making 279 calls to Package::Stash::XS::namespace, avg 251ns/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	279	267µ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 5.24ms (1.09+4.14) within namespace::clean::import which was called 18 times, avg 291µs/call: # once (121µs+539µs) by JSON::Schema::Modern::BEGIN@37 at line 37 of JSON/Schema/Modern.pm # once (106µs+343µs) by OpenAPI::Modern::BEGIN@33 at line 33 of OpenAPI/Modern.pm # once (70µs+315µs) by JSON::Schema::Modern::Result::BEGIN@26 at line 26 of JSON/Schema/Modern/Result.pm # once (42µs+317µs) by JSON::Schema::Modern::Vocabulary::Unevaluated::BEGIN@19 at line 19 of JSON/Schema/Modern/Vocabulary/Unevaluated.pm # once (81µs+251µs) by JSON::Schema::Modern::Document::OpenAPI::BEGIN@27 at line 27 of JSON/Schema/Modern/Document/OpenAPI.pm # once (38µs+277µs) by JSON::Schema::Modern::Vocabulary::OpenAPI::BEGIN@18 at line 18 of JSON/Schema/Modern/Vocabulary/OpenAPI.pm # once (73µs+226µs) by JSON::Schema::Modern::Vocabulary::Validation::BEGIN@21 at line 21 of JSON/Schema/Modern/Vocabulary/Validation.pm # once (65µs+208µs) by JSON::Schema::Modern::Vocabulary::FormatAssertion::BEGIN@19 at line 19 of JSON/Schema/Modern/Vocabulary/FormatAssertion.pm # once (54µs+200µs) by JSON::Schema::Modern::Vocabulary::Core::BEGIN@18 at line 18 of JSON/Schema/Modern/Vocabulary/Core.pm # once (71µs+173µs) by JSON::Schema::Modern::Vocabulary::Applicator::BEGIN@22 at line 22 of JSON/Schema/Modern/Vocabulary/Applicator.pm # once (30µs+204µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 21 of JSON/Schema/Modern/Error.pm # once (58µs+175µs) by JSON::Schema::Modern::Vocabulary::Content::BEGIN@20 at line 20 of JSON/Schema/Modern/Vocabulary/Content.pm # once (49µs+169µs) by JSON::Schema::Modern::Annotation::BEGIN@20 at line 20 of JSON/Schema/Modern/Annotation.pm # once (57µs+156µs) by JSON::Schema::Modern::Vocabulary::MetaData::BEGIN@18 at line 18 of JSON/Schema/Modern/Vocabulary/MetaData.pm # once (44µs+155µs) by JSON::Schema::Modern::Vocabulary::FormatAnnotation::BEGIN@19 at line 19 of JSON/Schema/Modern/Vocabulary/FormatAnnotation.pm # once (44µs+151µs) by JSON::Schema::Modern::Document::BEGIN@25 at line 25 of JSON/Schema/Modern/Document.pm # once (52µs+137µs) by JSON::Schema::Modern::Vocabulary::BEGIN@20 at line 20 of JSON/Schema/Modern/Vocabulary.pm # once (39µs+148µs) by JSON::Schema::Modern::Utilities::BEGIN@25 at line 25 of JSON/Schema/Modern/Utilities.pm sub import {
138	18	12µs			my ($pragma, @args) = @_;
139
140	18	4µs			my (%args, $is_explicit);
141
142					ARG:
143	18	13µ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	19µs			my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
157	18	6µ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	101µs	18	2.36ms	my $functions = $pragma->get_functions($cleanee); # spent 2.36ms making 18 calls to namespace::clean::get_functions, avg 131µs/call
166	18	58µs	18	624µs	my $store = $pragma->get_class_store($cleanee); # spent 624µs making 18 calls to namespace::clean::get_class_store, avg 35µs/call
167	18	16µs	18	62µs	my $stash = stash_for($cleanee); # spent 62µs making 18 calls to namespace::clean::stash_for, avg 3µ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	17µs			: ()
174					);
175
176					# register symbols for removal, if they have a CODE entry
177	18	45µs			for my $f (keys %$functions) {
178	279	25µs			next if $except{ $f };
179	279	1.20ms	576	890µs	next unless $stash->has_symbol("&$f"); # spent 762µs making 279 calls to Package::Stash::XS::has_symbol, avg 3µs/call # spent 124µs making 279 calls to Package::Stash::XS::namespace, avg 444ns/call # spent 4µs making 18 calls to Package::Stash::XS::name, avg 222ns/call
180	279	143µs			$store->{remove}{ $f } = 1;
181					}
182
183					# spent 8.53ms (121µs+8.41) within namespace::clean::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/namespace/clean.pm:185] which was called 18 times, avg 474µs/call: # 18 times (121µs+8.41ms) 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 474µs/call on_scope_end {
184	18	119µs	18	8.41ms	$RemoveSubs->($cleanee, $store, keys %{ $store->{remove} }); # spent 8.41ms making 18 calls to namespace::clean::__ANON__[namespace/clean.pm:130], avg 467µs/call
185	18	78µs	18	332µs	}; # spent 332µs making 18 calls to B::Hooks::EndOfScope::XS::on_scope_end, avg 18µs/call
186
187	18	132µ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 624µs (245+379) within namespace::clean::get_class_store which was called 18 times, avg 35µs/call: # 18 times (245µs+379µs) by namespace::clean::import at line 166, avg 35µs/call sub get_class_store {
210	18	34µs			my ($pragma, $class) = @_;
211	18	23µs	18	102µs	my $stash = stash_for($class); # spent 102µs making 18 calls to namespace::clean::stash_for, avg 6µs/call
212	18	10µs			my $var = "%$STORAGE_VAR";
213	18	329µs	90	298µs	$stash->add_symbol($var, {}) # spent 137µs making 18 calls to Package::Stash::XS::add_symbol, avg 8µs/call # spent 97µs making 18 calls to Package::Stash::XS::has_symbol, avg 5µs/call # spent 56µs making 36 calls to Package::Stash::XS::namespace, avg 2µs/call # spent 8µs making 18 calls to Package::Stash::XS::name, avg 444ns/call
214					unless $stash->has_symbol($var);
215	18	130µs	36	47µs	return $stash->get_symbol($var); # spent 43µs making 18 calls to Package::Stash::XS::get_symbol, avg 2µs/call # spent 4µs making 18 calls to Package::Stash::XS::namespace, avg 222ns/call
216					}
217
218					# spent 2.36ms (771µs+1.59) within namespace::clean::get_functions which was called 18 times, avg 131µs/call: # 18 times (771µs+1.59ms) by namespace::clean::import at line 165, avg 131µs/call sub get_functions {
219	18	9µs			my ($pragma, $class) = @_;
220
221	18	65µs	18	282µs	my $stash = stash_for($class); # spent 282µs making 18 calls to namespace::clean::stash_for, avg 16µs/call
222					return {
223	18	2.05ms	612	1.47ms	map { $_ => $stash->get_symbol("&$_") } # spent 1.07ms making 279 calls to Package::Stash::XS::get_symbol, avg 4µs/call # spent 241µs making 18 calls to Package::Stash::XS::list_all_symbols, avg 13µs/call # spent 147µs making 297 calls to Package::Stash::XS::namespace, avg 495ns/call # spent 9µs making 18 calls to Package::Stash::XS::name, avg 500ns/call
224					$stash->list_all_symbols('CODE')
225					};
226					}
227
228	1	5µ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