Filename | /opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Install.pm |
Statements | Executed 734 statements in 3.47ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
41 | 1 | 1 | 745µs | 950µs | __ANON__[:100] | Sub::Install::
41 | 5 | 3 | 633µs | 1.80ms | __ANON__[:57] | Sub::Install::
41 | 1 | 1 | 205µs | 205µs | __ANON__[:112] | Sub::Install::
41 | 1 | 1 | 177µs | 214µs | _CODELIKE | Sub::Install::
1 | 1 | 1 | 56µs | 104µs | BEGIN@115 | Sub::Install::
5 | 5 | 5 | 29µs | 108µs | __ANON__[:171] | Sub::Install::
2 | 2 | 2 | 24µs | 24µs | exporter | Sub::Install::
3 | 3 | 1 | 19µs | 22µs | _do_with_warn | Sub::Install::
1 | 1 | 1 | 16µs | 19µs | BEGIN@64 | Sub::Install::
1 | 1 | 1 | 15µs | 32µs | BEGIN@1 | Data::OptList::
2 | 2 | 1 | 14µs | 14µs | _build_public_installer | Sub::Install::
1 | 1 | 1 | 13µs | 28µs | BEGIN@174 | Sub::Install::
1 | 1 | 1 | 9µs | 14µs | BEGIN@2 | Data::OptList::
1 | 1 | 1 | 9µs | 50µs | BEGIN@9 | Sub::Install::
1 | 1 | 1 | 9µs | 23µs | BEGIN@109 | Sub::Install::
3 | 3 | 1 | 9µs | 9µs | __ANON__[:101] | Sub::Install::
1 | 1 | 1 | 8µs | 10µs | BEGIN@73 | Sub::Install::
3 | 3 | 1 | 8µs | 8µs | _installer | Sub::Install::
3 | 3 | 1 | 5µs | 5µs | CORE:qr (opcode) | Sub::Install::
1 | 1 | 1 | 4µs | 4µs | BEGIN@10 | Sub::Install::
0 | 0 | 0 | 0s | 0s | __ANON__[:153] | Sub::Install::
0 | 0 | 0 | 0s | 0s | __ANON__[:81] | Sub::Install::
0 | 0 | 0 | 0s | 0s | __ANON__[:98] | Sub::Install::
0 | 0 | 0 | 0s | 0s | _name_of_code | Sub::Install::
0 | 0 | 0 | 0s | 0s | install_installers | Sub::Install::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | 2 | 31µs | 2 | 48µs | # spent 32µs (15+17) within Data::OptList::BEGIN@1 which was called:
# once (15µs+17µs) by Data::OptList::BEGIN@11 at line 1 # spent 32µs making 1 call to Data::OptList::BEGIN@1
# spent 17µs making 1 call to strict::import |
2 | 2 | 52µs | 2 | 19µs | # spent 14µs (9+5) within Data::OptList::BEGIN@2 which was called:
# once (9µs+5µs) by Data::OptList::BEGIN@11 at line 2 # spent 14µs making 1 call to Data::OptList::BEGIN@2
# spent 5µs making 1 call to warnings::import |
3 | package Sub::Install; | ||||
4 | { | ||||
5 | 2 | 1µs | $Sub::Install::VERSION = '0.927'; | ||
6 | } | ||||
7 | # ABSTRACT: install subroutines into packages easily | ||||
8 | |||||
9 | 2 | 38µs | 2 | 91µs | # spent 50µs (9+41) within Sub::Install::BEGIN@9 which was called:
# once (9µs+41µs) by Data::OptList::BEGIN@11 at line 9 # spent 50µs making 1 call to Sub::Install::BEGIN@9
# spent 41µs making 1 call to Exporter::import |
10 | 2 | 456µs | 1 | 4µs | # spent 4µs within Sub::Install::BEGIN@10 which was called:
# once (4µs+0s) by Data::OptList::BEGIN@11 at line 10 # spent 4µs making 1 call to Sub::Install::BEGIN@10 |
11 | |||||
12 | |||||
13 | sub _name_of_code { | ||||
14 | my ($code) = @_; | ||||
15 | require B; | ||||
16 | my $name = B::svref_2object($code)->GV->NAME; | ||||
17 | return $name unless $name =~ /\A__ANON__/; | ||||
18 | return; | ||||
19 | } | ||||
20 | |||||
21 | # See also Params::Util, to which this code was donated. | ||||
22 | # spent 214µs (177+36) within Sub::Install::_CODELIKE which was called 41 times, avg 5µs/call:
# 41 times (177µs+36µs) by Sub::Install::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Install.pm:57] at line 42, avg 5µs/call | ||||
23 | 41 | 249µs | 42 | 36µs | (Scalar::Util::reftype($_[0])||'') eq 'CODE' # spent 36µs making 41 calls to Scalar::Util::reftype, avg 871ns/call
# spent 700ns making 1 call to Scalar::Util::blessed |
24 | || Scalar::Util::blessed($_[0]) | ||||
25 | && (overload::Method($_[0],'&{}') ? $_[0] : undef); | ||||
26 | } | ||||
27 | |||||
28 | # do the heavy lifting | ||||
29 | sub _build_public_installer { | ||||
30 | 2 | 500ns | my ($installer) = @_; | ||
31 | |||||
32 | # spent 1.80ms (633µs+1.16) within Sub::Install::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Install.pm:57] which was called 41 times, avg 44µs/call:
# 34 times (491µs+914µs) by Sub::Exporter::default_installer at line 442 of Sub/Exporter.pm, avg 41µs/call
# 2 times (46µs+83µs) by Package::DeprecationManager::import at line 29 of Package/DeprecationManager.pm, avg 64µs/call
# 2 times (41µs+68µs) by Sub::Exporter::setup_exporter at line 198 of Sub/Exporter.pm, avg 55µs/call
# 2 times (27µs+49µs) by Package::DeprecationManager::import at line 37 of Package/DeprecationManager.pm, avg 38µs/call
# once (28µs+51µs) by Sub::Install::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Install.pm:171] at line 169 | ||||
33 | 41 | 9µs | my ($arg) = @_; | ||
34 | 41 | 161µs | my ($calling_pkg) = caller(0); | ||
35 | |||||
36 | # I'd rather use ||= but I'm whoring for Devel::Cover. | ||||
37 | 123 | 94µs | for (qw(into from)) { $arg->{$_} = $calling_pkg unless $arg->{$_} } | ||
38 | |||||
39 | # This is the only absolutely required argument, in many cases. | ||||
40 | 41 | 12µs | Carp::croak "named argument 'code' is not optional" unless $arg->{code}; | ||
41 | |||||
42 | 41 | 63µs | 41 | 214µs | if (_CODELIKE($arg->{code})) { # spent 214µs making 41 calls to Sub::Install::_CODELIKE, avg 5µs/call |
43 | $arg->{as} ||= _name_of_code($arg->{code}); | ||||
44 | } else { | ||||
45 | 1 | 9µs | 1 | 2µs | Carp::croak # spent 2µs making 1 call to UNIVERSAL::can |
46 | "couldn't find subroutine named $arg->{code} in package $arg->{from}" | ||||
47 | unless my $code = $arg->{from}->can($arg->{code}); | ||||
48 | |||||
49 | 1 | 900ns | $arg->{as} = $arg->{code} unless $arg->{as}; | ||
50 | 1 | 700ns | $arg->{code} = $code; | ||
51 | } | ||||
52 | |||||
53 | 41 | 8µs | Carp::croak "couldn't determine name under which to install subroutine" | ||
54 | unless $arg->{as}; | ||||
55 | |||||
56 | 41 | 165µs | 41 | 950µs | $installer->(@$arg{qw(into as code) }); # spent 950µs making 41 calls to Sub::Install::__ANON__[Sub/Install.pm:100], avg 23µs/call |
57 | } | ||||
58 | 2 | 18µs | } | ||
59 | |||||
60 | # do the ugly work | ||||
61 | |||||
62 | 1 | 100ns | my $_misc_warn_re; | ||
63 | 1 | 0s | my $_redef_warn_re; | ||
64 | # spent 19µs (16+4) within Sub::Install::BEGIN@64 which was called:
# once (16µs+4µs) by Data::OptList::BEGIN@11 at line 70 | ||||
65 | 1 | 10µs | 1 | 2µs | $_misc_warn_re = qr/ # spent 2µs making 1 call to Sub::Install::CORE:qr |
66 | Prototype\ mismatch:\ sub\ .+? | | ||||
67 | Constant subroutine \S+ redefined | ||||
68 | /x; | ||||
69 | 1 | 8µs | 1 | 1µs | $_redef_warn_re = qr/Subroutine\ \S+\ redefined/x; # spent 1µs making 1 call to Sub::Install::CORE:qr |
70 | 1 | 44µs | 1 | 19µs | } # spent 19µs making 1 call to Sub::Install::BEGIN@64 |
71 | |||||
72 | 1 | 0s | my $eow_re; | ||
73 | 1 | 362µs | 2 | 11µs | # spent 10µs (8+2) within Sub::Install::BEGIN@73 which was called:
# once (8µs+2µs) by Data::OptList::BEGIN@11 at line 73 # spent 10µs making 1 call to Sub::Install::BEGIN@73
# spent 2µs making 1 call to Sub::Install::CORE:qr |
74 | |||||
75 | sub _do_with_warn { | ||||
76 | 3 | 900ns | my ($arg) = @_; | ||
77 | 3 | 2µs | my $code = delete $arg->{code}; | ||
78 | # spent 9µs within Sub::Install::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Install.pm:101] which was called 3 times, avg 3µs/call:
# once (3µs+0s) by Sub::Install::BEGIN@115 at line 120
# once (3µs+0s) by Sub::Install::_do_with_warn at line 102
# once (3µs+0s) by Sub::Install::BEGIN@115 at line 127 | ||||
79 | 3 | 600ns | my $code = shift; | ||
80 | # spent 950µs (745+205) within Sub::Install::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Install.pm:100] which was called 41 times, avg 23µs/call:
# 41 times (745µs+205µs) by Sub::Install::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Install.pm:57] at line 56, avg 23µs/call | ||||
81 | 41 | 101µs | my $warn = $SIG{__WARN__} ? $SIG{__WARN__} : sub { warn @_ }; ## no critic | ||
82 | local $SIG{__WARN__} = sub { | ||||
83 | my ($error) = @_; | ||||
84 | for (@{ $arg->{suppress} }) { | ||||
85 | return if $error =~ $_; | ||||
86 | } | ||||
87 | for (@{ $arg->{croak} }) { | ||||
88 | if (my ($base_error) = $error =~ /\A($_) $eow_re/x) { | ||||
89 | Carp::croak $base_error; | ||||
90 | } | ||||
91 | } | ||||
92 | for (@{ $arg->{carp} }) { | ||||
93 | if (my ($base_error) = $error =~ /\A($_) $eow_re/x) { | ||||
94 | return $warn->(Carp::shortmess $base_error); | ||||
95 | } | ||||
96 | } | ||||
97 | ($arg->{default} || $warn)->($error); | ||||
98 | 41 | 177µs | }; | ||
99 | 41 | 423µs | 41 | 205µs | $code->(@_); # spent 205µs making 41 calls to Sub::Install::__ANON__[Sub/Install.pm:112], avg 5µs/call |
100 | 3 | 20µs | }; | ||
101 | 3 | 7µs | }; | ||
102 | 3 | 5µs | 1 | 3µs | return $wants_code->($code) if $code; # spent 3µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:101] |
103 | 2 | 10µs | return $wants_code; | ||
104 | } | ||||
105 | |||||
106 | sub _installer { | ||||
107 | # spent 205µs within Sub::Install::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Install.pm:112] which was called 41 times, avg 5µs/call:
# 41 times (205µs+0s) by Sub::Install::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Install.pm:100] at line 99, avg 5µs/call | ||||
108 | 41 | 17µs | my ($pkg, $name, $code) = @_; | ||
109 | 2 | 176µs | 2 | 37µs | # spent 23µs (9+14) within Sub::Install::BEGIN@109 which was called:
# once (9µs+14µs) by Data::OptList::BEGIN@11 at line 109 # spent 23µs making 1 call to Sub::Install::BEGIN@109
# spent 14µs making 1 call to strict::unimport |
110 | 41 | 123µs | *{"$pkg\::$name"} = $code; | ||
111 | 41 | 134µs | return $code; | ||
112 | } | ||||
113 | 3 | 14µs | } | ||
114 | |||||
115 | # spent 104µs (56+49) within Sub::Install::BEGIN@115 which was called:
# once (56µs+49µs) by Data::OptList::BEGIN@11 at line 133 | ||||
116 | 1 | 3µs | 1 | 6µs | *_ignore_warnings = _do_with_warn({ # spent 6µs making 1 call to Sub::Install::_do_with_warn |
117 | carp => [ $_misc_warn_re, $_redef_warn_re ] | ||||
118 | }); | ||||
119 | |||||
120 | 1 | 4µs | 3 | 16µs | *install_sub = _build_public_installer(_ignore_warnings(_installer)); # spent 10µs making 1 call to Sub::Install::_build_public_installer
# spent 3µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:101]
# spent 3µs making 1 call to Sub::Install::_installer |
121 | |||||
122 | 1 | 3µs | 1 | 4µs | *_carp_warnings = _do_with_warn({ # spent 4µs making 1 call to Sub::Install::_do_with_warn |
123 | carp => [ $_misc_warn_re ], | ||||
124 | suppress => [ $_redef_warn_re ], | ||||
125 | }); | ||||
126 | |||||
127 | 1 | 3µs | 3 | 9µs | *reinstall_sub = _build_public_installer(_carp_warnings(_installer)); # spent 3µs making 1 call to Sub::Install::_build_public_installer
# spent 3µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:101]
# spent 2µs making 1 call to Sub::Install::_installer |
128 | |||||
129 | 1 | 10µs | 2 | 13µ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 |
130 | code => _installer, | ||||
131 | croak => [ $_redef_warn_re ], | ||||
132 | }); | ||||
133 | 1 | 317µs | 1 | 104µs | } # spent 104µs making 1 call to Sub::Install::BEGIN@115 |
134 | |||||
135 | |||||
136 | sub install_installers { | ||||
137 | my ($into) = @_; | ||||
138 | |||||
139 | for my $method (qw(install_sub reinstall_sub)) { | ||||
140 | my $code = sub { | ||||
141 | my ($package, $subs) = @_; | ||||
142 | my ($caller) = caller(0); | ||||
143 | my $return; | ||||
144 | for (my ($name, $sub) = %$subs) { | ||||
145 | $return = Sub::Install->can($method)->({ | ||||
146 | code => $sub, | ||||
147 | from => $caller, | ||||
148 | into => $package, | ||||
149 | as => $name | ||||
150 | }); | ||||
151 | } | ||||
152 | return $return; | ||||
153 | }; | ||||
154 | install_sub({ code => $code, into => $into, as => $method }); | ||||
155 | } | ||||
156 | } | ||||
157 | |||||
158 | |||||
159 | # spent 24µs within Sub::Install::exporter which was called 2 times, avg 12µs/call:
# once (15µs+0s) by Sub::Install::BEGIN@174 at line 174
# once (9µs+0s) by Data::OptList::BEGIN@100 at line 101 of Data/OptList.pm | ||||
160 | 2 | 1µs | my ($arg) = @_; | ||
161 | |||||
162 | 2 | 8µs | my %is_exported = map { $_ => undef } @{ $arg->{exports} }; | ||
163 | |||||
164 | # spent 108µs (29+79) within Sub::Install::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Install.pm:171] which was called 5 times, avg 22µs/call:
# once (12µs+79µs) by Class::Load::BEGIN@8 at line 8 of Class/Load.pm
# once (5µs+0s) by Moose::Meta::Class::BEGIN@16 at line 16 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@20 at line 20 of Class/MOP.pm
# once (4µs+0s) by Moose::Util::BEGIN@13 at line 13 of Moose/Util.pm | ||||
165 | 5 | 2µs | my $class = shift; | ||
166 | 5 | 3µs | my $target = caller; | ||
167 | 5 | 29µs | for (@_) { | ||
168 | 1 | 500ns | Carp::croak "'$_' is not exported by $class" if !exists $is_exported{$_}; | ||
169 | 1 | 5µs | 1 | 79µs | install_sub({ code => $_, from => $class, into => $target }); # spent 79µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:57] |
170 | } | ||||
171 | } | ||||
172 | 2 | 29µs | } | ||
173 | |||||
174 | 1 | 44µs | 2 | 44µs | # spent 28µs (13+15) within Sub::Install::BEGIN@174 which was called:
# once (13µs+15µs) by Data::OptList::BEGIN@11 at line 174 # spent 28µs making 1 call to Sub::Install::BEGIN@174
# spent 15µs making 1 call to Sub::Install::exporter |
175 | |||||
176 | |||||
177 | 1 | 4µs | 1; | ||
178 | |||||
179 | __END__ | ||||
sub Sub::Install::CORE:qr; # opcode |