Profile of namespace/clean.pm

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

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
18	1	1	4.34ms	9.05ms	namespace::clean::::__ANON__[:130]namespace::clean::__ANON__[:130]
18	18	18	1.23ms	5.75ms	namespace::clean::::importnamespace::clean::import
1	1	1	1.12ms	1.50ms	namespace::clean::::BEGIN@38namespace::clean::BEGIN@38
1	1	1	1.09ms	3.74ms	namespace::clean::::BEGIN@16namespace::clean::BEGIN@16
1	1	1	1.03ms	8.65ms	namespace::clean::::BEGIN@11namespace::clean::BEGIN@11
18	1	1	947µs	2.59ms	namespace::clean::::get_functionsnamespace::clean::get_functions
18	1	1	318µs	686µs	namespace::clean::::get_class_storenamespace::clean::get_class_store
18	1	1	194µs	9.24ms	namespace::clean::::__ANON__[:185]namespace::clean::__ANON__[:185]
1	1	1	39µs	86µs	namespace::clean::::BEGIN@3namespace::clean::BEGIN@3
1	1	1	9µs	12µs	namespace::clean::::BEGIN@4namespace::clean::BEGIN@4
1	1	1	3µs	3µ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	50µs	2	133µs	# spent 86µs (39+47) within namespace::clean::BEGIN@3 which was called: # once (39µs+47µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 3 use warnings; # spent 86µs making 1 call to namespace::clean::BEGIN@3 # spent 47µs making 1 call to warnings::import
4	2	102µs	2	15µs	# spent 12µs (9+3) within namespace::clean::BEGIN@4 which was called: # once (9µs+3µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 4 use strict; # spent 12µs making 1 call to namespace::clean::BEGIN@4 # spent 3µs making 1 call to strict::import
5
6	1	1µs			our $VERSION = '0.27';
7	1	12µs	1	3µs	$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases # spent 3µs making 1 call to namespace::clean::CORE:match
8
9	1	0s			our $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
10
11	2	882µs	2	8.69ms	# spent 8.65ms (1.03+7.62) within namespace::clean::BEGIN@11 which was called: # once (1.03ms+7.62ms) by JSON::Schema::Modern::Error::BEGIN@21 at line 11 use B::Hooks::EndOfScope 'on_scope_end'; # spent 8.65ms making 1 call to namespace::clean::BEGIN@11 # spent 38µ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.74ms (1.09+2.65) within namespace::clean::BEGIN@16 which was called: # once (1.09ms+2.65ms) by JSON::Schema::Modern::Error::BEGIN@21 at line 36 BEGIN {
17	1	0s			my $provider;
18
19	1	3µs			if ( "$]" < 5.008007 ) {
20					require Package::Stash::PP;
21					$provider = 'Package::Stash::PP';
22					}
23					else {
24	1	679µs			require Package::Stash;
25	1	1µs			$provider = 'Package::Stash';
26					}
27	1	86µs			eval <<"EOS" or die $@; # spent 1.05ms executing statements in string eval # includes 473µ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	33µs	1	3.74ms	} # spent 3.74ms making 1 call to namespace::clean::BEGIN@16
37
38	2	1.61ms	2	1.55ms	# spent 1.50ms (1.12+386µs) within namespace::clean::BEGIN@38 which was called: # once (1.12ms+386µ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 1.50ms making 1 call to namespace::clean::BEGIN@38 # spent 48µ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 9.05ms (4.34+4.71) within namespace::clean::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/namespace/clean.pm:130] which was called 18 times, avg 503µs/call: # 18 times (4.34ms+4.71ms) by namespace::clean::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/namespace/clean.pm:185] at line 184, avg 503µs/call my $RemoveSubs = sub {
65	18	15µs			my $cleanee = shift;
66	18	5µs			my $store = shift;
67	18	45µs	18	355µs	my $cleanee_stash = stash_for($cleanee); # spent 355µs making 18 calls to namespace::clean::stash_for, avg 20µs/call
68	18	4µs			my $deleted_stash;
69
70					SYMBOL:
71	18	88µs			for my $f (@_) {
72
73					# ignore already removed symbols
74	281	97µs			next SYMBOL if $store->{exclude}{ $f };
75
76	281	1.49ms	580	1.07ms	my $sub = $cleanee_stash->get_symbol("&$f") # spent 897µs making 281 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 162µs making 281 calls to Package::Stash::XS::namespace, avg 577ns/call # spent 12µs making 18 calls to Package::Stash::XS::name, avg 667ns/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	281	66µ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	1405	730µs			my $name = $_ . $f;
114	1124	4.38ms	2248	3.00ms	my $def = $cleanee_stash->get_symbol($name); # spent 2.67ms making 1124 calls to Package::Stash::XS::get_symbol, avg 2µs/call # spent 334µs making 1124 calls to Package::Stash::XS::namespace, avg 297ns/call
115	1124	186µs			defined($def) ? [$name, $def] : ()
116					} '$', '@', '%', '';
117
118	281	1.24ms	562	882µs	$cleanee_stash->remove_glob($f); # spent 786µs making 281 calls to Package::Stash::XS::remove_glob, avg 3µs/call # spent 96µs making 281 calls to Package::Stash::XS::namespace, avg 342ns/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	281	347µ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 5.75ms (1.23+4.52) within namespace::clean::import which was called 18 times, avg 320µs/call: # once (206µs+725µs) by JSON::Schema::Modern::BEGIN@37 at line 37 of JSON/Schema/Modern.pm # once (99µs+356µs) by JSON::Schema::Modern::Vocabulary::Validation::BEGIN@21 at line 21 of JSON/Schema/Modern/Vocabulary/Validation.pm # once (48µs+388µs) by JSON::Schema::Modern::Utilities::BEGIN@25 at line 25 of JSON/Schema/Modern/Utilities.pm # once (59µs+330µs) by JSON::Schema::Modern::Error::BEGIN@21 at line 21 of JSON/Schema/Modern/Error.pm # once (59µs+328µs) by JSON::Schema::Modern::Vocabulary::FormatAssertion::BEGIN@19 at line 19 of JSON/Schema/Modern/Vocabulary/FormatAssertion.pm # once (80µs+288µs) by JSON::Schema::Modern::Document::BEGIN@25 at line 25 of JSON/Schema/Modern/Document.pm # once (92µs+222µs) by OpenAPI::Modern::BEGIN@33 at line 33 of OpenAPI/Modern.pm # once (44µs+267µs) by JSON::Schema::Modern::Vocabulary::BEGIN@20 at line 20 of JSON/Schema/Modern/Vocabulary.pm # once (70µs+216µs) by JSON::Schema::Modern::Vocabulary::Core::BEGIN@18 at line 18 of JSON/Schema/Modern/Vocabulary/Core.pm # once (46µs+220µs) by JSON::Schema::Modern::Vocabulary::Applicator::BEGIN@22 at line 22 of JSON/Schema/Modern/Vocabulary/Applicator.pm # once (66µs+198µs) by JSON::Schema::Modern::Result::BEGIN@26 at line 26 of JSON/Schema/Modern/Result.pm # once (82µs+174µs) by JSON::Schema::Modern::Annotation::BEGIN@20 at line 20 of JSON/Schema/Modern/Annotation.pm # once (64µs+177µs) by JSON::Schema::Modern::Document::OpenAPI::BEGIN@27 at line 27 of JSON/Schema/Modern/Document/OpenAPI.pm # once (61µs+155µs) by JSON::Schema::Modern::Vocabulary::MetaData::BEGIN@18 at line 18 of JSON/Schema/Modern/Vocabulary/MetaData.pm # once (41µs+146µs) by JSON::Schema::Modern::Vocabulary::Unevaluated::BEGIN@19 at line 19 of JSON/Schema/Modern/Vocabulary/Unevaluated.pm # once (41µs+121µs) by JSON::Schema::Modern::Vocabulary::Content::BEGIN@20 at line 20 of JSON/Schema/Modern/Vocabulary/Content.pm # once (31µs+113µs) by JSON::Schema::Modern::Vocabulary::FormatAnnotation::BEGIN@19 at line 19 of JSON/Schema/Modern/Vocabulary/FormatAnnotation.pm # once (43µs+99µs) by JSON::Schema::Modern::Vocabulary::OpenAPI::BEGIN@18 at line 18 of JSON/Schema/Modern/Vocabulary/OpenAPI.pm sub import {
138	18	17µs			my ($pragma, @args) = @_;
139
140	18	5µs			my (%args, $is_explicit);
141
142					ARG:
143	18	17µ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	25µs			my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
157	18	5µ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	83µs	18	2.59ms	my $functions = $pragma->get_functions($cleanee); # spent 2.59ms making 18 calls to namespace::clean::get_functions, avg 144µs/call
166	18	49µs	18	686µs	my $store = $pragma->get_class_store($cleanee); # spent 686µs making 18 calls to namespace::clean::get_class_store, avg 38µs/call
167	18	20µs	18	65µs	my $stash = stash_for($cleanee); # spent 65µs making 18 calls to namespace::clean::stash_for, avg 4µ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	69µs			for my $f (keys %$functions) {
178	281	24µs			next if $except{ $f };
179	281	1.13ms	580	778µs	next unless $stash->has_symbol("&$f"); # spent 661µs making 281 calls to Package::Stash::XS::has_symbol, avg 2µs/call # spent 113µs making 281 calls to Package::Stash::XS::namespace, avg 402ns/call # spent 4µs making 18 calls to Package::Stash::XS::name, avg 222ns/call
180	281	198µs			$store->{remove}{ $f } = 1;
181					}
182
183					# spent 9.24ms (194µs+9.05) within namespace::clean::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/namespace/clean.pm:185] which was called 18 times, avg 514µs/call: # 18 times (194µs+9.05ms) 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 514µs/call on_scope_end {
184	18	197µs	18	9.05ms	$RemoveSubs->($cleanee, $store, keys %{ $store->{remove} }); # spent 9.05ms making 18 calls to namespace::clean::__ANON__[namespace/clean.pm:130], avg 503µs/call
185	18	113µs	18	521µs	}; # spent 521µs making 18 calls to B::Hooks::EndOfScope::XS::on_scope_end, avg 29µs/call
186
187	18	151µ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 686µs (318+368) within namespace::clean::get_class_store which was called 18 times, avg 38µs/call: # 18 times (318µs+368µs) by namespace::clean::import at line 166, avg 38µs/call sub get_class_store {
210	18	10µs			my ($pragma, $class) = @_;
211	18	35µs	18	148µs	my $stash = stash_for($class); # spent 148µs making 18 calls to namespace::clean::stash_for, avg 8µs/call
212	18	10µs			my $var = "%$STORAGE_VAR";
213	18	279µs	90	245µs	$stash->add_symbol($var, {}) # spent 109µs making 18 calls to Package::Stash::XS::has_symbol, avg 6µs/call # spent 71µs making 18 calls to Package::Stash::XS::add_symbol, avg 4µs/call # spent 58µs making 36 calls to Package::Stash::XS::namespace, avg 2µs/call # spent 7µs making 18 calls to Package::Stash::XS::name, avg 389ns/call
214					unless $stash->has_symbol($var);
215	18	191µs	36	44µs	return $stash->get_symbol($var); # spent 40µ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.59ms (947µs+1.64) within namespace::clean::get_functions which was called 18 times, avg 144µs/call: # 18 times (947µs+1.64ms) by namespace::clean::import at line 165, avg 144µs/call sub get_functions {
219	18	13µs			my ($pragma, $class) = @_;
220
221	18	40µs	18	435µs	my $stash = stash_for($class); # spent 435µs making 18 calls to namespace::clean::stash_for, avg 24µs/call
222					return {
223	18	2.11ms	616	1.47ms	map { $_ => $stash->get_symbol("&$_") } # spent 786µs making 281 calls to Package::Stash::XS::get_symbol, avg 3µs/call # spent 422µs making 18 calls to Package::Stash::XS::list_all_symbols, avg 23µs/call # spent 255µs making 299 calls to Package::Stash::XS::namespace, avg 853ns/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	8µs			'Danger! Laws of Thermodynamics may not apply.'
229
230					__END__

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