← Index
NYTProf Performance Profile   « line view »
For index.cgi
  Run on Sat May 9 17:18:47 2020
Reported on Sat May 9 17:19:07 2020

Filename/usr/local/share/perl/5.18.2/Sub/Install.pm
StatementsExecuted 287 statements in 2.60ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1411271µs390µsSub::Install::::__ANON__[:161]Sub::Install::__ANON__[:161]
1482252µs750µsSub::Install::::__ANON__[:118]Sub::Install::__ANON__[:118]
1411119µs119µsSub::Install::::__ANON__[:173]Sub::Install::__ANON__[:173]
141184µs106µsSub::Install::::_CODELIKESub::Install::_CODELIKE
11154µs117µsSub::Install::::BEGIN@176Sub::Install::BEGIN@176
22221µs21µsSub::Install::::exporterSub::Install::exporter
33120µs27µsSub::Install::::_do_with_warnSub::Install::_do_with_warn
33117µs17µsSub::Install::::_installerSub::Install::_installer
11116µs19µsSub::Install::::BEGIN@125Sub::Install::BEGIN@125
11114µs31µsData::GUID::::BEGIN@1 Data::GUID::BEGIN@1
33113µs13µsSub::Install::::__ANON__[:162]Sub::Install::__ANON__[:162]
11113µs23µsSub::Install::::BEGIN@273Sub::Install::BEGIN@273
22113µs13µsSub::Install::::_build_public_installerSub::Install::_build_public_installer
11112µs14µsSub::Install::::BEGIN@134Sub::Install::BEGIN@134
11110µs53µsSub::Install::::BEGIN@6Sub::Install::BEGIN@6
1119µs25µsSub::Install::::BEGIN@170Sub::Install::BEGIN@170
1119µs15µsData::GUID::::BEGIN@2 Data::GUID::BEGIN@2
3315µs5µsSub::Install::::CORE:qrSub::Install::CORE:qr (opcode)
1115µs5µsSub::Install::::__ANON__[:270]Sub::Install::__ANON__[:270]
1114µs4µsSub::Install::::BEGIN@7Sub::Install::BEGIN@7
0000s0sSub::Install::::__ANON__[:142]Sub::Install::__ANON__[:142]
0000s0sSub::Install::::__ANON__[:159]Sub::Install::__ANON__[:159]
0000s0sSub::Install::::__ANON__[:236]Sub::Install::__ANON__[:236]
0000s0sSub::Install::::_name_of_codeSub::Install::_name_of_code
0000s0sSub::Install::::install_installersSub::Install::install_installers
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1229µs248µs
# spent 31µs (14+17) within Data::GUID::BEGIN@1 which was called: # once (14µs+17µs) by Data::GUID::BEGIN@8 at line 1
use strict;
# spent 31µs making 1 call to Data::GUID::BEGIN@1 # spent 17µs making 1 call to strict::import
2248µs221µs
# spent 15µs (9+6) within Data::GUID::BEGIN@2 which was called: # once (9µs+6µs) by Data::GUID::BEGIN@8 at line 2
use warnings;
# spent 15µs making 1 call to Data::GUID::BEGIN@2 # spent 6µs making 1 call to warnings::import
3package Sub::Install;
4# ABSTRACT: install subroutines into packages easily
51900ns$Sub::Install::VERSION = '0.928';
6229µs297µs
# spent 53µs (10+44) within Sub::Install::BEGIN@6 which was called: # once (10µs+44µs) by Data::GUID::BEGIN@8 at line 6
use Carp;
# spent 53µs making 1 call to Sub::Install::BEGIN@6 # spent 44µs making 1 call to Exporter::import
72515µs14µs
# spent 4µs within Sub::Install::BEGIN@7 which was called: # once (4µs+0s) by Data::GUID::BEGIN@8 at line 7
use Scalar::Util ();
# spent 4µs making 1 call to Sub::Install::BEGIN@7
8
9#pod =head1 SYNOPSIS
10#pod
11#pod use Sub::Install;
12#pod
13#pod Sub::Install::install_sub({
14#pod code => sub { ... },
15#pod into => $package,
16#pod as => $subname
17#pod });
18#pod
19#pod =head1 DESCRIPTION
20#pod
21#pod This module makes it easy to install subroutines into packages without the
22#pod unsightly mess of C<no strict> or typeglobs lying about where just anyone can
23#pod see them.
24#pod
25#pod =func install_sub
26#pod
27#pod Sub::Install::install_sub({
28#pod code => \&subroutine,
29#pod into => "Finance::Shady",
30#pod as => 'launder',
31#pod });
32#pod
33#pod This routine installs a given code reference into a package as a normal
34#pod subroutine. The above is equivalent to:
35#pod
36#pod no strict 'refs';
37#pod *{"Finance::Shady" . '::' . "launder"} = \&subroutine;
38#pod
39#pod If C<into> is not given, the sub is installed into the calling package.
40#pod
41#pod If C<code> is not a code reference, it is looked for as an existing sub in the
42#pod package named in the C<from> parameter. If C<from> is not given, it will look
43#pod in the calling package.
44#pod
45#pod If C<as> is not given, and if C<code> is a name, C<as> will default to C<code>.
46#pod If C<as> is not given, but if C<code> is a code ref, Sub::Install will try to
47#pod find the name of the given code ref and use that as C<as>.
48#pod
49#pod That means that this code:
50#pod
51#pod Sub::Install::install_sub({
52#pod code => 'twitch',
53#pod from => 'Person::InPain',
54#pod into => 'Person::Teenager',
55#pod as => 'dance',
56#pod });
57#pod
58#pod is the same as:
59#pod
60#pod package Person::Teenager;
61#pod
62#pod Sub::Install::install_sub({
63#pod code => Person::InPain->can('twitch'),
64#pod as => 'dance',
65#pod });
66#pod
67#pod =func reinstall_sub
68#pod
69#pod This routine behaves exactly like C<L</install_sub>>, but does not emit a
70#pod warning if warnings are on and the destination is already defined.
71#pod
72#pod =cut
73
74sub _name_of_code {
75 my ($code) = @_;
76 require B;
77 my $name = B::svref_2object($code)->GV->NAME;
78 return $name unless $name =~ /\A__ANON__/;
79 return;
80}
81
82# See also Params::Util, to which this code was donated.
83
# spent 106µs (84+22) within Sub::Install::_CODELIKE which was called 14 times, avg 8µs/call: # 14 times (84µs+22µs) by Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:118] at line 103, avg 8µs/call
sub _CODELIKE {
8414123µs1522µs (Scalar::Util::reftype($_[0])||'') eq 'CODE'
# spent 20µs making 14 calls to Scalar::Util::reftype, avg 1µs/call # spent 2µs making 1 call to Scalar::Util::blessed
85 || Scalar::Util::blessed($_[0])
86 && (overload::Method($_[0],'&{}') ? $_[0] : undef);
87}
88
89# do the heavy lifting
90
# spent 13µs within Sub::Install::_build_public_installer which was called 2 times, avg 6µs/call: # once (8µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (5µs+0s) by Sub::Install::BEGIN@176 at line 188
sub _build_public_installer {
912900ns my ($installer) = @_;
92
93
# spent 750µs (252+498) within Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:118] which was called 14 times, avg 54µs/call: # 3 times (51µs+90µs) by Data::GUID::BEGIN@323 at line 336 of Data/GUID.pm, avg 47µs/call # 3 times (48µs+91µs) by Data::GUID::_install_from_method at line 136 of Data/GUID.pm, avg 46µs/call # 3 times (40µs+85µs) by Data::GUID::_install_as_method at line 149 of Data/GUID.pm, avg 42µs/call # once (46µs+99µs) by Data::GUID::BEGIN@323 at line 324 of Data/GUID.pm # once (16µs+35µs) by Data::GUID::BEGIN@196 at line 197 of Data/GUID.pm # once (18µs+33µs) by Sub::Exporter::setup_exporter at line 198 of Sub/Exporter.pm # once (16µs+34µs) by Data::GUID::BEGIN@215 at line 216 of Data/GUID.pm # once (16µs+32µs) by Sub::Exporter::default_installer at line 442 of Sub/Exporter.pm
sub {
94147µs my ($arg) = @_;
951455µs my ($calling_pkg) = caller(0);
96
97 # I'd rather use ||= but I'm whoring for Devel::Cover.
984252µs for (qw(into from)) { $arg->{$_} = $calling_pkg unless $arg->{$_} }
99
100 # This is the only absolutely required argument, in many cases.
101145µs Carp::croak "named argument 'code' is not optional" unless $arg->{code};
102
1031427µs14106µs if (_CODELIKE($arg->{code})) {
# spent 106µs making 14 calls to Sub::Install::_CODELIKE, avg 8µs/call
104 $arg->{as} ||= _name_of_code($arg->{code});
105 } else {
106117µs13µs Carp::croak
# spent 3µs making 1 call to UNIVERSAL::can
107 "couldn't find subroutine named $arg->{code} in package $arg->{from}"
108 unless my $code = $arg->{from}->can($arg->{code});
109
1101600ns $arg->{as} = $arg->{code} unless $arg->{as};
11111µs $arg->{code} = $code;
112 }
113
114144µs Carp::croak "couldn't determine name under which to install subroutine"
115 unless $arg->{as};
116
1171470µs14390µs $installer->(@$arg{qw(into as code) });
# spent 390µs making 14 calls to Sub::Install::__ANON__[Sub/Install.pm:161], avg 28µs/call
118 }
119216µs}
120
121# do the ugly work
122
1231200nsmy $_misc_warn_re;
1241200nsmy $_redef_warn_re;
125
# spent 19µs (16+3) within Sub::Install::BEGIN@125 which was called: # once (16µs+3µs) by Data::GUID::BEGIN@8 at line 131
BEGIN {
126110µs12µs $_misc_warn_re = qr/
# spent 2µs making 1 call to Sub::Install::CORE:qr
127 Prototype\ mismatch:\ sub\ .+? |
128 Constant subroutine .+? redefined
129 /x;
13017µs11µs $_redef_warn_re = qr/Subroutine\ .+?\ redefined/x;
# spent 1µs making 1 call to Sub::Install::CORE:qr
131148µs119µs}
# spent 19µs making 1 call to Sub::Install::BEGIN@125
132
1331100nsmy $eow_re;
1341369µs216µs
# spent 14µs (12+2) within Sub::Install::BEGIN@134 which was called: # once (12µs+2µs) by Data::GUID::BEGIN@8 at line 134
BEGIN { $eow_re = qr/ at .+? line \d+\.\Z/ };
# spent 14µs making 1 call to Sub::Install::BEGIN@134 # spent 2µs making 1 call to Sub::Install::CORE:qr
135
136
# spent 27µs (20+7) within Sub::Install::_do_with_warn which was called 3 times, avg 9µs/call: # once (8µs+7µs) by Sub::Install::BEGIN@176 at line 190 # once (7µs+0s) by Sub::Install::BEGIN@176 at line 177 # once (4µs+0s) by Sub::Install::BEGIN@176 at line 183
sub _do_with_warn {
13732µs my ($arg) = @_;
13832µs my $code = delete $arg->{code};
139
# spent 13µs within Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:162] which was called 3 times, avg 4µs/call: # once (7µs+0s) by Sub::Install::_do_with_warn at line 163 # once (4µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (3µs+0s) by Sub::Install::BEGIN@176 at line 188
my $wants_code = sub {
14031µs my $code = shift;
141
# spent 390µs (271+119) within Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:161] which was called 14 times, avg 28µs/call: # 14 times (271µs+119µs) by Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:118] at line 117, avg 28µs/call
sub {
1421438µs my $warn = $SIG{__WARN__} ? $SIG{__WARN__} : sub { warn @_ }; ## no critic
143 local $SIG{__WARN__} = sub {
144 my ($error) = @_;
145 for (@{ $arg->{suppress} }) {
146 return if $error =~ $_;
147 }
148 for (@{ $arg->{croak} }) {
149 if (my ($base_error) = $error =~ /\A($_) $eow_re/x) {
150 Carp::croak $base_error;
151 }
152 }
153 for (@{ $arg->{carp} }) {
154 if (my ($base_error) = $error =~ /\A($_) $eow_re/x) {
155 return $warn->(Carp::shortmess $base_error);
156 }
157 }
158 ($arg->{default} || $warn)->($error);
1591486µs };
16014129µs14119µs $code->(@_);
# spent 119µs making 14 calls to Sub::Install::__ANON__[Sub/Install.pm:173], avg 9µs/call
161319µs };
16237µs };
16338µs17µs return $wants_code->($code) if $code;
# spent 7µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162]
164210µs return $wants_code;
165}
166
167
# spent 17µs within Sub::Install::_installer which was called 3 times, avg 6µs/call: # once (9µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (6µs+0s) by Sub::Install::BEGIN@176 at line 188 # once (2µs+0s) by Sub::Install::BEGIN@176 at line 190
sub _installer {
168
# spent 119µs within Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:173] which was called 14 times, avg 9µs/call: # 14 times (119µs+0s) by Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:161] at line 160, avg 9µs/call
sub {
1691410µs my ($pkg, $name, $code) = @_;
1702179µs241µs
# spent 25µs (9+16) within Sub::Install::BEGIN@170 which was called: # once (9µs+16µs) by Data::GUID::BEGIN@8 at line 170
no strict 'refs'; ## no critic ProhibitNoStrict
# spent 25µs making 1 call to Sub::Install::BEGIN@170 # spent 16µs making 1 call to strict::unimport
1711485µs *{"$pkg\::$name"} = $code;
1721457µs return $code;
173 }
174324µs}
175
176
# spent 117µs (54+64) within Sub::Install::BEGIN@176 which was called: # once (54µs+64µs) by Data::GUID::BEGIN@8 at line 194
BEGIN {
17714µs17µs *_ignore_warnings = _do_with_warn({
# spent 7µs making 1 call to Sub::Install::_do_with_warn
178 carp => [ $_misc_warn_re, $_redef_warn_re ]
179 });
180
18114µs321µs *install_sub = _build_public_installer(_ignore_warnings(_installer));
# spent 9µs making 1 call to Sub::Install::_installer # spent 8µs making 1 call to Sub::Install::_build_public_installer # spent 4µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162]
182
18313µs14µs *_carp_warnings = _do_with_warn({
# spent 4µs making 1 call to Sub::Install::_do_with_warn
184 carp => [ $_misc_warn_re ],
185 suppress => [ $_redef_warn_re ],
186 });
187
18814µs313µs *reinstall_sub = _build_public_installer(_carp_warnings(_installer));
# spent 6µs making 1 call to Sub::Install::_installer # spent 5µs making 1 call to Sub::Install::_build_public_installer # spent 3µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162]
189
190110µs218µs *_install_fatal = _do_with_warn({
# spent 15µs making 1 call to Sub::Install::_do_with_warn # spent 2µs making 1 call to Sub::Install::_installer
191 code => _installer,
192 croak => [ $_redef_warn_re ],
193 });
1941380µs1117µs}
# spent 117µs making 1 call to Sub::Install::BEGIN@176
195
196#pod =func install_installers
197#pod
198#pod This routine is provided to allow Sub::Install compatibility with
199#pod Sub::Installer. It installs C<install_sub> and C<reinstall_sub> methods into
200#pod the package named by its argument.
201#pod
202#pod Sub::Install::install_installers('Code::Builder'); # just for us, please
203#pod Code::Builder->install_sub({ name => $code_ref });
204#pod
205#pod Sub::Install::install_installers('UNIVERSAL'); # feeling lucky, punk?
206#pod Anything::At::All->install_sub({ name => $code_ref });
207#pod
208#pod The installed installers are similar, but not identical, to those provided by
209#pod Sub::Installer. They accept a single hash as an argument. The key/value pairs
210#pod are used as the C<as> and C<code> parameters to the C<install_sub> routine
211#pod detailed above. The package name on which the method is called is used as the
212#pod C<into> parameter.
213#pod
214#pod Unlike Sub::Installer's C<install_sub> will not eval strings into code, but
215#pod will look for named code in the calling package.
216#pod
217#pod =cut
218
219sub install_installers {
220 my ($into) = @_;
221
222 for my $method (qw(install_sub reinstall_sub)) {
223 my $code = sub {
224 my ($package, $subs) = @_;
225 my ($caller) = caller(0);
226 my $return;
227 for (my ($name, $sub) = %$subs) {
228 $return = Sub::Install->can($method)->({
229 code => $sub,
230 from => $caller,
231 into => $package,
232 as => $name
233 });
234 }
235 return $return;
236 };
237 install_sub({ code => $code, into => $into, as => $method });
238 }
239}
240
241#pod =head1 EXPORTS
242#pod
243#pod Sub::Install exports C<install_sub> and C<reinstall_sub> only if they are
244#pod requested.
245#pod
246#pod =head2 exporter
247#pod
248#pod Sub::Install has a never-exported subroutine called C<exporter>, which is used
249#pod to implement its C<import> routine. It takes a hashref of named arguments,
250#pod only one of which is currently recognize: C<exports>. This must be an arrayref
251#pod of subroutines to offer for export.
252#pod
253#pod This routine is mainly for Sub::Install's own consumption. Instead, consider
254#pod L<Sub::Exporter>.
255#pod
256#pod =cut
257
258
# spent 21µs within Sub::Install::exporter which was called 2 times, avg 10µs/call: # once (11µs+0s) by Data::OptList::BEGIN@100 at line 101 of Data/OptList.pm # once (10µs+0s) by Sub::Install::BEGIN@273 at line 273
sub exporter {
25922µs my ($arg) = @_;
260
261210µs my %is_exported = map { $_ => undef } @{ $arg->{exports} };
262
263
# spent 5µs within Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:270] which was called: # once (5µs+0s) by Data::GUID::BEGIN@8 at line 8 of Data/GUID.pm
sub {
2641700ns my $class = shift;
2651800ns my $target = caller;
26616µs for (@_) {
267 Carp::croak "'$_' is not exported by $class" if !exists $is_exported{$_};
268 install_sub({ code => $_, from => $class, into => $target });
269 }
270 }
271219µs}
272
273159µs233µs
# spent 23µs (13+10) within Sub::Install::BEGIN@273 which was called: # once (13µs+10µs) by Data::GUID::BEGIN@8 at line 273
BEGIN { *import = exporter({ exports => [ qw(install_sub reinstall_sub) ] }); }
# spent 23µs making 1 call to Sub::Install::BEGIN@273 # spent 10µs making 1 call to Sub::Install::exporter
274
275#pod =head1 SEE ALSO
276#pod
277#pod =over
278#pod
279#pod =item L<Sub::Installer>
280#pod
281#pod This module is (obviously) a reaction to Damian Conway's Sub::Installer, which
282#pod does the same thing, but does it by getting its greasy fingers all over
283#pod UNIVERSAL. I was really happy about the idea of making the installation of
284#pod coderefs less ugly, but I couldn't bring myself to replace the ugliness of
285#pod typeglobs and loosened strictures with the ugliness of UNIVERSAL methods.
286#pod
287#pod =item L<Sub::Exporter>
288#pod
289#pod This is a complete Exporter.pm replacement, built atop Sub::Install.
290#pod
291#pod =back
292#pod
293#pod =head1 EXTRA CREDITS
294#pod
295#pod Several of the tests are adapted from tests that shipped with Damian Conway's
296#pod Sub-Installer distribution.
297#pod
298#pod =cut
299
30014µs1;
301
302__END__
 
# spent 5µs within Sub::Install::CORE:qr which was called 3 times, avg 2µs/call: # once (2µs+0s) by Sub::Install::BEGIN@125 at line 126 # once (2µs+0s) by Sub::Install::BEGIN@134 at line 134 # once (1µs+0s) by Sub::Install::BEGIN@125 at line 130
sub Sub::Install::CORE:qr; # opcode
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.