| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Exporter/Tiny.pm |
| Statements | Executed 437 statements in 2.39ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 5 | 5 | 5 | 180µs | 892µs | Exporter::Tiny::import |
| 5 | 1 | 1 | 125µs | 125µs | Exporter::Tiny::CORE:sort (opcode) |
| 14 | 2 | 1 | 114µs | 114µs | Exporter::Tiny::CORE:regcomp (opcode) |
| 9 | 1 | 1 | 114µs | 114µs | Exporter::Tiny::_exporter_install_sub |
| 5 | 1 | 1 | 112µs | 349µs | Exporter::Tiny::_exporter_permitted_regexp |
| 9 | 1 | 1 | 72µs | 123µs | Exporter::Tiny::_exporter_expand_sub |
| 5 | 1 | 1 | 70µs | 80µs | Exporter::Tiny::__ANON__[:38] |
| 5 | 1 | 1 | 40µs | 40µs | Exporter::Tiny::mkopt |
| 45 | 2 | 1 | 27µs | 27µs | Exporter::Tiny::CORE:match (opcode) |
| 1 | 1 | 1 | 8µs | 10µs | Exporter::Tiny::BEGIN@4 |
| 1 | 1 | 1 | 7µs | 7µs | Exporter::Tiny::BEGIN@3 |
| 5 | 1 | 1 | 6µs | 6µs | Exporter::Tiny::CORE:qr (opcode) |
| 5 | 1 | 1 | 6µs | 6µs | Exporter::Tiny::_exporter_validate_opts |
| 1 | 1 | 1 | 6µs | 14µs | Exporter::Tiny::BEGIN@143 |
| 1 | 1 | 1 | 6µs | 13µs | Exporter::Tiny::BEGIN@283 |
| 1 | 1 | 1 | 6µs | 18µs | Exporter::Tiny::BEGIN@48 |
| 1 | 1 | 1 | 5µs | 11µs | Exporter::Tiny::BEGIN@206 |
| 1 | 1 | 1 | 5µs | 12µs | Exporter::Tiny::BEGIN@170 |
| 1 | 1 | 1 | 5µs | 11µs | Exporter::Tiny::BEGIN@189 |
| 1 | 1 | 1 | 5µs | 23µs | Exporter::Tiny::BEGIN@5.24 |
| 1 | 1 | 1 | 5µs | 11µs | Exporter::Tiny::BEGIN@297 |
| 1 | 1 | 1 | 4µs | 11µs | Exporter::Tiny::BEGIN@253 |
| 1 | 1 | 1 | 4µs | 6µs | Exporter::Tiny::BEGIN@5 |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::__ANON__[:267] |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::__ANON__[:96] |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::_carp |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::_croak |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::_exporter_expand_regexp |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::_exporter_expand_tag |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::_exporter_fail |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::_exporter_merge_opts |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::_exporter_uninstall_sub |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::_exporter_validate_unimport_opts |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::mkopt_hash |
| 0 | 0 | 0 | 0s | 0s | Exporter::Tiny::unimport |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Exporter::Tiny; | ||||
| 2 | |||||
| 3 | 2 | 20µs | 1 | 7µs | # spent 7µs within Exporter::Tiny::BEGIN@3 which was called:
# once (7µs+0s) by List::MoreUtils::BEGIN@12 at line 3 # spent 7µs making 1 call to Exporter::Tiny::BEGIN@3 |
| 4 | 2 | 11µs | 2 | 11µs | # spent 10µs (8+1) within Exporter::Tiny::BEGIN@4 which was called:
# once (8µs+1µs) by List::MoreUtils::BEGIN@12 at line 4 # spent 10µs making 1 call to Exporter::Tiny::BEGIN@4
# spent 1µs making 1 call to strict::import |
| 5 | 4 | 284µs | 4 | 50µs | use warnings; no warnings qw(void once uninitialized numeric redefine); # spent 23µs making 1 call to Exporter::Tiny::BEGIN@5.24
# spent 18µs making 1 call to warnings::unimport
# spent 6µs making 1 call to Exporter::Tiny::BEGIN@5
# spent 3µs making 1 call to warnings::import |
| 6 | |||||
| 7 | 1 | 300ns | our $AUTHORITY = 'cpan:TOBYINK'; | ||
| 8 | 1 | 100ns | our $VERSION = '0.042'; | ||
| 9 | 1 | 1µs | our @EXPORT_OK = qw< mkopt mkopt_hash _croak _carp >; | ||
| 10 | |||||
| 11 | sub _croak ($;@) { require Carp; my $fmt = shift; @_ = sprintf($fmt, @_); goto \&Carp::croak } | ||||
| 12 | sub _carp ($;@) { require Carp; my $fmt = shift; @_ = sprintf($fmt, @_); goto \&Carp::carp } | ||||
| 13 | |||||
| 14 | my $_process_optlist = sub | ||||
| 15 | # spent 80µs (70+10) within Exporter::Tiny::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Exporter/Tiny.pm:38] which was called 5 times, avg 16µs/call:
# 5 times (70µs+10µs) by Exporter::Tiny::import at line 50, avg 16µs/call | ||||
| 16 | 5 | 1µs | my $class = shift; | ||
| 17 | 5 | 2µs | my ($global_opts, $opts, $want, $not_want) = @_; | ||
| 18 | |||||
| 19 | 5 | 15µs | while (@$opts) | ||
| 20 | { | ||||
| 21 | 9 | 3µs | my $opt = shift @{$opts}; | ||
| 22 | 9 | 3µs | my ($name, $value) = @$opt; | ||
| 23 | |||||
| 24 | ($name =~ m{\A\!(/.+/[msixpodual]+)\z}) ? | ||||
| 25 | do { | ||||
| 26 | my @not = $class->_exporter_expand_regexp($1, $value, $global_opts); | ||||
| 27 | ++$not_want->{$_->[0]} for @not; | ||||
| 28 | } : | ||||
| 29 | ($name =~ m{\A\!(.+)\z}) ? | ||||
| 30 | 9 | 59µs | 36 | 10µs | (++$not_want->{$1}) : # spent 10µs making 36 calls to Exporter::Tiny::CORE:match, avg 278ns/call |
| 31 | ($name =~ m{\A[:-](.+)\z}) ? | ||||
| 32 | push(@$opts, $class->_exporter_expand_tag($1, $value, $global_opts)) : | ||||
| 33 | ($name =~ m{\A/.+/[msixpodual]+\z}) ? | ||||
| 34 | push(@$opts, $class->_exporter_expand_regexp($name, $value, $global_opts)) : | ||||
| 35 | # else ? | ||||
| 36 | push(@$want, $opt); | ||||
| 37 | } | ||||
| 38 | 1 | 3µs | }; | ||
| 39 | |||||
| 40 | sub import | ||||
| 41 | # spent 892µs (180+712) within Exporter::Tiny::import which was called 5 times, avg 178µs/call:
# once (60µs+263µs) by Moose::Exporter::BEGIN@9 at line 9 of Moose/Exporter.pm
# once (37µs+140µs) by SQL::SplitStatement::BEGIN@15 at line 15 of SQL/SplitStatement.pm
# once (33µs+127µs) by Moose::Meta::Class::BEGIN@10 at line 10 of Moose/Meta/Class.pm
# once (31µs+107µs) by BenchmarkAnything::Storage::Backend::SQL::Query::common::BEGIN@9 at line 9 of BenchmarkAnything/Storage/Backend/SQL/Query/common.pm
# once (19µs+75µs) by BenchmarkAnything::Storage::Backend::SQL::Query::mysql::BEGIN@9 at line 9 of BenchmarkAnything/Storage/Backend/SQL/Query/mysql.pm | ||||
| 42 | 5 | 2µs | my $class = shift; | ||
| 43 | 5 | 6µs | my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () }; | ||
| 44 | 5 | 7µs | $global_opts->{into} = caller unless exists $global_opts->{into}; | ||
| 45 | |||||
| 46 | 5 | 1µs | my @want; | ||
| 47 | 5 | 4µs | my %not_want; $global_opts->{not} = \%not_want; | ||
| 48 | 12 | 373µs | 2 | 31µs | # spent 18µs (6+13) within Exporter::Tiny::BEGIN@48 which was called:
# once (6µs+13µs) by List::MoreUtils::BEGIN@12 at line 48 # spent 18µs making 1 call to Exporter::Tiny::BEGIN@48
# spent 13µs making 1 call to strict::unimport |
| 49 | 5 | 9µs | 5 | 40µs | my $opts = mkopt(\@args); # spent 40µs making 5 calls to Exporter::Tiny::mkopt, avg 8µs/call |
| 50 | 5 | 12µs | 5 | 80µs | $class->$_process_optlist($global_opts, $opts, \@want, \%not_want); # spent 80µs making 5 calls to Exporter::Tiny::__ANON__[Exporter/Tiny.pm:38], avg 16µs/call |
| 51 | |||||
| 52 | 5 | 16µs | 5 | 349µs | my $permitted = $class->_exporter_permitted_regexp($global_opts); # spent 349µs making 5 calls to Exporter::Tiny::_exporter_permitted_regexp, avg 70µs/call |
| 53 | 5 | 12µs | 5 | 6µs | $class->_exporter_validate_opts($global_opts); # spent 6µs making 5 calls to Exporter::Tiny::_exporter_validate_opts, avg 1µs/call |
| 54 | |||||
| 55 | 5 | 25µs | for my $wanted (@want) | ||
| 56 | { | ||||
| 57 | 9 | 4µs | next if $not_want{$wanted->[0]}; | ||
| 58 | |||||
| 59 | 9 | 22µs | 9 | 123µs | my %symbols = $class->_exporter_expand_sub(@$wanted, $global_opts, $permitted); # spent 123µs making 9 calls to Exporter::Tiny::_exporter_expand_sub, avg 14µs/call |
| 60 | $class->_exporter_install_sub($_, $wanted->[1], $global_opts, $symbols{$_}) | ||||
| 61 | 9 | 29µs | 9 | 114µs | for keys %symbols; # spent 114µs making 9 calls to Exporter::Tiny::_exporter_install_sub, avg 13µs/call |
| 62 | } | ||||
| 63 | } | ||||
| 64 | |||||
| 65 | sub unimport | ||||
| 66 | { | ||||
| 67 | my $class = shift; | ||||
| 68 | my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () }; | ||||
| 69 | $global_opts->{into} = caller unless exists $global_opts->{into}; | ||||
| 70 | $global_opts->{is_unimport} = 1; | ||||
| 71 | |||||
| 72 | my @want; | ||||
| 73 | my %not_want; $global_opts->{not} = \%not_want; | ||||
| 74 | my @args = do { our %TRACKED; @_ ? @_ : keys(%{$TRACKED{$class}{$global_opts->{into}}}) }; | ||||
| 75 | my $opts = mkopt(\@args); | ||||
| 76 | $class->$_process_optlist($global_opts, $opts, \@want, \%not_want); | ||||
| 77 | |||||
| 78 | my $permitted = $class->_exporter_permitted_regexp($global_opts); | ||||
| 79 | $class->_exporter_validate_unimport_opts($global_opts); | ||||
| 80 | |||||
| 81 | my $expando = $class->can('_exporter_expand_sub'); | ||||
| 82 | $expando = undef if $expando == \&_exporter_expand_sub; | ||||
| 83 | |||||
| 84 | for my $wanted (@want) | ||||
| 85 | { | ||||
| 86 | next if $not_want{$wanted->[0]}; | ||||
| 87 | |||||
| 88 | if ($wanted->[1]) | ||||
| 89 | { | ||||
| 90 | _carp("Passing options to unimport '%s' makes no sense", $wanted->[0]) | ||||
| 91 | unless (ref($wanted->[1]) eq 'HASH' and not keys %{$wanted->[1]}); | ||||
| 92 | } | ||||
| 93 | |||||
| 94 | my %symbols = defined($expando) | ||||
| 95 | ? $class->$expando(@$wanted, $global_opts, $permitted) | ||||
| 96 | : ($wanted->[0] => sub { "dummy" }); | ||||
| 97 | $class->_exporter_uninstall_sub($_, $wanted->[1], $global_opts) | ||||
| 98 | for keys %symbols; | ||||
| 99 | } | ||||
| 100 | } | ||||
| 101 | |||||
| 102 | # Called once per import/unimport, passed the "global" import options. | ||||
| 103 | # Expected to validate the options and carp or croak if there are problems. | ||||
| 104 | # Can also take the opportunity to do other stuff if needed. | ||||
| 105 | # | ||||
| 106 | 5 | 9µs | # spent 6µs within Exporter::Tiny::_exporter_validate_opts which was called 5 times, avg 1µs/call:
# 5 times (6µs+0s) by Exporter::Tiny::import at line 53, avg 1µs/call | ||
| 107 | sub _exporter_validate_unimport_opts { 1 } | ||||
| 108 | |||||
| 109 | # Called after expanding a tag or regexp to merge the tag's options with | ||||
| 110 | # any sub-specific options. | ||||
| 111 | # | ||||
| 112 | sub _exporter_merge_opts | ||||
| 113 | { | ||||
| 114 | my $class = shift; | ||||
| 115 | my ($tag_opts, $global_opts, @stuff) = @_; | ||||
| 116 | |||||
| 117 | $tag_opts = {} unless ref($tag_opts) eq q(HASH); | ||||
| 118 | _croak('Cannot provide an -as option for tags') | ||||
| 119 | if exists $tag_opts->{-as}; | ||||
| 120 | |||||
| 121 | my $optlist = mkopt(\@stuff); | ||||
| 122 | for my $export (@$optlist) | ||||
| 123 | { | ||||
| 124 | next if defined($export->[1]) && ref($export->[1]) ne q(HASH); | ||||
| 125 | |||||
| 126 | my %sub_opts = ( %{ $export->[1] or {} }, %$tag_opts ); | ||||
| 127 | $sub_opts{-prefix} = sprintf('%s%s', $tag_opts->{-prefix}, $export->[1]{-prefix}) | ||||
| 128 | if exists($export->[1]{-prefix}) && exists($tag_opts->{-prefix}); | ||||
| 129 | $sub_opts{-suffix} = sprintf('%s%s', $export->[1]{-suffix}, $tag_opts->{-suffix}) | ||||
| 130 | if exists($export->[1]{-suffix}) && exists($tag_opts->{-suffix}); | ||||
| 131 | $export->[1] = \%sub_opts; | ||||
| 132 | } | ||||
| 133 | return @$optlist; | ||||
| 134 | } | ||||
| 135 | |||||
| 136 | # Given a tag name, looks it up in %EXPORT_TAGS and returns the list of | ||||
| 137 | # associated functions. The default implementation magically handles tags | ||||
| 138 | # "all" and "default". The default implementation interprets any undefined | ||||
| 139 | # tags as being global options. | ||||
| 140 | # | ||||
| 141 | sub _exporter_expand_tag | ||||
| 142 | { | ||||
| 143 | 2 | 98µs | 2 | 22µs | # spent 14µs (6+8) within Exporter::Tiny::BEGIN@143 which was called:
# once (6µs+8µs) by List::MoreUtils::BEGIN@12 at line 143 # spent 14µs making 1 call to Exporter::Tiny::BEGIN@143
# spent 8µs making 1 call to strict::unimport |
| 144 | |||||
| 145 | my $class = shift; | ||||
| 146 | my ($name, $value, $globals) = @_; | ||||
| 147 | my $tags = \%{"$class\::EXPORT_TAGS"}; | ||||
| 148 | |||||
| 149 | return $class->_exporter_merge_opts($value, $globals, $tags->{$name}->($class, @_)) | ||||
| 150 | if ref($tags->{$name}) eq q(CODE); | ||||
| 151 | |||||
| 152 | return $class->_exporter_merge_opts($value, $globals, @{$tags->{$name}}) | ||||
| 153 | if exists $tags->{$name}; | ||||
| 154 | |||||
| 155 | return $class->_exporter_merge_opts($value, $globals, @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"}) | ||||
| 156 | if $name eq 'all'; | ||||
| 157 | |||||
| 158 | return $class->_exporter_merge_opts($value, $globals, @{"$class\::EXPORT"}) | ||||
| 159 | if $name eq 'default'; | ||||
| 160 | |||||
| 161 | $globals->{$name} = $value || 1; | ||||
| 162 | return; | ||||
| 163 | } | ||||
| 164 | |||||
| 165 | # Given a regexp-like string, looks it up in @EXPORT_OK and returns the | ||||
| 166 | # list of matching functions. | ||||
| 167 | # | ||||
| 168 | sub _exporter_expand_regexp | ||||
| 169 | { | ||||
| 170 | 2 | 75µs | 2 | 18µs | # spent 12µs (5+7) within Exporter::Tiny::BEGIN@170 which was called:
# once (5µs+7µs) by List::MoreUtils::BEGIN@12 at line 170 # spent 12µs making 1 call to Exporter::Tiny::BEGIN@170
# spent 6µs making 1 call to strict::unimport |
| 171 | our %TRACKED; | ||||
| 172 | |||||
| 173 | my $class = shift; | ||||
| 174 | my ($name, $value, $globals) = @_; | ||||
| 175 | my $compiled = eval("qr$name"); | ||||
| 176 | |||||
| 177 | my @possible = $globals->{is_unimport} | ||||
| 178 | ? keys( %{$TRACKED{$class}{$globals->{into}}} ) | ||||
| 179 | : @{"$class\::EXPORT_OK"}; | ||||
| 180 | |||||
| 181 | $class->_exporter_merge_opts($value, $globals, grep /$compiled/, @possible); | ||||
| 182 | } | ||||
| 183 | |||||
| 184 | # Helper for _exporter_expand_sub. Returns a regexp matching all subs in | ||||
| 185 | # the exporter package which are available for export. | ||||
| 186 | # | ||||
| 187 | sub _exporter_permitted_regexp | ||||
| 188 | # spent 349µs (112+238) within Exporter::Tiny::_exporter_permitted_regexp which was called 5 times, avg 70µs/call:
# 5 times (112µs+238µs) by Exporter::Tiny::import at line 52, avg 70µs/call | ||||
| 189 | 2 | 77µs | 2 | 17µs | # spent 11µs (5+6) within Exporter::Tiny::BEGIN@189 which was called:
# once (5µs+6µs) by List::MoreUtils::BEGIN@12 at line 189 # spent 11µs making 1 call to Exporter::Tiny::BEGIN@189
# spent 6µs making 1 call to strict::unimport |
| 190 | 5 | 1µs | my $class = shift; | ||
| 191 | my $re = join "|", map quotemeta, sort { | ||||
| 192 | length($b) <=> length($a) or $a cmp $b | ||||
| 193 | 5 | 209µs | 5 | 125µs | } @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"}; # spent 125µs making 5 calls to Exporter::Tiny::CORE:sort, avg 25µs/call |
| 194 | 5 | 143µs | 10 | 112µs | qr{^(?:$re)$}ms; # spent 106µs making 5 calls to Exporter::Tiny::CORE:regcomp, avg 21µs/call
# spent 6µs making 5 calls to Exporter::Tiny::CORE:qr, avg 1µs/call |
| 195 | } | ||||
| 196 | |||||
| 197 | # Given a sub name, returns a hash of subs to install (usually just one sub). | ||||
| 198 | # Keys are sub names, values are coderefs. | ||||
| 199 | # | ||||
| 200 | sub _exporter_expand_sub | ||||
| 201 | # spent 123µs (72+51) within Exporter::Tiny::_exporter_expand_sub which was called 9 times, avg 14µs/call:
# 9 times (72µs+51µs) by Exporter::Tiny::import at line 59, avg 14µs/call | ||||
| 202 | 9 | 2µs | my $class = shift; | ||
| 203 | 9 | 3µs | my ($name, $value, $globals, $permitted) = @_; | ||
| 204 | 9 | 2µs | $permitted ||= $class->_exporter_permitted_regexp($globals); | ||
| 205 | |||||
| 206 | 2 | 157µs | 2 | 17µs | # spent 11µs (5+6) within Exporter::Tiny::BEGIN@206 which was called:
# once (5µs+6µs) by List::MoreUtils::BEGIN@12 at line 206 # spent 11µs making 1 call to Exporter::Tiny::BEGIN@206
# spent 6µs making 1 call to strict::unimport |
| 207 | |||||
| 208 | 9 | 45µs | 18 | 25µs | if ($name =~ $permitted) # spent 17µs making 9 calls to Exporter::Tiny::CORE:match, avg 2µs/call
# spent 8µs making 9 calls to Exporter::Tiny::CORE:regcomp, avg 900ns/call |
| 209 | { | ||||
| 210 | 9 | 39µs | 9 | 21µs | my $generator = $class->can("_generate_$name"); # spent 21µs making 9 calls to UNIVERSAL::can, avg 2µs/call |
| 211 | 9 | 2µs | return $name => $class->$generator($name, $value, $globals) if $generator; | ||
| 212 | |||||
| 213 | 9 | 17µs | 9 | 5µs | my $sub = $class->can($name); # spent 5µs making 9 calls to UNIVERSAL::can, avg 600ns/call |
| 214 | 9 | 18µs | return $name => $sub if $sub; | ||
| 215 | } | ||||
| 216 | |||||
| 217 | $class->_exporter_fail(@_); | ||||
| 218 | } | ||||
| 219 | |||||
| 220 | # Called by _exporter_expand_sub if it is unable to generate a key-value | ||||
| 221 | # pair for a sub. | ||||
| 222 | # | ||||
| 223 | sub _exporter_fail | ||||
| 224 | { | ||||
| 225 | my $class = shift; | ||||
| 226 | my ($name, $value, $globals) = @_; | ||||
| 227 | return if $globals->{is_unimport}; | ||||
| 228 | _croak("Could not find sub '%s' exported by %s", $name, $class); | ||||
| 229 | } | ||||
| 230 | |||||
| 231 | # Actually performs the installation of the sub into the target package. This | ||||
| 232 | # also handles renaming the sub. | ||||
| 233 | # | ||||
| 234 | sub _exporter_install_sub | ||||
| 235 | # spent 114µs within Exporter::Tiny::_exporter_install_sub which was called 9 times, avg 13µs/call:
# 9 times (114µs+0s) by Exporter::Tiny::import at line 61, avg 13µs/call | ||||
| 236 | 9 | 2µs | my $class = shift; | ||
| 237 | 9 | 3µs | my ($name, $value, $globals, $sym) = @_; | ||
| 238 | |||||
| 239 | 9 | 4µs | my $into = $globals->{into}; | ||
| 240 | 9 | 4µs | my $installer = $globals->{installer} || $globals->{exporter}; | ||
| 241 | |||||
| 242 | 9 | 7µs | $name = $value->{-as} || $name; | ||
| 243 | 9 | 5µs | unless (ref($name) eq q(SCALAR)) | ||
| 244 | { | ||||
| 245 | 9 | 18µs | my ($prefix) = grep defined, $value->{-prefix}, $globals->{prefix}, q(); | ||
| 246 | 9 | 10µs | my ($suffix) = grep defined, $value->{-suffix}, $globals->{suffix}, q(); | ||
| 247 | 9 | 6µs | $name = "$prefix$name$suffix"; | ||
| 248 | } | ||||
| 249 | |||||
| 250 | 9 | 2µs | return ($$name = $sym) if ref($name) eq q(SCALAR); | ||
| 251 | 9 | 3µs | return ($into->{$name} = $sym) if ref($into) eq q(HASH); | ||
| 252 | |||||
| 253 | 2 | 96µs | 2 | 17µs | # spent 11µs (4+6) within Exporter::Tiny::BEGIN@253 which was called:
# once (4µs+6µs) by List::MoreUtils::BEGIN@12 at line 253 # spent 11µs making 1 call to Exporter::Tiny::BEGIN@253
# spent 6µs making 1 call to strict::unimport |
| 254 | |||||
| 255 | 9 | 12µs | if (exists &{"$into\::$name"} and \&{"$into\::$name"} != $sym) | ||
| 256 | { | ||||
| 257 | my ($level) = grep defined, $value->{-replace}, $globals->{replace}, q(0); | ||||
| 258 | my $action = { | ||||
| 259 | carp => \&_carp, | ||||
| 260 | 0 => \&_carp, | ||||
| 261 | '' => \&_carp, | ||||
| 262 | warn => \&_carp, | ||||
| 263 | nonfatal => \&_carp, | ||||
| 264 | croak => \&_croak, | ||||
| 265 | fatal => \&_croak, | ||||
| 266 | die => \&_croak, | ||||
| 267 | }->{$level} || sub {}; | ||||
| 268 | |||||
| 269 | $action->( | ||||
| 270 | $action == \&_croak | ||||
| 271 | ? "Refusing to overwrite existing sub '%s::%s' with sub '%s' exported by %s" | ||||
| 272 | : "Overwriting existing sub '%s::%s' with sub '%s' exported by %s", | ||||
| 273 | $into, | ||||
| 274 | $name, | ||||
| 275 | $_[0], | ||||
| 276 | $class, | ||||
| 277 | ); | ||||
| 278 | } | ||||
| 279 | |||||
| 280 | our %TRACKED; | ||||
| 281 | 9 | 9µs | $TRACKED{$class}{$into}{$name} = $sym; | ||
| 282 | |||||
| 283 | 2 | 79µs | 2 | 21µs | # spent 13µs (6+8) within Exporter::Tiny::BEGIN@283 which was called:
# once (6µs+8µs) by List::MoreUtils::BEGIN@12 at line 283 # spent 13µs making 1 call to Exporter::Tiny::BEGIN@283
# spent 8µs making 1 call to warnings::unimport |
| 284 | $installer | ||||
| 285 | ? $installer->($globals, [$name, $sym]) | ||||
| 286 | 9 | 35µs | : (*{"$into\::$name"} = $sym); | ||
| 287 | } | ||||
| 288 | |||||
| 289 | sub _exporter_uninstall_sub | ||||
| 290 | { | ||||
| 291 | our %TRACKED; | ||||
| 292 | my $class = shift; | ||||
| 293 | my ($name, $value, $globals, $sym) = @_; | ||||
| 294 | my $into = $globals->{into}; | ||||
| 295 | ref $into and return; | ||||
| 296 | |||||
| 297 | 2 | 220µs | 2 | 17µs | # spent 11µs (5+6) within Exporter::Tiny::BEGIN@297 which was called:
# once (5µs+6µs) by List::MoreUtils::BEGIN@12 at line 297 # spent 11µs making 1 call to Exporter::Tiny::BEGIN@297
# spent 6µs making 1 call to strict::unimport |
| 298 | |||||
| 299 | # Cowardly refuse to uninstall a sub that differs from the one | ||||
| 300 | # we installed! | ||||
| 301 | my $our_coderef = $TRACKED{$class}{$into}{$name}; | ||||
| 302 | my $cur_coderef = exists(&{"$into\::$name"}) ? \&{"$into\::$name"} : -1; | ||||
| 303 | return unless $our_coderef == $cur_coderef; | ||||
| 304 | |||||
| 305 | my $stash = \%{"$into\::"}; | ||||
| 306 | my $old = delete $stash->{$name}; | ||||
| 307 | my $full_name = join('::', $into, $name); | ||||
| 308 | foreach my $type (qw(SCALAR HASH ARRAY IO)) # everything but the CODE | ||||
| 309 | { | ||||
| 310 | next unless defined(*{$old}{$type}); | ||||
| 311 | *$full_name = *{$old}{$type}; | ||||
| 312 | } | ||||
| 313 | |||||
| 314 | delete $TRACKED{$class}{$into}{$name}; | ||||
| 315 | } | ||||
| 316 | |||||
| 317 | sub mkopt | ||||
| 318 | # spent 40µs within Exporter::Tiny::mkopt which was called 5 times, avg 8µs/call:
# 5 times (40µs+0s) by Exporter::Tiny::import at line 49, avg 8µs/call | ||||
| 319 | 5 | 2µs | my $in = shift or return []; | ||
| 320 | 5 | 1µs | my @out; | ||
| 321 | |||||
| 322 | 5 | 3µs | $in = [map(($_ => ref($in->{$_}) ? $in->{$_} : ()), sort keys %$in)] | ||
| 323 | if ref($in) eq q(HASH); | ||||
| 324 | |||||
| 325 | 5 | 8µs | for (my $i = 0; $i < @$in; $i++) | ||
| 326 | { | ||||
| 327 | 9 | 3µs | my $k = $in->[$i]; | ||
| 328 | 9 | 1µs | my $v; | ||
| 329 | |||||
| 330 | 9 | 7µs | ($i == $#$in) ? ($v = undef) : | ||
| 331 | !defined($in->[$i+1]) ? (++$i, ($v = undef)) : | ||||
| 332 | !ref($in->[$i+1]) ? ($v = undef) : | ||||
| 333 | ($v = $in->[++$i]); | ||||
| 334 | |||||
| 335 | 9 | 7µs | push @out, [ $k => $v ]; | ||
| 336 | } | ||||
| 337 | |||||
| 338 | 5 | 14µs | \@out; | ||
| 339 | } | ||||
| 340 | |||||
| 341 | sub mkopt_hash | ||||
| 342 | { | ||||
| 343 | my $in = shift or return; | ||||
| 344 | my %out = map +($_->[0] => $_->[1]), @{ mkopt($in) }; | ||||
| 345 | \%out; | ||||
| 346 | } | ||||
| 347 | |||||
| 348 | 1 | 5µs | 1; | ||
| 349 | |||||
| 350 | __END__ | ||||
# spent 27µs within Exporter::Tiny::CORE:match which was called 45 times, avg 593ns/call:
# 36 times (10µs+0s) by Exporter::Tiny::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Exporter/Tiny.pm:38] at line 30, avg 278ns/call
# 9 times (17µs+0s) by Exporter::Tiny::_exporter_expand_sub at line 208, avg 2µs/call | |||||
# spent 6µs within Exporter::Tiny::CORE:qr which was called 5 times, avg 1µs/call:
# 5 times (6µs+0s) by Exporter::Tiny::_exporter_permitted_regexp at line 194, avg 1µs/call | |||||
sub Exporter::Tiny::CORE:regcomp; # opcode | |||||
# spent 125µs within Exporter::Tiny::CORE:sort which was called 5 times, avg 25µs/call:
# 5 times (125µs+0s) by Exporter::Tiny::_exporter_permitted_regexp at line 193, avg 25µs/call |