Profile of namespace/clean.pm

Filename	/usr/local/share/perl/5.18.2/namespace/clean.pm
Statements	Executed 242 statements in 2.53ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	459µs	1.42ms	namespace::clean::::BEGIN@16namespace::clean::BEGIN@16
1	1	1	372µs	662µs	namespace::clean::::BEGIN@38namespace::clean::BEGIN@38
2	2	1	259µs	552µs	namespace::clean::::__ANON__[:121]namespace::clean::__ANON__[:121]
2	2	2	162µs	344µs	namespace::clean::::get_functionsnamespace::clean::get_functions
1	1	1	49µs	334µs	namespace::clean::::importnamespace::clean::import
1	1	1	21µs	60µs	namespace::clean::::get_class_storenamespace::clean::get_class_store
1	1	1	19µs	103µs	namespace::clean::::BEGIN@11namespace::clean::BEGIN@11
1	1	1	17µs	24µs	namespace::clean::::BEGIN@3namespace::clean::BEGIN@3
1	1	1	8µs	422µs	namespace::clean::::clean_subroutinesnamespace::clean::clean_subroutines
1	1	1	8µs	146µs	namespace::clean::::__ANON__[:178]namespace::clean::__ANON__[:178]
1	1	1	7µs	23µs	namespace::clean::::BEGIN@4namespace::clean::BEGIN@4
1	1	1	2µs	2µs	namespace::clean::::CORE:matchnamespace::clean::CORE:match (opcode)
0	0	0	0s	0s	namespace::clean::::__ANON__[:151]namespace::clean::__ANON__[:151]
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	30µs	2	32µs	# spent 24µs (17+7) within namespace::clean::BEGIN@3 which was called: # once (17µs+7µs) by namespace::autoclean::BEGIN@12 at line 3 use warnings; # spent 24µs making 1 call to namespace::clean::BEGIN@3 # spent 7µs making 1 call to warnings::import
4	2	79µs	2	39µs	# spent 23µs (7+16) within namespace::clean::BEGIN@4 which was called: # once (7µs+16µs) by namespace::autoclean::BEGIN@12 at line 4 use strict; # spent 23µs making 1 call to namespace::clean::BEGIN@4 # spent 16µs making 1 call to strict::import
5
6	1	800ns			our $VERSION = '0.26';
7	1	10µs	1	2µs	$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases # spent 2µs making 1 call to namespace::clean::CORE:match
8
9	1	400ns			our $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
10
11	2	117µs	2	148µs	# spent 103µs (19+84) within namespace::clean::BEGIN@11 which was called: # once (19µs+84µs) by namespace::autoclean::BEGIN@12 at line 11 use B::Hooks::EndOfScope 'on_scope_end'; # spent 103µs making 1 call to namespace::clean::BEGIN@11 # spent 45µ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 1.42ms (459µs+958µs) within namespace::clean::BEGIN@16 which was called: # once (459µs+958µs) by namespace::autoclean::BEGIN@12 at line 36 BEGIN {
17	1	200ns			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	90µs			require Package::Stash;
25	1	700ns			$provider = 'Package::Stash';
26					}
27	1	59µs			eval <<"EOS" or die $@; # spent 120µs executing statements in string eval # includes 42µs spent executing 6 calls to 1 sub defined therein.
28
29					sub stash_for (\$) {
30					$provider->new(\$_[0]);
31					}
32
33					1;
34
35					EOS
36	1	28µs	1	1.42ms	} # spent 1.42ms making 1 call to namespace::clean::BEGIN@16
37
38	2	1.17ms	2	713µs	# spent 662µs (372+290) within namespace::clean::BEGIN@38 which was called: # once (372µs+290µs) by namespace::autoclean::BEGIN@12 at line 38 use namespace::clean::_Util qw( DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT ); # spent 662µs making 1 call to namespace::clean::BEGIN@38 # spent 50µ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 552µs (259+293) within namespace::clean::__ANON__[/usr/local/share/perl/5.18.2/namespace/clean.pm:121] which was called 2 times, avg 276µs/call: # once (198µs+215µs) by namespace::clean::clean_subroutines at line 125 # once (61µs+78µs) by namespace::clean::__ANON__[/usr/local/share/perl/5.18.2/namespace/clean.pm:178] at line 177 my $RemoveSubs = sub {
58	2	1µs			my $cleanee = shift;
59	2	500ns			my $store = shift;
60	2	4µs	2	32µs	my $cleanee_stash = stash_for($cleanee); # spent 32µs making 2 calls to namespace::clean::stash_for, avg 16µs/call
61	2	400ns			my $deleted_stash;
62
63					SYMBOL:
64	2	13µs			for my $f (@_) {
65
66					# ignore already removed symbols
67	10	7µs			next SYMBOL if $store->{exclude}{ $f };
68
69	10	112µs	22	82µs	my $sub = $cleanee_stash->get_symbol("&$f") # spent 64µs making 10 calls to Package::Stash::XS::get_symbol, avg 6µs/call # spent 17µs making 10 calls to Package::Stash::XS::namespace, avg 2µs/call # spent 2µs making 2 calls to Package::Stash::XS::name, avg 850ns/call
70					or next SYMBOL;
71
72	10	4µs			my $need_debugger_fixup =
73					( DEBUGGER_NEEDS_CV_RENAME or DEBUGGER_NEEDS_CV_PIVOT )
74					&&
75					$^P
76					&&
77					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	40	17µs			my @symbols = map {
104	10	21µs			my $name = $_ . $f;
105	40	248µs	80	175µs	my $def = $cleanee_stash->get_symbol($name); # spent 155µs making 40 calls to Package::Stash::XS::get_symbol, avg 4µs/call # spent 20µs making 40 calls to Package::Stash::XS::namespace, avg 503ns/call
106	40	14µs			defined($def) ? [$name, $def] : ()
107					} '$', '@', '%', '';
108
109	10	66µs	20	48µs	$cleanee_stash->remove_glob($f); # spent 43µs making 10 calls to Package::Stash::XS::remove_glob, avg 4µs/call # spent 5µs making 10 calls to Package::Stash::XS::namespace, avg 500ns/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	10	14µs			$cleanee_stash->add_symbol(@$_) for @symbols;
120					}
121	1	4µs			};
122
123					# spent 422µs (8+414) within namespace::clean::clean_subroutines which was called: # once (8µs+414µs) by namespace::autoclean::__ANON__[/usr/local/share/perl/5.18.2/namespace/autoclean.pm:183] at line 182 of namespace/autoclean.pm sub clean_subroutines {
124	1	1µs			my ($nc, $cleanee, @subs) = @_;
125	1	7µs	1	414µs	$RemoveSubs->($cleanee, {}, @subs); # spent 414µs making 1 call to namespace::clean::__ANON__[namespace/clean.pm:121]
126					}
127
128					# spent 334µs (49+285) within namespace::clean::import which was called: # once (49µs+285µs) by namespace::autoclean::BEGIN@12 at line 12 of namespace/autoclean.pm sub import {
129	1	1µs			my ($pragma, @args) = @_;
130
131	1	200ns			my (%args, $is_explicit);
132
133					ARG:
134	1	1µ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	1	2µs			my $cleanee = exists $args{ -cleanee } ? $args{ -cleanee } : scalar caller;
148	1	300ns			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	1	3µs	1	157µs	my $functions = $pragma->get_functions($cleanee); # spent 157µs making 1 call to namespace::clean::get_functions
157	1	4µs	1	60µs	my $store = $pragma->get_class_store($cleanee); # spent 60µs making 1 call to namespace::clean::get_class_store
158	1	1µs	1	8µs	my $stash = stash_for($cleanee); # spent 8µs making 1 call to namespace::clean::stash_for
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	1	2µs			: ()
165					);
166
167					# register symbols for removal, if they have a CODE entry
168	1	2µs			for my $f (keys %$functions) {
169	2	700ns			next if $except{ $f };
170	2	21µs	5	22µs	next unless $stash->has_symbol("&$f"); # spent 16µs making 2 calls to Package::Stash::XS::has_symbol, avg 8µs/call # spent 6µs making 2 calls to Package::Stash::XS::namespace, avg 3µs/call # spent 600ns making 1 call to Package::Stash::XS::name
171	2	5µs			$store->{remove}{ $f } = 1;
172					}
173
174					# register EOF handler on first call to import
175	1	700ns			unless ($store->{handler_is_installed}) {
176					# spent 146µs (8+138) within namespace::clean::__ANON__[/usr/local/share/perl/5.18.2/namespace/clean.pm:178] which was called: # once (8µs+138µs) by B::Hooks::EndOfScope::XS::__ANON__[/usr/local/share/perl/5.18.2/B/Hooks/EndOfScope/XS.pm:17] at line 17 of B/Hooks/EndOfScope/XS.pm on_scope_end {
177	1	7µs	1	138µs	$RemoveSubs->($cleanee, $store, keys %{ $store->{remove} }); # spent 138µs making 1 call to namespace::clean::__ANON__[namespace/clean.pm:121]
178	1	5µs	1	44µs	}; # spent 44µs making 1 call to B::Hooks::EndOfScope::XS::on_scope_end
179	1	900ns			$store->{handler_is_installed} = 1;
180					}
181
182	1	6µ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 60µs (21+39) within namespace::clean::get_class_store which was called: # once (21µs+39µs) by namespace::clean::import at line 157 sub get_class_store {
205	1	1µs			my ($pragma, $class) = @_;
206	1	2µs	1	11µs	my $stash = stash_for($class); # spent 11µs making 1 call to namespace::clean::stash_for
207	1	1µs			my $var = "%$STORAGE_VAR";
208	1	32µs	5	30µs	$stash->add_symbol($var, {}) # spent 12µs making 1 call to Package::Stash::XS::has_symbol # spent 10µs making 1 call to Package::Stash::XS::add_symbol # spent 7µs making 2 calls to Package::Stash::XS::namespace, avg 3µs/call # spent 700ns making 1 call to Package::Stash::XS::name
209					unless $stash->has_symbol($var);
210	1	13µs	2	6µs	return $stash->get_symbol($var); # spent 5µs making 1 call to Package::Stash::XS::get_symbol # spent 500ns making 1 call to Package::Stash::XS::namespace
211					}
212
213					# spent 344µs (162+183) within namespace::clean::get_functions which was called 2 times, avg 172µs/call: # once (89µs+98µs) by namespace::autoclean::__ANON__[/usr/local/share/perl/5.18.2/namespace/autoclean.pm:183] at line 172 of namespace/autoclean.pm # once (73µs+84µs) by namespace::clean::import at line 156 sub get_functions {
214	2	9µs			my ($pragma, $class) = @_;
215
216	2	4µs	2	56µs	my $stash = stash_for($class); # spent 56µs making 2 calls to namespace::clean::stash_for, avg 28µs/call
217					return {
218	2	282µs	42	157µs	map { $_ => $stash->get_symbol("&$_") } # spent 89µs making 18 calls to Package::Stash::XS::get_symbol, avg 5µs/call # spent 38µs making 2 calls to Package::Stash::XS::list_all_symbols, avg 19µs/call # spent 29µs making 20 calls to Package::Stash::XS::namespace, avg 1µs/call # spent 2µs making 2 calls to Package::Stash::XS::name, avg 850ns/call
219					$stash->list_all_symbols('CODE')
220					};
221					}
222
223	1	6µs			'Danger! Laws of Thermodynamics may not apply.'
224
225					__END__

					# spent 2µs within namespace::clean::CORE:match which was called: # once (2µs+0s) by namespace::autoclean::BEGIN@12 at line 7 sub namespace::clean::CORE:match; # opcode