| Filename | /home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm |
| Statements | Executed 14701 statements in 194ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 914 | 4 | 2 | 71.3ms | 187ms | Sub::Install::__ANON__[:132] |
| 914 | 1 | 1 | 67.0ms | 93.4ms | Sub::Install::__ANON__[:175] |
| 914 | 1 | 1 | 26.3ms | 26.4ms | Sub::Install::__ANON__[:187] |
| 914 | 1 | 1 | 17.6ms | 22.3ms | Sub::Install::_CODELIKE |
| 1 | 1 | 1 | 281µs | 521µs | Sub::Install::BEGIN@190 |
| 3 | 3 | 1 | 90µs | 105µs | Sub::Install::_do_with_warn |
| 4 | 4 | 4 | 88µs | 88µs | Sub::Install::__ANON__[:284] |
| 2 | 2 | 2 | 83µs | 83µs | Sub::Install::exporter |
| 1 | 1 | 1 | 78µs | 150µs | Sub::Install::BEGIN@3 |
| 1 | 1 | 1 | 60µs | 82µs | Sub::Install::__ANON__[:173] |
| 1 | 1 | 1 | 58µs | 87µs | Sub::Install::BEGIN@139 |
| 2 | 2 | 1 | 53µs | 53µs | Sub::Install::_build_public_installer |
| 3 | 3 | 1 | 49µs | 49µs | Sub::Install::__ANON__[:176] |
| 1 | 1 | 1 | 49µs | 80µs | Sub::Install::BEGIN@287 |
| 3 | 3 | 1 | 48µs | 48µs | Sub::Install::_installer |
| 1 | 1 | 1 | 42µs | 117µs | Sub::Install::BEGIN@184 |
| 1 | 1 | 1 | 37µs | 238µs | Sub::Install::BEGIN@6 |
| 3 | 3 | 1 | 36µs | 36µs | Sub::Install::CORE:qr (opcode) |
| 1 | 1 | 1 | 36µs | 50µs | Sub::Install::BEGIN@4 |
| 1 | 1 | 1 | 27µs | 35µs | Sub::Install::BEGIN@148 |
| 1 | 1 | 1 | 20µs | 20µs | Sub::Install::BEGIN@7 |
| 1 | 1 | 1 | 16µs | 16µs | Sub::Install::CORE:match (opcode) |
| 1 | 1 | 1 | 5µs | 5µs | Sub::Install::CORE:regcomp (opcode) |
| 0 | 0 | 0 | 0s | 0s | Sub::Install::__ANON__[:156] |
| 0 | 0 | 0 | 0s | 0s | Sub::Install::__ANON__[:250] |
| 0 | 0 | 0 | 0s | 0s | Sub::Install::_name_of_code |
| 0 | 0 | 0 | 0s | 0s | Sub::Install::install_installers |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Sub::Install; | ||||
| 2 | |||||
| 3 | 3 | 102µs | 2 | 223µs | # spent 150µs (78+72) within Sub::Install::BEGIN@3 which was called:
# once (78µs+72µs) by Package::DeprecationManager::BEGIN@12 at line 3 # spent 150µs making 1 call to Sub::Install::BEGIN@3
# spent 72µs making 1 call to warnings::import |
| 4 | 3 | 91µs | 2 | 65µs | # spent 50µs (36+15) within Sub::Install::BEGIN@4 which was called:
# once (36µs+15µs) by Package::DeprecationManager::BEGIN@12 at line 4 # spent 50µs making 1 call to Sub::Install::BEGIN@4
# spent 15µs making 1 call to strict::import |
| 5 | |||||
| 6 | 3 | 134µs | 2 | 438µs | # spent 238µs (37+201) within Sub::Install::BEGIN@6 which was called:
# once (37µs+201µs) by Package::DeprecationManager::BEGIN@12 at line 6 # spent 238µs making 1 call to Sub::Install::BEGIN@6
# spent 201µs making 1 call to Exporter::import |
| 7 | 3 | 1.36ms | 1 | 20µs | # spent 20µs within Sub::Install::BEGIN@7 which was called:
# once (20µs+0s) by Package::DeprecationManager::BEGIN@12 at line 7 # spent 20µs making 1 call to Sub::Install::BEGIN@7 |
| 8 | |||||
| 9 | =head1 NAME | ||||
| 10 | |||||
| - - | |||||
| 19 | 1 | 4µs | our $VERSION = '0.925'; | ||
| 20 | |||||
| 21 | =head1 SYNOPSIS | ||||
| 22 | |||||
| - - | |||||
| 88 | sub _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 22.3ms (17.6+4.77) within Sub::Install::_CODELIKE which was called 914 times, avg 24µs/call:
# 914 times (17.6ms+4.77ms) by Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:132] at line 117, avg 24µs/call | ||||
| 98 | 914 | 24.6ms | 914 | 4.77ms | (Scalar::Util::reftype($_[0])||'') eq 'CODE' # spent 4.77ms making 914 calls to Scalar::Util::reftype, avg 5µs/call |
| 99 | || Scalar::Util::blessed($_[0]) | ||||
| 100 | && (overload::Method($_[0],'&{}') ? $_[0] : undef); | ||||
| 101 | } | ||||
| 102 | |||||
| 103 | # do the heavy lifting | ||||
| 104 | sub _build_public_installer { | ||||
| 105 | 2 | 7µs | my ($installer) = @_; | ||
| 106 | |||||
| 107 | # spent 187ms (71.3+116) within Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:132] which was called 914 times, avg 205µs/call:
# 906 times (70.4ms+114ms) by Sub::Exporter::default_installer at line 896 of Sub/Exporter.pm, avg 204µs/call
# 3 times (382µs+640µs) by Package::DeprecationManager::import at line 29 of Package/DeprecationManager.pm, avg 341µs/call
# 3 times (364µs+519µs) by Package::DeprecationManager::import at line 37 of Package/DeprecationManager.pm, avg 294µs/call
# 2 times (187µs+294µs) by Sub::Exporter::setup_exporter at line 607 of Sub/Exporter.pm, avg 240µs/call | ||||
| 108 | 914 | 2.78ms | my ($arg) = @_; | ||
| 109 | 914 | 14.6ms | my ($calling_pkg) = caller(0); | ||
| 110 | |||||
| 111 | # I'd rather use ||= but I'm whoring for Devel::Cover. | ||||
| 112 | 2742 | 16.9ms | for (qw(into from)) { $arg->{$_} = $calling_pkg unless $arg->{$_} } | ||
| 113 | |||||
| 114 | # This is the only absolutely required argument, in many cases. | ||||
| 115 | 914 | 2.22ms | Carp::croak "named argument 'code' is not optional" unless $arg->{code}; | ||
| 116 | |||||
| 117 | 914 | 10.5ms | 914 | 22.3ms | if (_CODELIKE($arg->{code})) { # spent 22.3ms making 914 calls to Sub::Install::_CODELIKE, avg 24µ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 | |||||
| 128 | 914 | 2.03ms | Carp::croak "couldn't determine name under which to install subroutine" | ||
| 129 | unless $arg->{as}; | ||||
| 130 | |||||
| 131 | 914 | 18.6ms | 914 | 93.4ms | $installer->(@$arg{qw(into as code) }); # spent 93.4ms making 914 calls to Sub::Install::__ANON__[Sub/Install.pm:175], avg 102µs/call |
| 132 | } | ||||
| 133 | 2 | 57µs | } | ||
| 134 | |||||
| 135 | # do the ugly work | ||||
| 136 | |||||
| 137 | 1 | 2µs | my $_misc_warn_re; | ||
| 138 | 1 | 2µs | my $_redef_warn_re; | ||
| 139 | # spent 87µs (58+29) within Sub::Install::BEGIN@139 which was called:
# once (58µs+29µs) by Package::DeprecationManager::BEGIN@12 at line 145 | ||||
| 140 | 1 | 50µs | 1 | 22µs | $_misc_warn_re = qr/ # spent 22µs making 1 call to Sub::Install::CORE:qr |
| 141 | Prototype\ mismatch:\ sub\ .+? | | ||||
| 142 | Constant subroutine \S+ redefined | ||||
| 143 | /x; | ||||
| 144 | 1 | 31µs | 1 | 7µs | $_redef_warn_re = qr/Subroutine\ \S+\ redefined/x; # spent 7µs making 1 call to Sub::Install::CORE:qr |
| 145 | 1 | 116µs | 1 | 87µs | } # spent 87µs making 1 call to Sub::Install::BEGIN@139 |
| 146 | |||||
| 147 | 1 | 2µs | my $eow_re; | ||
| 148 | 1 | 1.09ms | 2 | 42µs | # spent 35µs (27+7) within Sub::Install::BEGIN@148 which was called:
# once (27µs+7µs) by Package::DeprecationManager::BEGIN@12 at line 148 # spent 35µs making 1 call to Sub::Install::BEGIN@148
# spent 7µs making 1 call to Sub::Install::CORE:qr |
| 149 | |||||
| 150 | sub _do_with_warn { | ||||
| 151 | 3 | 10µs | my ($arg) = @_; | ||
| 152 | 3 | 11µs | my $code = delete $arg->{code}; | ||
| 153 | # spent 49µs within Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:176] which was called 3 times, avg 16µs/call:
# once (18µs+0s) by Sub::Install::BEGIN@190 at line 195
# once (16µs+0s) by Sub::Install::BEGIN@190 at line 202
# once (15µs+0s) by Sub::Install::_do_with_warn at line 177 | ||||
| 154 | 3 | 8µs | my $code = shift; | ||
| 155 | # spent 93.4ms (67.0+26.4) within Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:175] which was called 914 times, avg 102µs/call:
# 914 times (67.0ms+26.4ms) by Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:132] at line 131, avg 102µs/call | ||||
| 156 | 914 | 14.8ms | my $warn = $SIG{__WARN__} ? $SIG{__WARN__} : sub { warn @_ }; ## no critic | ||
| 157 | # spent 82µs (60+22) within Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:173] which was called:
# once (60µs+22µs) by Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:187] at line 185 | ||||
| 158 | 1 | 4µs | my ($error) = @_; | ||
| 159 | 1 | 6µs | for (@{ $arg->{suppress} }) { | ||
| 160 | 1 | 102µs | 2 | 22µs | return if $error =~ $_; # spent 16µs making 1 call to Sub::Install::CORE:match
# spent 5µs making 1 call to Sub::Install::CORE:regcomp |
| 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); | ||||
| 173 | 914 | 18.5ms | }; | ||
| 174 | 914 | 32.4ms | 914 | 26.4ms | $code->(@_); # spent 26.4ms making 914 calls to Sub::Install::__ANON__[Sub/Install.pm:187], avg 29µs/call |
| 175 | 3 | 58µs | }; | ||
| 176 | 3 | 26µs | }; | ||
| 177 | 3 | 23µs | 1 | 15µs | return $wants_code->($code) if $code; # spent 15µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:176] |
| 178 | 2 | 52µs | return $wants_code; | ||
| 179 | } | ||||
| 180 | |||||
| 181 | sub _installer { | ||||
| 182 | # spent 26.4ms (26.3+81µs) within Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:187] which was called 914 times, avg 29µs/call:
# 914 times (26.3ms+81µs) by Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:175] at line 174, avg 29µs/call | ||||
| 183 | 914 | 3.85ms | my ($pkg, $name, $code) = @_; | ||
| 184 | 3 | 527µs | 2 | 192µs | # spent 117µs (42+75) within Sub::Install::BEGIN@184 which was called:
# once (42µs+75µs) by Package::DeprecationManager::BEGIN@12 at line 184 # spent 117µs making 1 call to Sub::Install::BEGIN@184
# spent 75µs making 1 call to strict::unimport |
| 185 | 914 | 13.9ms | 1 | 82µs | *{"$pkg\::$name"} = $code; # spent 82µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:173] |
| 186 | 914 | 13.3ms | return $code; | ||
| 187 | } | ||||
| 188 | 3 | 66µs | } | ||
| 189 | |||||
| 190 | # spent 521µs (281+240) within Sub::Install::BEGIN@190 which was called:
# once (281µs+240µs) by Package::DeprecationManager::BEGIN@12 at line 208 | ||||
| 191 | 1 | 27µs | 1 | 31µs | *_ignore_warnings = _do_with_warn({ # spent 31µs making 1 call to Sub::Install::_do_with_warn |
| 192 | carp => [ $_misc_warn_re, $_redef_warn_re ] | ||||
| 193 | }); | ||||
| 194 | |||||
| 195 | 1 | 28µs | 3 | 52µs | *install_sub = _build_public_installer(_ignore_warnings(_installer)); # spent 21µs making 1 call to Sub::Install::_build_public_installer
# spent 18µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:176]
# spent 13µs making 1 call to Sub::Install::_installer |
| 196 | |||||
| 197 | 1 | 16µs | 1 | 23µs | *_carp_warnings = _do_with_warn({ # spent 23µs making 1 call to Sub::Install::_do_with_warn |
| 198 | carp => [ $_misc_warn_re ], | ||||
| 199 | suppress => [ $_redef_warn_re ], | ||||
| 200 | }); | ||||
| 201 | |||||
| 202 | 1 | 25µs | 3 | 60µs | *reinstall_sub = _build_public_installer(_carp_warnings(_installer)); # spent 32µs making 1 call to Sub::Install::_build_public_installer
# spent 16µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:176]
# spent 12µs making 1 call to Sub::Install::_installer |
| 203 | |||||
| 204 | 1 | 38µs | 2 | 73µs | *_install_fatal = _do_with_warn({ # spent 51µs making 1 call to Sub::Install::_do_with_warn
# spent 22µs making 1 call to Sub::Install::_installer |
| 205 | code => _installer, | ||||
| 206 | croak => [ $_redef_warn_re ], | ||||
| 207 | }); | ||||
| 208 | 1 | 947µs | 1 | 521µs | } # spent 521µs making 1 call to Sub::Install::BEGIN@190 |
| 209 | |||||
| 210 | =head2 install_installers | ||||
| 211 | |||||
| - - | |||||
| 233 | sub 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 | |||||
| - - | |||||
| 272 | # spent 83µs within Sub::Install::exporter which was called 2 times, avg 41µs/call:
# once (51µs+0s) by Data::OptList::BEGIN@214 at line 215 of Data/OptList.pm
# once (31µs+0s) by Sub::Install::BEGIN@287 at line 287 | ||||
| 273 | 2 | 7µs | my ($arg) = @_; | ||
| 274 | |||||
| 275 | 2 | 29µs | my %is_exported = map { $_ => undef } @{ $arg->{exports} }; | ||
| 276 | |||||
| 277 | # spent 88µs within Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:284] which was called 4 times, avg 22µs/call:
# once (23µs+0s) by Class::MOP::BEGIN@13 at line 13 of Class/MOP.pm
# once (22µs+0s) by Moose::Meta::Class::BEGIN@10 at line 10 of Moose/Meta/Class.pm
# once (21µs+0s) by Moose::Util::BEGIN@6 at line 6 of Moose/Util.pm
# once (21µs+0s) by Package::DeprecationManager::BEGIN@12 at line 12 of Package/DeprecationManager.pm | ||||
| 278 | 4 | 17µs | my $class = shift; | ||
| 279 | 4 | 17µs | my $target = caller; | ||
| 280 | 4 | 85µs | for (@_) { | ||
| 281 | Carp::croak "'$_' is not exported by $class" if !exists $is_exported{$_}; | ||||
| 282 | install_sub({ code => $_, from => $class, into => $target }); | ||||
| 283 | } | ||||
| 284 | } | ||||
| 285 | 2 | 59µs | } | ||
| 286 | |||||
| 287 | 1 | 134µs | 2 | 111µs | # spent 80µs (49+31) within Sub::Install::BEGIN@287 which was called:
# once (49µs+31µs) by Package::DeprecationManager::BEGIN@12 at line 287 # spent 80µs making 1 call to Sub::Install::BEGIN@287
# spent 31µs making 1 call to Sub::Install::exporter |
| 288 | |||||
| 289 | =head1 SEE ALSO | ||||
| 290 | |||||
| - - | |||||
| 329 | 1 | 13µs | 1; | ||
# spent 16µs within Sub::Install::CORE:match which was called:
# once (16µs+0s) by Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:173] at line 160 | |||||
sub Sub::Install::CORE:qr; # opcode | |||||
# spent 5µs within Sub::Install::CORE:regcomp which was called:
# once (5µs+0s) by Sub::Install::__ANON__[/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/Sub/Install.pm:173] at line 160 |