← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:47 2015

Filename/usr/share/perl5/Sub/Install.pm
StatementsExecuted 79 statements in 1.49ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11132µs70µsSub::Install::::BEGIN@176 Sub::Install::BEGIN@176
11122µs50µsSub::Install::::__ANON__[:118] Sub::Install::__ANON__[:118]
11114µs18µsSub::Install::::__ANON__[:161] Sub::Install::__ANON__[:161]
33113µs13µsSub::Install::::__ANON__[:162] Sub::Install::__ANON__[:162]
33113µs20µsSub::Install::::_do_with_warn Sub::Install::_do_with_warn
22213µs13µsSub::Install::::exporter Sub::Install::exporter
11110µs23µsData::OptList::::BEGIN@1Data::OptList::BEGIN@1
11110µs12µsSub::Install::::BEGIN@125 Sub::Install::BEGIN@125
1119µs39µsSub::Install::::BEGIN@6 Sub::Install::BEGIN@6
1118µs10µsSub::Install::::_CODELIKE Sub::Install::_CODELIKE
1118µs14µsSub::Install::::BEGIN@273 Sub::Install::BEGIN@273
1118µs58µsSub::Install::::__ANON__[:270] Sub::Install::__ANON__[:270]
1117µs12µsData::OptList::::BEGIN@2Data::OptList::BEGIN@2
1117µs17µsSub::Install::::BEGIN@170 Sub::Install::BEGIN@170
2216µs6µsSub::Install::::_build_public_installer Sub::Install::_build_public_installer
1115µs6µsSub::Install::::BEGIN@134 Sub::Install::BEGIN@134
3315µs5µsSub::Install::::_installer Sub::Install::_installer
1114µs4µsSub::Install::::__ANON__[:173] Sub::Install::__ANON__[:173]
3313µs3µsSub::Install::::CORE:qr Sub::Install::CORE:qr (opcode)
1113µs3µ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
1225µs235µs
# spent 23µs (10+12) within Data::OptList::BEGIN@1 which was called: # once (10µs+12µs) by Data::OptList::BEGIN@11 at line 1
use strict;
# spent 23µs making 1 call to Data::OptList::BEGIN@1 # spent 12µs making 1 call to strict::import
2236µs216µs
# spent 12µs (7+4) within Data::OptList::BEGIN@2 which was called: # once (7µs+4µs) by Data::OptList::BEGIN@11 at line 2
use warnings;
# spent 12µ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';
6222µs269µs
# spent 39µs (9+30) within Sub::Install::BEGIN@6 which was called: # once (9µs+30µs) by Data::OptList::BEGIN@11 at line 6
use Carp;
# spent 39µs making 1 call to Sub::Install::BEGIN@6 # spent 30µs making 1 call to Exporter::import
72350µ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 10µs (8+2) within Sub::Install::_CODELIKE which was called: # once (8µs+2µs) by Sub::Install::__ANON__[/usr/share/perl5/Sub/Install.pm:118] at line 103
sub _CODELIKE {
84112µs22µs (Scalar::Util::reftype($_[0])||'') eq 'CODE'
# spent 1µs making 1 call to Scalar::Util::reftype # 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 6µs within Sub::Install::_build_public_installer which was called 2 times, avg 3µ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
sub _build_public_installer {
912400ns my ($installer) = @_;
92
93
# spent 50µs (22+29) within Sub::Install::__ANON__[/usr/share/perl5/Sub/Install.pm:118] which was called: # once (22µs+29µs) by Sub::Install::__ANON__[/usr/share/perl5/Sub/Install.pm:270] at line 268
sub {
941300ns my ($arg) = @_;
9513µs my ($calling_pkg) = caller(0);
96
97 # I'd rather use ||= but I'm whoring for Devel::Cover.
9832µs for (qw(into from)) { $arg->{$_} = $calling_pkg unless $arg->{$_} }
99
100 # This is the only absolutely required argument, in many cases.
1011200ns Carp::croak "named argument 'code' is not optional" unless $arg->{code};
102
10311µs110µs if (_CODELIKE($arg->{code})) {
# spent 10µs making 1 call to Sub::Install::_CODELIKE
104 $arg->{as} ||= _name_of_code($arg->{code});
105 } else {
10619µ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
1101700ns $arg->{as} = $arg->{code} unless $arg->{as};
1111700ns $arg->{code} = $code;
112 }
113
1141200ns Carp::croak "couldn't determine name under which to install subroutine"
115 unless $arg->{as};
116
11714µs118µs $installer->(@$arg{qw(into as code) });
# spent 18µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:161]
118 }
119210µs}
120
121# do the ugly work
122
1231100nsmy $_misc_warn_re;
124my $_redef_warn_re;
125
# spent 12µs (10+2) within Sub::Install::BEGIN@125 which was called: # once (10µs+2µ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;
13014µs1700ns $_redef_warn_re = qr/Subroutine\ .+?\ redefined/x;
# spent 700ns making 1 call to Sub::Install::CORE:qr
131131µs112µs}
# spent 12µs making 1 call to Sub::Install::BEGIN@125
132
133my $eow_re;
1341325µs27µs
# spent 6µs (5+1000ns) within Sub::Install::BEGIN@134 which was called: # once (5µs+1000ns) by Data::OptList::BEGIN@11 at line 134
BEGIN { $eow_re = qr/ at .+? line \d+\.\Z/ };
# spent 6µs making 1 call to Sub::Install::BEGIN@134 # spent 1µs making 1 call to Sub::Install::CORE:qr
135
136
# spent 20µs (13+7) within Sub::Install::_do_with_warn which was called 3 times, avg 6µs/call: # once (5µs+7µs) by Sub::Install::BEGIN@176 at line 190 # once (5µs+0s) by Sub::Install::BEGIN@176 at line 177 # once (2µs+0s) by Sub::Install::BEGIN@176 at line 183
sub _do_with_warn {
1373700ns my ($arg) = @_;
13832µs my $code = delete $arg->{code};
139
# spent 13µs within Sub::Install::__ANON__[/usr/share/perl5/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 (5µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (2µs+0s) by Sub::Install::BEGIN@176 at line 188
my $wants_code = sub {
1403400ns my $code = shift;
141
# spent 18µs (14+4) within Sub::Install::__ANON__[/usr/share/perl5/Sub/Install.pm:161] which was called: # once (14µs+4µs) by Sub::Install::__ANON__[/usr/share/perl5/Sub/Install.pm:118] at line 117
sub {
14212µ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);
15913µs };
16018µs14µs $code->(@_);
# spent 4µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:173]
161318µs };
16234µs };
16333µs17µs return $wants_code->($code) if $code;
# spent 7µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162]
16427µs return $wants_code;
165}
166
167
# spent 5µs within Sub::Install::_installer which was called 3 times, avg 2µs/call: # once (2µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (2µs+0s) by Sub::Install::BEGIN@176 at line 190 # once (2µs+0s) by Sub::Install::BEGIN@176 at line 188
sub _installer {
168
# spent 4µs within Sub::Install::__ANON__[/usr/share/perl5/Sub/Install.pm:173] which was called: # once (4µs+0s) by Sub::Install::__ANON__[/usr/share/perl5/Sub/Install.pm:161] at line 160
sub {
1691500ns my ($pkg, $name, $code) = @_;
1702250µs227µs
# spent 17µs (7+10) within Sub::Install::BEGIN@170 which was called: # once (7µs+10µs) by Data::OptList::BEGIN@11 at line 170
no strict 'refs'; ## no critic ProhibitNoStrict
# spent 17µs making 1 call to Sub::Install::BEGIN@170 # spent 10µs making 1 call to strict::unimport
17112µs *{"$pkg\::$name"} = $code;
17213µs return $code;
173 }
17439µs}
175
176
# spent 70µs (32+38) within Sub::Install::BEGIN@176 which was called: # once (32µs+38µs) by Data::OptList::BEGIN@11 at line 194
BEGIN {
17713µs15µs *_ignore_warnings = _do_with_warn({
# spent 5µs making 1 call to Sub::Install::_do_with_warn
178 carp => [ $_misc_warn_re, $_redef_warn_re ]
179 });
180
18113µs311µs *install_sub = _build_public_installer(_ignore_warnings(_installer));
# spent 5µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162] # spent 4µs making 1 call to Sub::Install::_build_public_installer # spent 2µs making 1 call to Sub::Install::_installer
182
18312µs12µs *_carp_warnings = _do_with_warn({
# spent 2µs making 1 call to Sub::Install::_do_with_warn
184 carp => [ $_misc_warn_re ],
185 suppress => [ $_redef_warn_re ],
186 });
187
18812µs36µs *reinstall_sub = _build_public_installer(_carp_warnings(_installer));
# spent 2µs making 1 call to Sub::Install::_build_public_installer # spent 2µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:162] # spent 2µs making 1 call to Sub::Install::_installer
189
19014µs214µs *_install_fatal = _do_with_warn({
# spent 12µ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 });
1941252µs170µs}
# spent 70µ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 13µs within Sub::Install::exporter which was called 2 times, avg 6µs/call: # once (7µs+0s) by Data::OptList::BEGIN@100 at line 101 of Data/OptList.pm # once (6µs+0s) by Sub::Install::BEGIN@273 at line 273
sub exporter {
2592800ns my ($arg) = @_;
260
26126µs my %is_exported = map { $_ => undef } @{ $arg->{exports} };
262
263
# spent 58µs (8+50) within Sub::Install::__ANON__[/usr/share/perl5/Sub/Install.pm:270] which was called: # once (8µs+50µs) by Class::Load::BEGIN@10 at line 10 of Class/Load.pm
sub {
2641300ns my $class = shift;
2651600ns my $target = caller;
26613µs for (@_) {
2671300ns Carp::croak "'$_' is not exported by $class" if !exists $is_exported{$_};
26813µs150µs install_sub({ code => $_, from => $class, into => $target });
# spent 50µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:118]
269 }
270 }
271212µs}
272
273138µs220µs
# spent 14µs (8+6) within Sub::Install::BEGIN@273 which was called: # once (8µs+6µs) by Data::OptList::BEGIN@11 at line 273
BEGIN { *import = exporter({ exports => [ qw(install_sub reinstall_sub) ] }); }
# spent 14µs making 1 call to Sub::Install::BEGIN@273 # spent 6µ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 3µ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 (1µ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
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.