← Index
NYTProf Performance Profile   « line view »
For /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
  Run on Mon Jan 29 16:55:34 2018
Reported on Mon Jan 29 16:57:06 2018

Filename/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Sub/Install.pm
StatementsExecuted 1523 statements in 3.28ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
9111855µs1.14msSub::Install::::__ANON__[:161] Sub::Install::__ANON__[:161]
9142798µs2.19msSub::Install::::__ANON__[:118] Sub::Install::__ANON__[:118]
9111290µs290µsSub::Install::::__ANON__[:173] Sub::Install::__ANON__[:173]
9111200µs243µsSub::Install::::_CODELIKE Sub::Install::_CODELIKE
11126µs44µsSub::Install::::BEGIN@176 Sub::Install::BEGIN@176
44419µs19µsSub::Install::::__ANON__[:270] Sub::Install::__ANON__[:270]
11113µs17µsSub::Install::::BEGIN@125 Sub::Install::BEGIN@125
11113µs16µsData::OptList::::BEGIN@1Data::OptList::BEGIN@1
22210µs10µsSub::Install::::exporter Sub::Install::exporter
3319µs10µsSub::Install::::_do_with_warn Sub::Install::_do_with_warn
1118µs18µsData::OptList::::BEGIN@2Data::OptList::BEGIN@2
1118µs26µsSub::Install::::BEGIN@170 Sub::Install::BEGIN@170
1117µs12µsSub::Install::::BEGIN@273 Sub::Install::BEGIN@273
1116µs7µsSub::Install::::BEGIN@134 Sub::Install::BEGIN@134
1116µs37µsSub::Install::::BEGIN@6 Sub::Install::BEGIN@6
3314µs4µsSub::Install::::CORE:qr Sub::Install::CORE:qr (opcode)
3314µs4µsSub::Install::::__ANON__[:162] Sub::Install::__ANON__[:162]
1113µs3µsSub::Install::::BEGIN@7 Sub::Install::BEGIN@7
3313µs3µsSub::Install::::_installer Sub::Install::_installer
2212µs2µsSub::Install::::_build_public_installer Sub::Install::_build_public_installer
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_code Sub::Install::_name_of_code
0000s0sSub::Install::::install_installers Sub::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
1218µs218µs
# spent 16µs (13+3) within Data::OptList::BEGIN@1 which was called: # once (13µs+3µs) by Data::OptList::BEGIN@11 at line 1
use strict;
# spent 16µs making 1 call to Data::OptList::BEGIN@1 # spent 3µs making 1 call to strict::import
2228µs228µs
# spent 18µs (8+10) within Data::OptList::BEGIN@2 which was called: # once (8µs+10µs) by Data::OptList::BEGIN@11 at line 2
use warnings;
# spent 18µs making 1 call to Data::OptList::BEGIN@2 # spent 10µs making 1 call to warnings::import
3package Sub::Install;
4# ABSTRACT: install subroutines into packages easily
51300ns$Sub::Install::VERSION = '0.928';
6216µs269µs
# spent 37µs (6+32) within Sub::Install::BEGIN@6 which was called: # once (6µs+32µs) by Data::OptList::BEGIN@11 at line 6
use Carp;
# spent 37µs making 1 call to Sub::Install::BEGIN@6 # spent 32µs making 1 call to Exporter::import
72353µs13µs
# spent 3µs within Sub::Install::BEGIN@7 which was called: # once (3µs+0s) by Data::OptList::BEGIN@11 at line 7
use Scalar::Util ();
# spent 3µ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 243µs (200+42) within Sub::Install::_CODELIKE which was called 91 times, avg 3µs/call: # 91 times (200µs+42µs) by Sub::Install::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Sub/Install.pm:118] at line 103, avg 3µs/call
sub _CODELIKE {
8491299µs9142µs (Scalar::Util::reftype($_[0])||'') eq 'CODE'
# spent 42µs making 91 calls to Scalar::Util::reftype, avg 465ns/call
85 || Scalar::Util::blessed($_[0])
86 && (overload::Method($_[0],'&{}') ? $_[0] : undef);
87}
88
89# do the heavy lifting
90
# spent 2µs within Sub::Install::_build_public_installer which was called 2 times, avg 1µs/call: # once (1µs+0s) by Sub::Install::BEGIN@176 at line 188 # once (1µs+0s) by Sub::Install::BEGIN@176 at line 181
sub _build_public_installer {
912200ns my ($installer) = @_;
92
93
# spent 2.19ms (798µs+1.39) within Sub::Install::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Sub/Install.pm:118] which was called 91 times, avg 24µs/call: # 85 times (728µs+1.27ms) by Sub::Exporter::default_installer at line 445 of Sub/Exporter.pm, avg 23µs/call # 2 times (33µs+59µs) by Package::DeprecationManager::import at line 39 of Package/DeprecationManager.pm, avg 46µs/call # 2 times (25µs+43µs) by Sub::Exporter::setup_exporter at line 198 of Sub/Exporter.pm, avg 34µs/call # 2 times (13µs+20µs) by Package::DeprecationManager::import at line 45 of Package/DeprecationManager.pm, avg 16µs/call
sub {
949114µs my ($arg) = @_;
9591205µs my ($calling_pkg) = caller(0);
96
97 # I'd rather use ||= but I'm whoring for Devel::Cover.
98273137µs for (qw(into from)) { $arg->{$_} = $calling_pkg unless $arg->{$_} }
99
100 # This is the only absolutely required argument, in many cases.
1019119µs Carp::croak "named argument 'code' is not optional" unless $arg->{code};
102
10391103µs91243µs if (_CODELIKE($arg->{code})) {
# spent 243µs making 91 calls to Sub::Install::_CODELIKE, avg 3µs/call
104 $arg->{as} ||= _name_of_code($arg->{code});
105 } else {
106 Carp::croak
107 "couldn't find subroutine named $arg->{code} in package $arg->{from}"
108 unless my $code = $arg->{from}->can($arg->{code});
109
110 $arg->{as} = $arg->{code} unless $arg->{as};
111 $arg->{code} = $code;
112 }
113
114 Carp::croak "couldn't determine name under which to install subroutine"
1159121µs unless $arg->{as};
116
11791221µs911.14ms $installer->(@$arg{qw(into as code) });
# spent 1.14ms making 91 calls to Sub::Install::__ANON__[Sub/Install.pm:161], avg 13µs/call
118 }
11924µs}
120
121# do the ugly work
122
1231100nsmy $_misc_warn_re;
124my $_redef_warn_re;
125
# spent 17µs (13+4) within Sub::Install::BEGIN@125 which was called: # once (13µs+4µs) by Data::OptList::BEGIN@11 at line 131
BEGIN {
126111µs13µs $_misc_warn_re = qr/
# spent 3µs making 1 call to Sub::Install::CORE:qr
127 Prototype\ mismatch:\ sub\ .+? |
128 Constant subroutine .+? redefined
129 /x;
13017µs1600ns $_redef_warn_re = qr/Subroutine\ .+?\ redefined/x;
# spent 600ns making 1 call to Sub::Install::CORE:qr
131133µs117µs}
# spent 17µs making 1 call to Sub::Install::BEGIN@125
132
133my $eow_re;
1341193µs28µs
# spent 7µs (6+900ns) within Sub::Install::BEGIN@134 which was called: # once (6µs+900ns) by Data::OptList::BEGIN@11 at line 134
BEGIN { $eow_re = qr/ at .+? line \d+\.\Z/ };
# spent 7µs making 1 call to Sub::Install::BEGIN@134 # spent 900ns making 1 call to Sub::Install::CORE:qr
135
136
# spent 10µs (9+1) within Sub::Install::_do_with_warn which was called 3 times, avg 3µs/call: # once (4µs+1µs) by Sub::Install::BEGIN@176 at line 190 # once (3µs+0s) by Sub::Install::BEGIN@176 at line 177 # once (1µs+0s) by Sub::Install::BEGIN@176 at line 183
sub _do_with_warn {
1373500ns my ($arg) = @_;
1383800ns my $code = delete $arg->{code};
139
# spent 4µs within Sub::Install::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Sub/Install.pm:162] which was called 3 times, avg 1µs/call: # once (1µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (1µs+0s) by Sub::Install::BEGIN@176 at line 188 # once (1µs+0s) by Sub::Install::_do_with_warn at line 163
my $wants_code = sub {
1403500ns my $code = shift;
141
# spent 1.14ms (855µs+290µs) within Sub::Install::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Sub/Install.pm:161] which was called 91 times, avg 13µs/call: # 91 times (855µs+290µs) by Sub::Install::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Sub/Install.pm:118] at line 117, avg 13µs/call
sub {
1429197µ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);
15991195µs };
16091560µs91290µs $code->(@_);
# spent 290µs making 91 calls to Sub::Install::__ANON__[Sub/Install.pm:173], avg 3µs/call
16137µs };
16233µs };
16334µs11µs return $wants_code->($code) if $code;
# spent 1µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162]
16426µs return $wants_code;
165}
166
167
# spent 3µs within Sub::Install::_installer which was called 3 times, avg 933ns/call: # once (1µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (1µs+0s) by Sub::Install::BEGIN@176 at line 190 # once (600ns+0s) by Sub::Install::BEGIN@176 at line 188
sub _installer {
168
# spent 290µs within Sub::Install::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Sub/Install.pm:173] which was called 91 times, avg 3µs/call: # 91 times (290µs+0s) by Sub::Install::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Sub/Install.pm:161] at line 160, avg 3µs/call
sub {
1699130µs my ($pkg, $name, $code) = @_;
170293µs244µs
# spent 26µs (8+18) within Sub::Install::BEGIN@170 which was called: # once (8µs+18µs) by Data::OptList::BEGIN@11 at line 170
no strict 'refs'; ## no critic ProhibitNoStrict
# spent 26µs making 1 call to Sub::Install::BEGIN@170 # spent 18µs making 1 call to strict::unimport
17191193µs *{"$pkg\::$name"} = $code;
17291140µs return $code;
173 }
17438µs}
175
176
# spent 44µs (26+18) within Sub::Install::BEGIN@176 which was called: # once (26µs+18µs) by Data::OptList::BEGIN@11 at line 194
BEGIN {
17712µs13µs *_ignore_warnings = _do_with_warn({
# spent 3µs making 1 call to Sub::Install::_do_with_warn
178 carp => [ $_misc_warn_re, $_redef_warn_re ]
179 });
180
18112µs34µs *install_sub = _build_public_installer(_ignore_warnings(_installer));
# spent 1µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162] # spent 1µs making 1 call to Sub::Install::_installer # spent 1µs making 1 call to Sub::Install::_build_public_installer
182
18311µs11µs *_carp_warnings = _do_with_warn({
# spent 1µs making 1 call to Sub::Install::_do_with_warn
184 carp => [ $_misc_warn_re ],
185 suppress => [ $_redef_warn_re ],
186 });
187
18811µs33µs *reinstall_sub = _build_public_installer(_carp_warnings(_installer));
# spent 1µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162] # spent 1µs making 1 call to Sub::Install::_build_public_installer # spent 600ns making 1 call to Sub::Install::_installer
189
19013µs26µs *_install_fatal = _do_with_warn({
# spent 5µs making 1 call to Sub::Install::_do_with_warn # spent 1µs making 1 call to Sub::Install::_installer
191 code => _installer,
192 croak => [ $_redef_warn_re ],
193 });
1941174µs144µs}
# spent 44µ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 10µs within Sub::Install::exporter which was called 2 times, avg 5µs/call: # once (5µs+0s) by Sub::Install::BEGIN@273 at line 273 # once (5µs+0s) by Data::OptList::BEGIN@100 at line 101 of Data/OptList.pm
sub exporter {
2592600ns my ($arg) = @_;
260
26125µs my %is_exported = map { $_ => undef } @{ $arg->{exports} };
262
263
# spent 19µs within Sub::Install::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Sub/Install.pm:270] which was called 4 times, avg 5µs/call: # once (5µs+0s) by Package::DeprecationManager::BEGIN@12 at line 12 of Package/DeprecationManager.pm # once (5µs+0s) by Moose::Meta::Class::BEGIN@8 at line 8 of Moose/Meta/Class.pm # once (5µs+0s) by Class::MOP::BEGIN@12 at line 12 of Class/MOP.pm # once (5µs+0s) by Moose::Util::BEGIN@8 at line 8 of Moose/Util.pm
sub {
26443µs my $class = shift;
26544µs my $target = caller;
266416µs for (@_) {
267 Carp::croak "'$_' is not exported by $class" if !exists $is_exported{$_};
268 install_sub({ code => $_, from => $class, into => $target });
269 }
270 }
27129µs}
272
273136µs217µs
# spent 12µs (7+5) within Sub::Install::BEGIN@273 which was called: # once (7µs+5µs) by Data::OptList::BEGIN@11 at line 273
BEGIN { *import = exporter({ exports => [ qw(install_sub reinstall_sub) ] }); }
# spent 12µs making 1 call to Sub::Install::BEGIN@273 # spent 5µ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
30013µs1;
301
302__END__
 
# spent 4µs within Sub::Install::CORE:qr which was called 3 times, avg 2µs/call: # once (3µs+0s) by Sub::Install::BEGIN@125 at line 126 # once (900ns+0s) by Sub::Install::BEGIN@134 at line 134 # once (600ns+0s) by Sub::Install::BEGIN@125 at line 130
sub Sub::Install::CORE:qr; # opcode