← Index
NYTProf Performance Profile   « line view »
For flows_to_es.pl
  Run on Mon May 9 23:27:59 2016
Reported on Mon May 9 23:28:08 2016

Filename/opt/flows/lib/lib/perl5/Sub/Install.pm
StatementsExecuted 585 statements in 2.92ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
3311556µs746µsSub::Install::::__ANON__[:161] Sub::Install::__ANON__[:161]
3321424µs1.33msSub::Install::::__ANON__[:118] Sub::Install::__ANON__[:118]
3311190µs190µsSub::Install::::__ANON__[:173] Sub::Install::__ANON__[:173]
3311126µs158µsSub::Install::::_CODELIKE Sub::Install::_CODELIKE
11142µs85µsSub::Install::::BEGIN@176 Sub::Install::BEGIN@176
22220µs20µsSub::Install::::exporter Sub::Install::exporter
33119µs21µsSub::Install::::_do_with_warn Sub::Install::_do_with_warn
11114µs17µsSub::Install::::BEGIN@125 Sub::Install::BEGIN@125
11114µs28µsData::OptList::::BEGIN@1Data::OptList::BEGIN@1
11112µs24µsSub::Install::::BEGIN@273 Sub::Install::BEGIN@273
1119µs48µsSub::Install::::BEGIN@6 Sub::Install::BEGIN@6
3319µs9µsSub::Install::::_installer Sub::Install::_installer
1119µs14µsData::OptList::::BEGIN@2Data::OptList::BEGIN@2
1118µs21µsSub::Install::::BEGIN@170 Sub::Install::BEGIN@170
2218µs8µsSub::Install::::_build_public_installer Sub::Install::_build_public_installer
1118µs9µsSub::Install::::BEGIN@134 Sub::Install::BEGIN@134
3317µs7µsSub::Install::::__ANON__[:162] Sub::Install::__ANON__[:162]
3314µs4µsSub::Install::::CORE:qr Sub::Install::CORE:qr (opcode)
1114µs4µ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::::__ANON__[:270] Sub::Install::__ANON__[:270]
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
1229µs243µs
# spent 28µs (14+14) within Data::OptList::BEGIN@1 which was called: # once (14µs+14µs) by Data::OptList::BEGIN@8 at line 1
use strict;
# spent 28µs making 1 call to Data::OptList::BEGIN@1 # spent 14µs making 1 call to strict::import
2242µs219µs
# spent 14µs (9+5) within Data::OptList::BEGIN@2 which was called: # once (9µs+5µs) by Data::OptList::BEGIN@8 at line 2
use warnings;
# spent 14µs making 1 call to Data::OptList::BEGIN@2 # spent 5µs making 1 call to warnings::import
3package Sub::Install;
4# ABSTRACT: install subroutines into packages easily
51600ns$Sub::Install::VERSION = '0.928';
6228µs287µs
# spent 48µs (9+39) within Sub::Install::BEGIN@6 which was called: # once (9µs+39µs) by Data::OptList::BEGIN@8 at line 6
use Carp;
# spent 48µs making 1 call to Sub::Install::BEGIN@6 # spent 39µs making 1 call to Exporter::import
72427µs14µs
# spent 4µs within Sub::Install::BEGIN@7 which was called: # once (4µs+0s) by Data::OptList::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 158µs (126+32) within Sub::Install::_CODELIKE which was called 33 times, avg 5µs/call: # 33 times (126µs+32µs) by Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:118] at line 103, avg 5µs/call
sub _CODELIKE {
8433192µs3332µs (Scalar::Util::reftype($_[0])||'') eq 'CODE'
# spent 32µs making 33 calls to Scalar::Util::reftype, avg 964ns/call
85 || Scalar::Util::blessed($_[0])
86 && (overload::Method($_[0],'&{}') ? $_[0] : undef);
87}
88
89# do the heavy lifting
90
# spent 8µs within Sub::Install::_build_public_installer which was called 2 times, avg 4µs/call: # once (5µs+0s) by Sub::Install::BEGIN@176 at line 188 # once (3µs+0s) by Sub::Install::BEGIN@176 at line 181
sub _build_public_installer {
912600ns my ($installer) = @_;
92
93
# spent 1.33ms (424µs+904µs) within Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:118] which was called 33 times, avg 40µs/call: # 32 times (408µs+872µs) by Sub::Exporter::default_installer at line 442 of /opt/flows/lib/lib/perl5/Sub/Exporter.pm, avg 40µs/call # once (16µs+32µs) by Sub::Exporter::setup_exporter at line 198 of /opt/flows/lib/lib/perl5/Sub/Exporter.pm
sub {
94339µs my ($arg) = @_;
9533112µs my ($calling_pkg) = caller(0);
96
97 # I'd rather use ||= but I'm whoring for Devel::Cover.
989974µs for (qw(into from)) { $arg->{$_} = $calling_pkg unless $arg->{$_} }
99
100 # This is the only absolutely required argument, in many cases.
101339µs Carp::croak "named argument 'code' is not optional" unless $arg->{code};
102
1033351µs33158µs if (_CODELIKE($arg->{code})) {
# spent 158µs making 33 calls to Sub::Install::_CODELIKE, avg 5µ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
114338µs Carp::croak "couldn't determine name under which to install subroutine"
115 unless $arg->{as};
116
11733114µs33746µs $installer->(@$arg{qw(into as code) });
# spent 746µs making 33 calls to Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:161], avg 23µs/call
118 }
119211µs}
120
121# do the ugly work
122
1231100nsmy $_misc_warn_re;
1241100nsmy $_redef_warn_re;
125
# spent 17µs (14+3) within Sub::Install::BEGIN@125 which was called: # once (14µs+3µs) by Data::OptList::BEGIN@8 at line 131
BEGIN {
12618µ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;
13016µs11µs $_redef_warn_re = qr/Subroutine\ .+?\ redefined/x;
# spent 1µs making 1 call to Sub::Install::CORE:qr
131139µs117µs}
# spent 17µs making 1 call to Sub::Install::BEGIN@125
132
13310smy $eow_re;
1341338µs210µs
# spent 9µs (8+1) within Sub::Install::BEGIN@134 which was called: # once (8µs+1µs) by Data::OptList::BEGIN@8 at line 134
BEGIN { $eow_re = qr/ at .+? line \d+\.\Z/ };
# spent 9µs making 1 call to Sub::Install::BEGIN@134 # spent 1µs making 1 call to Sub::Install::CORE:qr
135
136
# spent 21µs (19+2) within Sub::Install::_do_with_warn which was called 3 times, avg 7µs/call: # once (9µs+2µs) by Sub::Install::BEGIN@176 at line 190 # once (6µs+0s) by Sub::Install::BEGIN@176 at line 177 # once (3µs+0s) by Sub::Install::BEGIN@176 at line 183
sub _do_with_warn {
13731µs my ($arg) = @_;
13832µs my $code = delete $arg->{code};
139
# spent 7µs within Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:162] which was called 3 times, avg 2µs/call: # once (3µs+0s) by Sub::Install::BEGIN@176 at line 188 # once (3µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (2µs+0s) by Sub::Install::_do_with_warn at line 163
my $wants_code = sub {
1403800ns my $code = shift;
141
# spent 746µs (556+190) within Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:161] which was called 33 times, avg 23µs/call: # 33 times (556µs+190µs) by Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:118] at line 117, avg 23µs/call
sub {
1423380µ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);
15933156µs };
16033302µs33190µs $code->(@_);
# spent 190µs making 33 calls to Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:173], avg 6µs/call
161315µs };
16236µs };
16334µs12µs return $wants_code->($code) if $code;
# spent 2µs making 1 call to Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:162]
16429µs return $wants_code;
165}
166
167
# spent 9µs within Sub::Install::_installer which was called 3 times, avg 3µs/call: # once (4µs+0s) by Sub::Install::BEGIN@176 at line 188 # once (2µs+0s) by Sub::Install::BEGIN@176 at line 181 # once (2µs+0s) by Sub::Install::BEGIN@176 at line 190
sub _installer {
168
# spent 190µs within Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:173] which was called 33 times, avg 6µs/call: # 33 times (190µs+0s) by Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:161] at line 160, avg 6µs/call
sub {
1693314µs my ($pkg, $name, $code) = @_;
1702162µs234µs
# spent 21µs (8+13) within Sub::Install::BEGIN@170 which was called: # once (8µs+13µs) by Data::OptList::BEGIN@8 at line 170
no strict 'refs'; ## no critic ProhibitNoStrict
# spent 21µs making 1 call to Sub::Install::BEGIN@170 # spent 13µs making 1 call to strict::unimport
17133136µs *{"$pkg\::$name"} = $code;
1723399µs return $code;
173 }
174315µs}
175
176
# spent 85µs (42+43) within Sub::Install::BEGIN@176 which was called: # once (42µs+43µs) by Data::OptList::BEGIN@8 at line 194
BEGIN {
17713µs16µs *_ignore_warnings = _do_with_warn({
# spent 6µs making 1 call to Sub::Install::_do_with_warn
178 carp => [ $_misc_warn_re, $_redef_warn_re ]
179 });
180
18113µs38µs *install_sub = _build_public_installer(_ignore_warnings(_installer));
# spent 3µs making 1 call to Sub::Install::_build_public_installer # spent 3µs making 1 call to Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:162] # spent 2µs making 1 call to Sub::Install::_installer
182
18313µs13µs *_carp_warnings = _do_with_warn({
# spent 3µs making 1 call to Sub::Install::_do_with_warn
184 carp => [ $_misc_warn_re ],
185 suppress => [ $_redef_warn_re ],
186 });
187
18813µs312µs *reinstall_sub = _build_public_installer(_carp_warnings(_installer));
# spent 5µs making 1 call to Sub::Install::_build_public_installer # spent 4µs making 1 call to Sub::Install::_installer # spent 3µs making 1 call to Sub::Install::__ANON__[/opt/flows/lib/lib/perl5/Sub/Install.pm:162]
189
19016µs213µs *_install_fatal = _do_with_warn({
# spent 11µ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 });
1941314µs185µs}
# spent 85µ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 20µs within Sub::Install::exporter which was called 2 times, avg 10µs/call: # once (11µs+0s) by Sub::Install::BEGIN@273 at line 273 # once (8µs+0s) by Data::OptList::BEGIN@232 at line 233 of /opt/flows/lib/lib/perl5/Data/OptList.pm
sub exporter {
25921µs my ($arg) = @_;
260
26128µs my %is_exported = map { $_ => undef } @{ $arg->{exports} };
262
263 sub {
264 my $class = shift;
265 my $target = caller;
266 for (@_) {
267 Carp::croak "'$_' is not exported by $class" if !exists $is_exported{$_};
268 install_sub({ code => $_, from => $class, into => $target });
269 }
270 }
271220µs}
272
273153µs235µs
# spent 24µs (12+11) within Sub::Install::BEGIN@273 which was called: # once (12µs+11µs) by Data::OptList::BEGIN@8 at line 273
BEGIN { *import = exporter({ exports => [ qw(install_sub reinstall_sub) ] }); }
# spent 24µs making 1 call to Sub::Install::BEGIN@273 # spent 11µ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 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 (1µs+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.