← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:09 2016

Filename/usr/local/share/perl/5.18.2/Sub/Install.pm
StatementsExecuted 15245 statements in 28.9ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
9487412.9ms27.2msSub::Install::::__ANON__[:118] Sub::Install::__ANON__[:118]
948118.42ms11.7msSub::Install::::__ANON__[:161] Sub::Install::__ANON__[:161]
948113.24ms3.24msSub::Install::::__ANON__[:173] Sub::Install::__ANON__[:173]
948112.21ms2.55msSub::Install::::_CODELIKE Sub::Install::_CODELIKE
11155µs89µsSub::Install::::BEGIN@176 Sub::Install::BEGIN@176
55524µs78µsSub::Install::::__ANON__[:270] Sub::Install::__ANON__[:270]
22214µs14µsSub::Install::::exporter Sub::Install::exporter
33114µs16µsSub::Install::::_do_with_warn Sub::Install::_do_with_warn
11111µs17µsSub::Install::::BEGIN@273 Sub::Install::BEGIN@273
11110µs13µsSub::Install::::BEGIN@125 Sub::Install::BEGIN@125
1118µs19µsData::OptList::::BEGIN@1Data::OptList::BEGIN@1
1118µs9µsSub::Install::::BEGIN@134 Sub::Install::BEGIN@134
3317µs7µsSub::Install::::_installer Sub::Install::_installer
3317µs7µsSub::Install::::__ANON__[:162] Sub::Install::__ANON__[:162]
1117µs40µsSub::Install::::BEGIN@6 Sub::Install::BEGIN@6
1116µs16µsSub::Install::::BEGIN@170 Sub::Install::BEGIN@170
1116µs10µsData::OptList::::BEGIN@2Data::OptList::BEGIN@2
2215µs5µsSub::Install::::_build_public_installer Sub::Install::_build_public_installer
3314µs4µsSub::Install::::CORE:qr Sub::Install::CORE:qr (opcode)
1112µs2µsSub::Install::::BEGIN@7 Sub::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_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
1219µs229µs
# spent 19µs (8+10) within Data::OptList::BEGIN@1 which was called: # once (8µs+10µs) by Data::OptList::BEGIN@11 at line 1
use strict;
# spent 19µs making 1 call to Data::OptList::BEGIN@1 # spent 10µs making 1 call to strict::import
2231µs215µs
# spent 10µs (6+5) within Data::OptList::BEGIN@2 which was called: # once (6µs+5µs) by Data::OptList::BEGIN@11 at line 2
use warnings;
# spent 10µs making 1 call to Data::OptList::BEGIN@2 # spent 4µs making 1 call to warnings::import
3package Sub::Install;
4# ABSTRACT: install subroutines into packages easily
51400ns$Sub::Install::VERSION = '0.928';
6220µs274µs
# spent 40µs (7+34) within Sub::Install::BEGIN@6 which was called: # once (7µs+34µs) by Data::OptList::BEGIN@11 at line 6
use Carp;
# spent 40µs making 1 call to Sub::Install::BEGIN@6 # spent 34µs making 1 call to Exporter::import
72316µs12µs
# spent 2µs within Sub::Install::BEGIN@7 which was called: # once (2µs+0s) by Data::OptList::BEGIN@11 at line 7
use Scalar::Util ();
# spent 2µ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 2.55ms (2.21+346µs) within Sub::Install::_CODELIKE which was called 948 times, avg 3µs/call: # 948 times (2.21ms+346µs) by Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:118] at line 103, avg 3µs/call
sub _CODELIKE {
849483.27ms949346µs (Scalar::Util::reftype($_[0])||'') eq 'CODE'
# spent 346µs making 948 calls to Scalar::Util::reftype, avg 364ns/call # spent 500ns 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 5µs within Sub::Install::_build_public_installer which was called 2 times, avg 3µs/call: # once (3µs+0s) by Sub::Install::BEGIN@176 at line 188 # once (2µs+0s) by Sub::Install::BEGIN@176 at line 181
sub _build_public_installer {
912500ns my ($installer) = @_;
92
93
# spent 27.2ms (12.9+14.2) within Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:118] which was called 948 times, avg 29µs/call: # 939 times (12.8ms+14.0ms) by Sub::Exporter::default_installer at line 442 of Sub/Exporter.pm, avg 29µs/call # 2 times (33µs+69µs) by Package::DeprecationManager::import at line 29 of Package/DeprecationManager.pm, avg 51µs/call # 2 times (37µs+62µs) by Sub::Exporter::setup_exporter at line 198 of Sub/Exporter.pm, avg 50µs/call # 2 times (18µs+32µs) by Package::DeprecationManager::import at line 37 of Package/DeprecationManager.pm, avg 24µs/call # once (19µs+34µs) by Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:270] at line 268 # once (12µs+23µs) by App::Cmd::Setup::_make_app_class at line 115 of App/Cmd/Setup.pm # once (9µs+14µs) by App::Cmd::Setup::_make_app_class at line 143 of App/Cmd/Setup.pm
sub {
94948159µs my ($arg) = @_;
959481.84ms my ($calling_pkg) = caller(0);
96
97 # I'd rather use ||= but I'm whoring for Devel::Cover.
9828441.48ms for (qw(into from)) { $arg->{$_} = $calling_pkg unless $arg->{$_} }
99
100 # This is the only absolutely required argument, in many cases.
101948192µs Carp::croak "named argument 'code' is not optional" unless $arg->{code};
102
103948923µs9482.55ms if (_CODELIKE($arg->{code})) {
# spent 2.55ms making 948 calls to Sub::Install::_CODELIKE, avg 3µs/call
104 $arg->{as} ||= _name_of_code($arg->{code});
105 } else {
10617µs11µs Carp::croak
# spent 1µ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
1101800ns $arg->{as} = $arg->{code} unless $arg->{as};
1111600ns $arg->{code} = $code;
112 }
113
114948138µs Carp::croak "couldn't determine name under which to install subroutine"
115 unless $arg->{as};
116
1179482.19ms94811.7ms $installer->(@$arg{qw(into as code) });
# spent 11.7ms making 948 calls to Sub::Install::__ANON__[Sub/Install.pm:161], avg 12µs/call
118 }
11927µs}
120
121# do the ugly work
122
1231100nsmy $_misc_warn_re;
1241100nsmy $_redef_warn_re;
125
# spent 13µs (10+3) within Sub::Install::BEGIN@125 which was called: # once (10µs+3µs) by Data::OptList::BEGIN@11 at line 131
BEGIN {
12617µ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;
13015µs1700ns $_redef_warn_re = qr/Subroutine\ .+?\ redefined/x;
# spent 700ns making 1 call to Sub::Install::CORE:qr
131139µs113µs}
# spent 13µs making 1 call to Sub::Install::BEGIN@125
132
13310smy $eow_re;
1341257µs211µs
# spent 9µs (8+2) within Sub::Install::BEGIN@134 which was called: # once (8µs+2µs) by Data::OptList::BEGIN@11 at line 134
BEGIN { $eow_re = qr/ at .+? line \d+\.\Z/ };
# spent 9µs making 1 call to Sub::Install::BEGIN@134 # spent 2µs making 1 call to Sub::Install::CORE:qr
135
136
# spent 16µs (14+2) within Sub::Install::_do_with_warn which was called 3 times, avg 5µs/call: # once (5µs+2µs) by Sub::Install::BEGIN@176 at line 190 # once (5µs+0s) by Sub::Install::BEGIN@176 at line 183 # once (4µs+0s) by Sub::Install::BEGIN@176 at line 177
sub _do_with_warn {
1373900ns my ($arg) = @_;
13832µs my $code = delete $arg->{code};
139
# spent 7µs within Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:162] which was called 3 times, avg 2µs/call: # once (3µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (2µs+0s) by Sub::Install::BEGIN@176 at line 188 # once (2µs+0s) by Sub::Install::_do_with_warn at line 163
my $wants_code = sub {
1403400ns my $code = shift;
141
# spent 11.7ms (8.42+3.24) within Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:161] which was called 948 times, avg 12µs/call: # 948 times (8.42ms+3.24ms) by Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:118] at line 117, avg 12µs/call
sub {
1429481.30ms 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);
1599482.12ms };
1609489.78ms9483.24ms $code->(@_);
# spent 3.24ms making 948 calls to Sub::Install::__ANON__[Sub/Install.pm:173], avg 3µs/call
161311µs };
16235µs };
16333µs12µs return $wants_code->($code) if $code;
# spent 2µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162]
164215µs return $wants_code;
165}
166
167
# spent 7µs within Sub::Install::_installer which was called 3 times, avg 2µs/call: # once (4µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (2µs+0s) by Sub::Install::BEGIN@176 at line 188 # once (1µs+0s) by Sub::Install::BEGIN@176 at line 190
sub _installer {
168
# spent 3.24ms within Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:173] which was called 948 times, avg 3µs/call: # 948 times (3.24ms+0s) by Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:161] at line 160, avg 3µs/call
sub {
169948279µs my ($pkg, $name, $code) = @_;
1702120µs225µs
# spent 16µs (6+10) within Sub::Install::BEGIN@170 which was called: # once (6µs+10µs) by Data::OptList::BEGIN@11 at line 170
no strict 'refs'; ## no critic ProhibitNoStrict
# spent 16µs making 1 call to Sub::Install::BEGIN@170 # spent 10µs making 1 call to strict::unimport
1719482.24ms *{"$pkg\::$name"} = $code;
1729481.81ms return $code;
173 }
174312µs}
175
176
# spent 89µs (55+34) within Sub::Install::BEGIN@176 which was called: # once (55µs+34µs) by Data::OptList::BEGIN@11 at line 194
BEGIN {
17712µs14µs *_ignore_warnings = _do_with_warn({
# spent 4µs making 1 call to Sub::Install::_do_with_warn
178 carp => [ $_misc_warn_re, $_redef_warn_re ]
179 });
180
18112µs310µs *install_sub = _build_public_installer(_ignore_warnings(_installer));
# spent 4µs making 1 call to Sub::Install::_installer # spent 3µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162] # spent 2µs making 1 call to Sub::Install::_build_public_installer
182
183118µs15µs *_carp_warnings = _do_with_warn({
# spent 5µs making 1 call to Sub::Install::_do_with_warn
184 carp => [ $_misc_warn_re ],
185 suppress => [ $_redef_warn_re ],
186 });
187
18812µs37µs *reinstall_sub = _build_public_installer(_carp_warnings(_installer));
# spent 3µs making 1 call to Sub::Install::_build_public_installer # spent 2µs making 1 call to Sub::Install::_installer # spent 2µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162]
189
19016µs28µs *_install_fatal = _do_with_warn({
# spent 7µ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 });
1941221µs189µs}
# spent 89µ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 14µs within Sub::Install::exporter which was called 2 times, avg 7µs/call: # once (7µs+0s) by Data::OptList::BEGIN@100 at line 101 of Data/OptList.pm # once (7µs+0s) by Sub::Install::BEGIN@273 at line 273
sub exporter {
2592800ns my ($arg) = @_;
260
26128µs my %is_exported = map { $_ => undef } @{ $arg->{exports} };
262
263
# spent 78µs (24+53) within Sub::Install::__ANON__[/usr/local/share/perl/5.18.2/Sub/Install.pm:270] which was called 5 times, avg 16µs/call: # once (8µs+53µs) by Class::Load::BEGIN@10 at line 10 of Class/Load.pm # once (5µs+0s) by Moose::Meta::Class::BEGIN@8 at line 8 of Moose/Meta/Class.pm # once (4µs+0s) by Package::DeprecationManager::BEGIN@12 at line 12 of Package/DeprecationManager.pm # once (4µs+0s) by Class::MOP::BEGIN@12 at line 12 of Class/MOP.pm # once (4µs+0s) by Moose::Util::BEGIN@8 at line 8 of Moose/Util.pm
sub {
26453µs my $class = shift;
26554µs my $target = caller;
266524µs for (@_) {
2671400ns Carp::croak "'$_' is not exported by $class" if !exists $is_exported{$_};
26813µs153µs install_sub({ code => $_, from => $class, into => $target });
# spent 53µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:118]
269 }
270 }
271211µs}
272
273136µs224µs
# spent 17µs (11+7) within Sub::Install::BEGIN@273 which was called: # once (11µs+7µs) by Data::OptList::BEGIN@11 at line 273
BEGIN { *import = exporter({ exports => [ qw(install_sub reinstall_sub) ] }); }
# spent 17µs making 1 call to Sub::Install::BEGIN@273 # spent 7µ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
30012µs1;
301
302__END__
 
# spent 4µs within Sub::Install::CORE:qr which was called 3 times, avg 1µ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 (700ns+0s) by Sub::Install::BEGIN@125 at line 130
sub Sub::Install::CORE:qr; # opcode