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	4.04ms	8.41ms	namespace::clean::::__ANON__[:130]namespace::clean::__ANON__[:130]
18	18	18	1.04ms	4.29ms	namespace::clean::::importnamespace::clean::import
1	1	1	784µs	8.79ms	namespace::clean::::BEGIN@11namespace::clean::BEGIN@11
1	1	1	755µs	2.57ms	namespace::clean::::BEGIN@16namespace::clean::BEGIN@16
18	1	1	645µs	1.87ms	namespace::clean::::get_functionsnamespace::clean::get_functions
1	1	1	624µs	830µs	namespace::clean::::BEGIN@38namespace::clean::BEGIN@38
18	1	1	172µs	442µs	namespace::clean::::get_class_storenamespace::clean::get_class_store
18	1	1	136µs	8.54ms	namespace::clean::::__ANON__[:185]namespace::clean::__ANON__[:185]
1	1	1	28µs	61µ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	25µs	2	94µs	# spent 61µs (28+33) within namespace::clean::BEGIN@3 which was called: # once (28µs+33µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 3 use warnings; # spent 61µs making 1 call to namespace::clean::BEGIN@3 # spent 33µs making 1 call to warnings::import
4	2	65µ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	10µ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	656µs	2	8.81ms	# spent 8.79ms (784µs+8.00) within namespace::clean::BEGIN@11 which was called: # once (784µs+8.00ms) by JSON::Schema::Modern::Error::BEGIN@21 at line 11 use B::Hooks::EndOfScope 'on_scope_end'; # spent 8.79ms making 1 call to namespace::clean::BEGIN@11 # spent 21µ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 2.57ms (755µs+1.82) within namespace::clean::BEGIN@16 which was called: # once (755µs+1.82ms) by JSON::Schema::Modern::Error::BEGIN@21 at line 36 BEGIN {
17	1	0s			my $provider;
18
19	1	1µs			if ( "$]" < 5.008007 ) {
20					require Package::Stash::PP;
21					$provider = 'Package::Stash::PP';
22					}
23					else {
24	1	522µs			require Package::Stash;
25	1	0s			$provider = 'Package::Stash';
26					}
27	1	44µs			eval <<"EOS" or die $@; # spent 674µs executing statements in string eval # includes 276µ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	20µs	1	2.57ms	} # spent 2.57ms making 1 call to namespace::clean::BEGIN@16
37
38	2	1.28ms	2	867µs	# spent 830µs (624+206) within namespace::clean::BEGIN@38 which was called: # once (624µs+206µ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 830µs making 1 call to namespace::clean::BEGIN@38 # spent 37µ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.04+4.36) 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.04ms+4.36ms) 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	15µs			my $cleanee = shift;
66	18	5µs			my $store = shift;
67	18	28µs	18	280µs	my $cleanee_stash = stash_for($cleanee); # spent 280µs making 18 calls to namespace::clean::stash_for, avg 16µs/call
68	18	4µs			my $deleted_stash;
69
70					SYMBOL:
71	18	103µs			for my $f (@_) {
72
73					# ignore already removed symbols
74	283	103µs			next SYMBOL if $store->{exclude}{ $f };
75
76	283	1.44ms	584	997µs	my $sub = $cleanee_stash->get_symbol("&$f") # spent 838µs making 283 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 150µs making 283 calls to Package::Stash::XS::namespace, avg 530ns/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	38µ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	495µs			my $name = $_ . $f;
114	1132	4.23ms	2264	2.79ms	my $def = $cleanee_stash->get_symbol($name); # spent 2.48ms making 1132 calls to Package::Stash::XS::get_symbol, avg 2µs/call # spent 311µs making 1132 calls to Package::Stash::XS::namespace, avg 275ns/call
115	1132	163µs			defined($def) ? [$name, $def] : ()
116					} '$', '@', '%', '';
117
118	283	1.17ms	566	832µs	$cleanee_stash->remove_glob($f); # spent 763µs making 283 calls to Package::Stash::XS::remove_glob, avg 3µs/call # spent 69µs making 283 calls to Package::Stash::XS::namespace, avg 244ns/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	314µs			$cleanee_stash->add_symbol(@$_) for @symbols;
129					}
130	1	3µs			};
131
132					sub clean_subroutines {
133					my ($nc, $cleanee, @subs) = @_;
134					$RemoveSubs->($cleanee, {}, @subs);
135					}
136
137					# spent 4.29ms (1.04+3.25) within namespace::clean::import which was called 18 times, avg 238µs/call: # once (151µs+407µs) by OpenAPI::Modern::BEGIN@33 at line 33 of OpenAPI/Modern.pm # once (87µs+269µs) by JSON::Schema::Modern::BEGIN@37 at line 37 of JSON/Schema/Modern.pm # once (83µs+261µs) by JSON::Schema::Modern::Document::OpenAPI::BEGIN@27 at line 27 of JSON/Schema/Modern/Document/OpenAPI.pm # once (83µs+204µs) by JSON::Schema::Modern::Vocabulary::Unevaluated::BEGIN@19 at line 19 of JSON/Schema/Modern/Vocabulary/Unevaluated.pm # once (60µs+224µs) by JSON::Schema::Modern::Vocabulary::Applicator::BEGIN@22 at line 22 of JSON/Schema/Modern/Vocabulary/Applicator.pm # once (64µs+206µs) by JSON::Schema::Modern::Result::BEGIN@26 at line 26 of JSON/Schema/Modern/Result.pm # once (53µs+205µs) by JSON::Schema::Modern::Vocabulary::Validation::BEGIN@21 at line 21 of JSON/Schema/Modern/Vocabulary/Validation.pm # once (36µs+209µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 21 of JSON/Schema/Modern/Error.pm # once (85µs+136µs) by JSON::Schema::Modern::Vocabulary::MetaData::BEGIN@18 at line 18 of JSON/Schema/Modern/Vocabulary/MetaData.pm # once (39µs+154µs) by JSON::Schema::Modern::Annotation::BEGIN@20 at line 20 of JSON/Schema/Modern/Annotation.pm # once (50µs+138µs) by JSON::Schema::Modern::Document::BEGIN@25 at line 25 of JSON/Schema/Modern/Document.pm # once (35µs+140µs) by JSON::Schema::Modern::Vocabulary::FormatAssertion::BEGIN@19 at line 19 of JSON/Schema/Modern/Vocabulary/FormatAssertion.pm # once (48µs+125µs) by JSON::Schema::Modern::Utilities::BEGIN@25 at line 25 of JSON/Schema/Modern/Utilities.pm # once (39µs+124µs) by JSON::Schema::Modern::Vocabulary::BEGIN@20 at line 20 of JSON/Schema/Modern/Vocabulary.pm # once (34µs+120µs) by JSON::Schema::Modern::Vocabulary::Core::BEGIN@18 at line 18 of JSON/Schema/Modern/Vocabulary/Core.pm # once (28µs+118µs) by JSON::Schema::Modern::Vocabulary::FormatAnnotation::BEGIN@19 at line 19 of JSON/Schema/Modern/Vocabulary/FormatAnnotation.pm # once (34µs+105µs) by JSON::Schema::Modern::Vocabulary::OpenAPI::BEGIN@18 at line 18 of JSON/Schema/Modern/Vocabulary/OpenAPI.pm # once (31µs+102µs) by JSON::Schema::Modern::Vocabulary::Content::BEGIN@20 at line 20 of JSON/Schema/Modern/Vocabulary/Content.pm sub import {
138	18	14µs			my ($pragma, @args) = @_;
139
140	18	5µs			my (%args, $is_explicit);
141
142					ARG:
143	18	16µ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	47µs			my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
157	18	8µ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	63µs	18	1.87ms	my $functions = $pragma->get_functions($cleanee); # spent 1.87ms making 18 calls to namespace::clean::get_functions, avg 104µs/call
166	18	30µs	18	442µs	my $store = $pragma->get_class_store($cleanee); # spent 442µs making 18 calls to namespace::clean::get_class_store, avg 25µs/call
167	18	14µs	18	52µs	my $stash = stash_for($cleanee); # spent 52µ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	14µs			: ()
174					);
175
176					# register symbols for removal, if they have a CODE entry
177	18	38µs			for my $f (keys %$functions) {
178	283	34µs			next if $except{ $f };
179	283	968µs	584	690µs	next unless $stash->has_symbol("&$f"); # spent 594µs making 283 calls to Package::Stash::XS::has_symbol, avg 2µs/call # spent 92µs making 283 calls to Package::Stash::XS::namespace, avg 325ns/call # spent 4µs making 18 calls to Package::Stash::XS::name, avg 222ns/call
180	283	176µs			$store->{remove}{ $f } = 1;
181					}
182
183					# spent 8.54ms (136µ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 475µs/call: # 18 times (136µ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 475µs/call on_scope_end {
184	18	147µ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	99µs	18	293µs	}; # spent 293µs making 18 calls to B::Hooks::EndOfScope::XS::on_scope_end, avg 16µs/call
186
187	18	94µ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 442µs (172+270) within namespace::clean::get_class_store which was called 18 times, avg 25µs/call: # 18 times (172µs+270µs) by namespace::clean::import at line 166, avg 25µs/call sub get_class_store {
210	18	8µs			my ($pragma, $class) = @_;
211	18	15µs	18	76µs	my $stash = stash_for($class); # spent 76µs making 18 calls to namespace::clean::stash_for, avg 4µs/call
212	18	10µs			my $var = "%$STORAGE_VAR";
213	18	240µs	90	212µs	$stash->add_symbol($var, {}) # spent 90µs making 18 calls to Package::Stash::XS::has_symbol, avg 5µs/call # spent 70µs making 18 calls to Package::Stash::XS::add_symbol, avg 4µs/call # spent 49µs making 36 calls to Package::Stash::XS::namespace, avg 1µs/call # spent 3µs making 18 calls to Package::Stash::XS::name, avg 167ns/call
214					unless $stash->has_symbol($var);
215	18	87µs	36	38µs	return $stash->get_symbol($var); # spent 34µ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 1.87ms (645µs+1.22) within namespace::clean::get_functions which was called 18 times, avg 104µs/call: # 18 times (645µs+1.22ms) by namespace::clean::import at line 165, avg 104µs/call sub get_functions {
219	18	10µs			my ($pragma, $class) = @_;
220
221	18	29µs	18	212µs	my $stash = stash_for($class); # spent 212µs making 18 calls to namespace::clean::stash_for, avg 12µs/call
222					return {
223	18	1.64ms	620	1.21ms	map { $_ => $stash->get_symbol("&$_") } # spent 693µs making 283 calls to Package::Stash::XS::get_symbol, avg 2µs/call # spent 316µs making 18 calls to Package::Stash::XS::list_all_symbols, avg 18µs/call # spent 189µs making 301 calls to Package::Stash::XS::namespace, avg 628ns/call # spent 8µs making 18 calls to Package::Stash::XS::name, avg 444ns/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