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 | import | Exporter::Tiny::
5 | 1 | 1 | 125µs | 125µs | CORE:sort (opcode) | Exporter::Tiny::
14 | 2 | 1 | 114µs | 114µs | CORE:regcomp (opcode) | Exporter::Tiny::
9 | 1 | 1 | 114µs | 114µs | _exporter_install_sub | Exporter::Tiny::
5 | 1 | 1 | 112µs | 349µs | _exporter_permitted_regexp | Exporter::Tiny::
9 | 1 | 1 | 72µs | 123µs | _exporter_expand_sub | Exporter::Tiny::
5 | 1 | 1 | 70µs | 80µs | __ANON__[:38] | Exporter::Tiny::
5 | 1 | 1 | 40µs | 40µs | mkopt | Exporter::Tiny::
45 | 2 | 1 | 27µs | 27µs | CORE:match (opcode) | Exporter::Tiny::
1 | 1 | 1 | 8µs | 10µs | BEGIN@4 | Exporter::Tiny::
1 | 1 | 1 | 7µs | 7µs | BEGIN@3 | Exporter::Tiny::
5 | 1 | 1 | 6µs | 6µs | CORE:qr (opcode) | Exporter::Tiny::
5 | 1 | 1 | 6µs | 6µs | _exporter_validate_opts | Exporter::Tiny::
1 | 1 | 1 | 6µs | 14µs | BEGIN@143 | Exporter::Tiny::
1 | 1 | 1 | 6µs | 13µs | BEGIN@283 | Exporter::Tiny::
1 | 1 | 1 | 6µs | 18µs | BEGIN@48 | Exporter::Tiny::
1 | 1 | 1 | 5µs | 11µs | BEGIN@206 | Exporter::Tiny::
1 | 1 | 1 | 5µs | 12µs | BEGIN@170 | Exporter::Tiny::
1 | 1 | 1 | 5µs | 11µs | BEGIN@189 | Exporter::Tiny::
1 | 1 | 1 | 5µs | 23µs | BEGIN@5.24 | Exporter::Tiny::
1 | 1 | 1 | 5µs | 11µs | BEGIN@297 | Exporter::Tiny::
1 | 1 | 1 | 4µs | 11µs | BEGIN@253 | Exporter::Tiny::
1 | 1 | 1 | 4µs | 6µs | BEGIN@5 | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | __ANON__[:267] | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | __ANON__[:96] | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | _carp | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | _croak | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | _exporter_expand_regexp | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | _exporter_expand_tag | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | _exporter_fail | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | _exporter_merge_opts | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | _exporter_uninstall_sub | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | _exporter_validate_unimport_opts | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | mkopt_hash | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | unimport | Exporter::Tiny::
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 |