← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:23:25 2010

File /usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm
Statements Executed 14335
Statement Execution Time 27.6ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
8881111.2ms15.2msSub::Install::::__ANON__[:175]Sub::Install::__ANON__[:175]
888219.79ms27.9msSub::Install::::__ANON__[:132]Sub::Install::__ANON__[:132]
888113.83ms4.00msSub::Install::::__ANON__[:187]Sub::Install::__ANON__[:187]
888112.52ms2.95msSub::Install::::_CODELIKESub::Install::_CODELIKE
2011110µs168µsSub::Install::::__ANON__[:173]Sub::Install::__ANON__[:173]
201241µs41µsSub::Install::::CORE:matchSub::Install::CORE:match (opcode)
11139µs105µsSub::Install::::BEGIN@190Sub::Install::BEGIN@190
33131µs31µsSub::Install::::__ANON__[:176]Sub::Install::__ANON__[:176]
22218µs18µsSub::Install::::exporterSub::Install::exporter
33118µs20µsSub::Install::::_do_with_warnSub::Install::_do_with_warn
201216µs16µsSub::Install::::CORE:regcompSub::Install::CORE:regcomp (opcode)
11113µs24µsSub::Install::::BEGIN@3Sub::Install::BEGIN@3
11112µs44µsSub::Install::::BEGIN@6Sub::Install::BEGIN@6
22110µs10µsSub::Install::::_build_public_installerSub::Install::_build_public_installer
11110µs16µsSub::Install::::BEGIN@139Sub::Install::BEGIN@139
11110µs21µsSub::Install::::BEGIN@287Sub::Install::BEGIN@287
1117µs19µsSub::Install::::BEGIN@184Sub::Install::BEGIN@184
3327µs7µsSub::Install::::CORE:qrSub::Install::CORE:qr (opcode)
3317µs7µsSub::Install::::_installerSub::Install::_installer
1116µs8µsSub::Install::::BEGIN@4Sub::Install::BEGIN@4
1116µs7µsSub::Install::::BEGIN@148Sub::Install::BEGIN@148
1116µs6µsSub::Install::::__ANON__[:284]Sub::Install::__ANON__[:284]
1113µs3µsSub::Install::::BEGIN@7Sub::Install::BEGIN@7
0000s0sSub::Install::::__ANON__[:156]Sub::Install::__ANON__[:156]
0000s0sSub::Install::::__ANON__[:250]Sub::Install::__ANON__[:250]
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
1package Sub::Install;
2
3321µs234µs
# spent 24µs (13+10) within Sub::Install::BEGIN@3 which was called # once (13µs+10µs) by Data::OptList::BEGIN@8 at line 3
use warnings;
# spent 24µs making 1 call to Sub::Install::BEGIN@3 # spent 10µs making 1 call to warnings::import
4317µs210µs
# spent 8µs (6+2) within Sub::Install::BEGIN@4 which was called # once (6µs+2µs) by Data::OptList::BEGIN@8 at line 4
use strict;
# spent 8µs making 1 call to Sub::Install::BEGIN@4 # spent 2µs making 1 call to strict::import
5
6320µs277µs
# spent 44µs (12+33) within Sub::Install::BEGIN@6 which was called # once (12µs+33µs) by Data::OptList::BEGIN@8 at line 6
use Carp;
# spent 44µs making 1 call to Sub::Install::BEGIN@6 # spent 33µs making 1 call to Exporter::import
73296µs13µs
# spent 3µs within Sub::Install::BEGIN@7 which was called # once (3µs+0s) by Data::OptList::BEGIN@8 at line 7
use Scalar::Util ();
# spent 3µs making 1 call to Sub::Install::BEGIN@7
8
9=head1 NAME
10
11Sub::Install - install subroutines into packages easily
12
13=head1 VERSION
14
15version 0.925
16
17=cut
18
191600nsour $VERSION = '0.925';
20
21=head1 SYNOPSIS
22
23 use Sub::Install;
24
25 Sub::Install::install_sub({
26 code => sub { ... },
27 into => $package,
28 as => $subname
29 });
30
31=head1 DESCRIPTION
32
33This module makes it easy to install subroutines into packages without the
34unslightly mess of C<no strict> or typeglobs lying about where just anyone can
35see them.
36
37=head1 FUNCTIONS
38
39=head2 install_sub
40
41 Sub::Install::install_sub({
42 code => \&subroutine,
43 into => "Finance::Shady",
44 as => 'launder',
45 });
46
47This routine installs a given code reference into a package as a normal
48subroutine. The above is equivalent to:
49
50 no strict 'refs';
51 *{"Finance::Shady" . '::' . "launder"} = \&subroutine;
52
53If C<into> is not given, the sub is installed into the calling package.
54
55If C<code> is not a code reference, it is looked for as an existing sub in the
56package named in the C<from> parameter. If C<from> is not given, it will look
57in the calling package.
58
59If C<as> is not given, and if C<code> is a name, C<as> will default to C<code>.
60If C<as> is not given, but if C<code> is a code ref, Sub::Install will try to
61find the name of the given code ref and use that as C<as>.
62
63That means that this code:
64
65 Sub::Install::install_sub({
66 code => 'twitch',
67 from => 'Person::InPain',
68 into => 'Person::Teenager',
69 as => 'dance',
70 });
71
72is the same as:
73
74 package Person::Teenager;
75
76 Sub::Install::install_sub({
77 code => Person::InPain->can('twitch'),
78 as => 'dance',
79 });
80
81=head2 reinstall_sub
82
83This routine behaves exactly like C<L</install_sub>>, but does not emit a
84warning if warnings are on and the destination is already defined.
85
86=cut
87
88sub _name_of_code {
89 my ($code) = @_;
90 require B;
91 my $name = B::svref_2object($code)->GV->NAME;
92 return $name unless $name =~ /\A__ANON__/;
93 return;
94}
95
96# See also Params::Util, to which this code was donated.
97
# spent 2.95ms (2.52+429µs) within Sub::Install::_CODELIKE which was called 888 times, avg 3µs/call: # 888 times (2.52ms+429µs) by Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:132] at line 117, avg 3µs/call
sub _CODELIKE {
988883.46ms888429µs (Scalar::Util::reftype($_[0])||'') eq 'CODE'
# spent 429µs making 888 calls to Scalar::Util::reftype, avg 483ns/call
99 || Scalar::Util::blessed($_[0])
100 && (overload::Method($_[0],'&{}') ? $_[0] : undef);
101}
102
103# do the heavy lifting
104
# spent 10µs within Sub::Install::_build_public_installer which was called 2 times, avg 5µs/call: # once (7µs+0s) by Sub::Install::BEGIN@190 at line 202 # once (4µs+0s) by Sub::Install::BEGIN@190 at line 195
sub _build_public_installer {
1052700ns my ($installer) = @_;
106
107
# spent 27.9ms (9.79+18.1) within Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:132] which was called 888 times, avg 31µs/call: # 886 times (9.75ms+18.0ms) by Sub::Exporter::default_installer at line 896 of Sub/Exporter.pm, avg 31µs/call # 2 times (39µs+83µs) by Sub::Exporter::setup_exporter at line 607 of Sub/Exporter.pm, avg 61µs/call
sub {
108888207µs my ($arg) = @_;
1098882.40ms my ($calling_pkg) = caller(0);
110
111 # I'd rather use ||= but I'm whoring for Devel::Cover.
11226641.54ms for (qw(into from)) { $arg->{$_} = $calling_pkg unless $arg->{$_} }
113
114 # This is the only absolutely required argument, in many cases.
115888110µs Carp::croak "named argument 'code' is not optional" unless $arg->{code};
116
1178881.01ms8882.95ms if (_CODELIKE($arg->{code})) {
# spent 2.95ms making 888 calls to Sub::Install::_CODELIKE, avg 3µs/call
118 $arg->{as} ||= _name_of_code($arg->{code});
119 } else {
120 Carp::croak
121 "couldn't find subroutine named $arg->{code} in package $arg->{from}"
122 unless my $code = $arg->{from}->can($arg->{code});
123
124 $arg->{as} = $arg->{code} unless $arg->{as};
125 $arg->{code} = $code;
126 }
127
128888100µs Carp::croak "couldn't determine name under which to install subroutine"
129 unless $arg->{as};
130
1318882.37ms88815.2ms $installer->(@$arg{qw(into as code) });
# spent 15.2ms making 888 calls to Sub::Install::__ANON__[Sub/Install.pm:175], avg 17µs/call
132 }
133212µs}
134
135# do the ugly work
136
1371100nsmy $_misc_warn_re;
13810smy $_redef_warn_re;
139
# spent 16µs (10+6) within Sub::Install::BEGIN@139 which was called # once (10µs+6µs) by Data::OptList::BEGIN@8 at line 145
BEGIN {
140110µs15µs $_misc_warn_re = qr/
# spent 5µs making 1 call to Sub::Install::CORE:qr
141 Prototype\ mismatch:\ sub\ .+? |
142 Constant subroutine \S+ redefined
143 /x;
14415µs1800ns $_redef_warn_re = qr/Subroutine\ \S+\ redefined/x;
# spent 800ns making 1 call to Sub::Install::CORE:qr
145130µs116µs}
# spent 16µs making 1 call to Sub::Install::BEGIN@139
146
14710smy $eow_re;
1481242µs28µs
# spent 7µs (6+1) within Sub::Install::BEGIN@148 which was called # once (6µs+1µs) by Data::OptList::BEGIN@8 at line 148
BEGIN { $eow_re = qr/ at .+? line \d+\.\Z/ };
# spent 7µs making 1 call to Sub::Install::BEGIN@148 # spent 1µs making 1 call to Sub::Install::CORE:qr
149
150
# spent 20µs (18+2) within Sub::Install::_do_with_warn which was called 3 times, avg 7µs/call: # once (6µs+2µs) by Sub::Install::BEGIN@190 at line 204 # once (7µs+0s) by Sub::Install::BEGIN@190 at line 197 # once (6µs+0s) by Sub::Install::BEGIN@190 at line 191
sub _do_with_warn {
15131µs my ($arg) = @_;
15232µs my $code = delete $arg->{code};
153
# spent 31µs within Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:176] which was called 3 times, avg 10µs/call: # once (26µs+0s) by Sub::Install::BEGIN@190 at line 195 # once (2µs+0s) by Sub::Install::BEGIN@190 at line 202 # once (2µs+0s) by Sub::Install::_do_with_warn at line 177
my $wants_code = sub {
1543800ns my $code = shift;
155
# spent 15.2ms (11.2+4.00) within Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:175] which was called 888 times, avg 17µs/call: # 888 times (11.2ms+4.00ms) by Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:132] at line 131, avg 17µs/call
sub {
1568882.02ms my $warn = $SIG{__WARN__} ? $SIG{__WARN__} : sub { warn @_ }; ## no critic
157
# spent 168µs (110+57) within Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:173] which was called 20 times, avg 8µs/call: # 20 times (110µs+57µs) by Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:187] at line 185, avg 8µs/call
local $SIG{__WARN__} = sub {
158208µs my ($error) = @_;
1592011µs for (@{ $arg->{suppress} }) {
16020163µs4057µs return if $error =~ $_;
# spent 41µs making 20 calls to Sub::Install::CORE:match, avg 2µs/call # spent 16µs making 20 calls to Sub::Install::CORE:regcomp, avg 810ns/call
161 }
162 for (@{ $arg->{croak} }) {
163 if (my ($base_error) = $error =~ /\A($_) $eow_re/x) {
164 Carp::croak $base_error;
165 }
166 }
167 for (@{ $arg->{carp} }) {
168 if (my ($base_error) = $error =~ /\A($_) $eow_re/x) {
169 return $warn->(Carp::shortmess $base_error);
170 }
171 }
172 ($arg->{default} || $warn)->($error);
1738882.84ms };
1748885.63ms8884.00ms $code->(@_);
# spent 4.00ms making 888 calls to Sub::Install::__ANON__[Sub/Install.pm:187], avg 5µs/call
175335µs };
17635µs };
17733µs12µs return $wants_code->($code) if $code;
# spent 2µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:176]
178211µs return $wants_code;
179}
180
181
# spent 7µs within Sub::Install::_installer which was called 3 times, avg 2µs/call: # once (2µs+0s) by Sub::Install::BEGIN@190 at line 195 # once (2µs+0s) by Sub::Install::BEGIN@190 at line 202 # once (2µs+0s) by Sub::Install::BEGIN@190 at line 204
sub _installer {
182
# spent 4.00ms (3.83+168µs) within Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:187] which was called 888 times, avg 5µs/call: # 888 times (3.83ms+168µs) by Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:175] at line 174, avg 5µs/call
sub {
183888437µs my ($pkg, $name, $code) = @_;
1843112µs231µs
# spent 19µs (7+12) within Sub::Install::BEGIN@184 which was called # once (7µs+12µs) by Data::OptList::BEGIN@8 at line 184
no strict 'refs'; ## no critic ProhibitNoStrict
# spent 19µs making 1 call to Sub::Install::BEGIN@184 # spent 12µs making 1 call to strict::unimport
1858882.25ms20168µs *{"$pkg\::$name"} = $code;
# spent 168µs making 20 calls to Sub::Install::__ANON__[Sub/Install.pm:173], avg 8µs/call
1868881.93ms return $code;
187 }
188314µs}
189
190
# spent 105µs (39+66) within Sub::Install::BEGIN@190 which was called # once (39µs+66µs) by Data::OptList::BEGIN@8 at line 208
BEGIN {
19113µs16µs *_ignore_warnings = _do_with_warn({
# spent 6µs making 1 call to Sub::Install::_do_with_warn
192 carp => [ $_misc_warn_re, $_redef_warn_re ]
193 });
194
19513µs333µs *install_sub = _build_public_installer(_ignore_warnings(_installer));
# spent 26µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:176] # spent 4µs making 1 call to Sub::Install::_build_public_installer # spent 2µs making 1 call to Sub::Install::_installer
196
19712µs17µs *_carp_warnings = _do_with_warn({
# spent 7µs making 1 call to Sub::Install::_do_with_warn
198 carp => [ $_misc_warn_re ],
199 suppress => [ $_redef_warn_re ],
200 });
201
20213µs311µs *reinstall_sub = _build_public_installer(_carp_warnings(_installer));
# spent 7µs making 1 call to Sub::Install::_build_public_installer # spent 2µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:176] # spent 2µs making 1 call to Sub::Install::_installer
203
20417µs210µs *_install_fatal = _do_with_warn({
# spent 8µs making 1 call to Sub::Install::_do_with_warn # spent 2µs making 1 call to Sub::Install::_installer
205 code => _installer,
206 croak => [ $_redef_warn_re ],
207 });
2081212µs1105µs}
# spent 105µs making 1 call to Sub::Install::BEGIN@190
209
210=head2 install_installers
211
212This routine is provided to allow Sub::Install compatibility with
213Sub::Installer. It installs C<install_sub> and C<reinstall_sub> methods into
214the package named by its argument.
215
216 Sub::Install::install_installers('Code::Builder'); # just for us, please
217 Code::Builder->install_sub({ name => $code_ref });
218
219 Sub::Install::install_installers('UNIVERSAL'); # feeling lucky, punk?
220 Anything::At::All->install_sub({ name => $code_ref });
221
222The installed installers are similar, but not identical, to those provided by
223Sub::Installer. They accept a single hash as an argument. The key/value pairs
224are used as the C<as> and C<code> parameters to the C<install_sub> routine
225detailed above. The package name on which the method is called is used as the
226C<into> parameter.
227
228Unlike Sub::Installer's C<install_sub> will not eval strings into code, but
229will look for named code in the calling package.
230
231=cut
232
233sub install_installers {
234 my ($into) = @_;
235
236 for my $method (qw(install_sub reinstall_sub)) {
237 my $code = sub {
238 my ($package, $subs) = @_;
239 my ($caller) = caller(0);
240 my $return;
241 for (my ($name, $sub) = %$subs) {
242 $return = Sub::Install->can($method)->({
243 code => $sub,
244 from => $caller,
245 into => $package,
246 as => $name
247 });
248 }
249 return $return;
250 };
251 install_sub({ code => $code, into => $into, as => $method });
252 }
253}
254
255=head1 EXPORTS
256
257Sub::Install exports C<install_sub> and C<reinstall_sub> only if they are
258requested.
259
260=head2 exporter
261
262Sub::Install has a never-exported subroutine called C<exporter>, which is used
263to implement its C<import> routine. It takes a hashref of named arguments,
264only one of which is currently recognize: C<exports>. This must be an arrayref
265of subroutines to offer for export.
266
267This routine is mainly for Sub::Install's own consumption. Instead, consider
268L<Sub::Exporter>.
269
270=cut
271
272
# spent 18µs within Sub::Install::exporter which was called 2 times, avg 9µs/call: # once (11µs+0s) by Sub::Install::BEGIN@287 at line 287 # once (7µs+0s) by Data::OptList::BEGIN@214 at line 215 of Data/OptList.pm
sub exporter {
27321µs my ($arg) = @_;
274
27526µs my %is_exported = map { $_ => undef } @{ $arg->{exports} };
276
277
# spent 6µs within Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:284] which was called # once (6µs+0s) by Moose::Util::BEGIN@6 at line 6 of Moose/Util.pm
sub {
2781800ns my $class = shift;
27911µs my $target = caller;
28015µs for (@_) {
281 Carp::croak "'$_' is not exported by $class" if !exists $is_exported{$_};
282 install_sub({ code => $_, from => $class, into => $target });
283 }
284 }
285217µs}
286
287149µs232µs
# spent 21µs (10+11) within Sub::Install::BEGIN@287 which was called # once (10µs+11µs) by Data::OptList::BEGIN@8 at line 287
BEGIN { *import = exporter({ exports => [ qw(install_sub reinstall_sub) ] }); }
# spent 21µs making 1 call to Sub::Install::BEGIN@287 # spent 11µs making 1 call to Sub::Install::exporter
288
289=head1 SEE ALSO
290
291=over
292
293=item L<Sub::Installer>
294
295This module is (obviously) a reaction to Damian Conway's Sub::Installer, which
296does the same thing, but does it by getting its greasy fingers all over
297UNIVERSAL. I was really happy about the idea of making the installation of
298coderefs less ugly, but I couldn't bring myself to replace the ugliness of
299typeglobs and loosened strictures with the ugliness of UNIVERSAL methods.
300
301=item L<Sub::Exporter>
302
303This is a complete Exporter.pm replacement, built atop Sub::Install.
304
305=back
306
307=head1 AUTHOR
308
309Ricardo Signes, C<< <rjbs@cpan.org> >>
310
311Several of the tests are adapted from tests that shipped with Damian Conway's
312Sub-Installer distribution.
313
314=head1 BUGS
315
316Please report any bugs or feature requests through the web interface at
317L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
318notified of progress on your bug as I make changes.
319
320=head1 COPYRIGHT
321
322Copyright 2005-2006 Ricardo Signes, All Rights Reserved.
323
324This program is free software; you can redistribute it and/or modify it
325under the same terms as Perl itself.
326
327=cut
328
32914µs1;
# spent 41µs within Sub::Install::CORE:match which was called 20 times, avg 2µs/call: # 20 times (41µs+0s) by Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:173] at line 160 of Sub/Install.pm, avg 2µs/call
sub Sub::Install::CORE:match; # xsub
# spent 7µs within Sub::Install::CORE:qr which was called 3 times, avg 2µs/call: # once (5µs+0s) by Sub::Install::BEGIN@139 at line 140 of Sub/Install.pm # once (1µs+0s) by Sub::Install::BEGIN@148 at line 148 of Sub/Install.pm # once (800ns+0s) by Sub::Install::BEGIN@139 at line 144 of Sub/Install.pm
sub Sub::Install::CORE:qr; # xsub
# spent 16µs within Sub::Install::CORE:regcomp which was called 20 times, avg 810ns/call: # 20 times (16µs+0s) by Sub::Install::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Install.pm:173] at line 160 of Sub/Install.pm, avg 810ns/call
sub Sub::Install::CORE:regcomp; # xsub