Filename | /opt/perl-5.18.1/lib/site_perl/5.18.1/Exporter/Tiny.pm |
Statements | Executed 1781 statements in 5.11ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
9 | 9 | 5 | 910µs | 4.84ms | import | Exporter::Tiny::
53 | 1 | 1 | 808µs | 954µs | _exporter_install_sub | Exporter::Tiny::
53 | 2 | 2 | 600µs | 1.07ms | _exporter_expand_sub | Exporter::Tiny::
62 | 2 | 1 | 360µs | 360µs | CORE:regcomp (opcode) | Exporter::Tiny::
9 | 2 | 2 | 154µs | 496µs | _exporter_permitted_regexp | Exporter::Tiny::
108 | 2 | 1 | 138µs | 138µs | CORE:match (opcode) | Exporter::Tiny::
9 | 1 | 1 | 92µs | 92µs | mkopt | Exporter::Tiny::
9 | 1 | 1 | 50µs | 50µs | CORE:sort (opcode) | Exporter::Tiny::
1 | 1 | 1 | 20µs | 20µs | BEGIN@3 | Exporter::Tiny::
9 | 1 | 1 | 16µs | 16µs | CORE:qr (opcode) | Exporter::Tiny::
1 | 1 | 1 | 14µs | 28µs | BEGIN@60 | Exporter::Tiny::
1 | 1 | 1 | 14µs | 18µs | BEGIN@5 | Exporter::Tiny::
1 | 1 | 1 | 10µs | 28µs | BEGIN@5.2 | Exporter::Tiny::
9 | 2 | 2 | 10µs | 10µs | _exporter_validate_opts | Exporter::Tiny::
1 | 1 | 1 | 9µs | 23µs | BEGIN@104 | Exporter::Tiny::
1 | 1 | 1 | 9µs | 22µs | BEGIN@87 | Exporter::Tiny::
1 | 1 | 1 | 9µs | 23µs | BEGIN@160 | Exporter::Tiny::
1 | 1 | 1 | 9µs | 24µs | BEGIN@17 | Exporter::Tiny::
1 | 1 | 1 | 9µs | 9µs | _exporter_expand_tag | Exporter::Tiny::
1 | 1 | 1 | 8µs | 24µs | BEGIN@4 | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | _croak | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | _exporter_fail | Exporter::Tiny::
0 | 0 | 0 | 0s | 0s | mkopt_hash | Exporter::Tiny::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Exporter::Tiny; | ||||
2 | |||||
3 | 2 | 58µs | 1 | 20µs | # spent 20µs within Exporter::Tiny::BEGIN@3 which was called:
# once (20µs+0s) by Eval::TypeTiny::import at line 3 # spent 20µs making 1 call to Exporter::Tiny::BEGIN@3 |
4 | 2 | 37µs | 2 | 40µs | # spent 24µs (8+16) within Exporter::Tiny::BEGIN@4 which was called:
# once (8µs+16µs) by Eval::TypeTiny::import at line 4 # spent 24µs making 1 call to Exporter::Tiny::BEGIN@4
# spent 16µs making 1 call to strict::import |
5 | 4 | 201µs | 4 | 68µs | use warnings; no warnings qw(void once uninitialized numeric redefine); # spent 28µs making 1 call to Exporter::Tiny::BEGIN@5.2
# spent 18µs making 1 call to Exporter::Tiny::BEGIN@5
# spent 18µs making 1 call to warnings::unimport
# spent 5µs making 1 call to warnings::import |
6 | |||||
7 | 1 | 800ns | our $AUTHORITY = 'cpan:TOBYINK'; | ||
8 | 1 | 200ns | our $VERSION = '0.030'; | ||
9 | 1 | 1µs | our @EXPORT_OK = qw< mkopt mkopt_hash _croak >; | ||
10 | |||||
11 | sub _croak ($;@) { require Carp; my $fmt = shift; @_ = sprintf($fmt, @_); goto \&Carp::croak } | ||||
12 | |||||
13 | sub import | ||||
14 | # spent 4.84ms (910µs+3.93) within Exporter::Tiny::import which was called 9 times, avg 538µs/call:
# once (464µs+2.42ms) by Typed::BEGIN@10 at line 10 of Typed.pm
# once (87µs+376µs) by Typed::import at line 23 of Typed.pm
# once (91µs+270µs) by Typed::import at line 22 of Typed.pm
# once (81µs+258µs) by Type::Utils::BEGIN@17 at line 17 of Type/Utils.pm
# once (55µs+157µs) by Types::TypeTiny::import at line 26 of Types/TypeTiny.pm
# once (34µs+173µs) by Types::Standard::BEGIN@18 at line 18 of Types/Standard.pm
# once (58µs+142µs) by Eval::TypeTiny::import at line 42 of Eval/TypeTiny.pm
# once (19µs+87µs) by Type::Utils::BEGIN@15 at line 15 of Type/Utils.pm
# once (22µs+42µs) by Typed::BEGIN@12 at line 12 of Typed.pm | ||||
15 | 9 | 4µs | my $class = shift; | ||
16 | 9 | 18µs | my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () }; | ||
17 | 20 | 313µs | 2 | 39µs | # spent 24µs (9+15) within Exporter::Tiny::BEGIN@17 which was called:
# once (9µs+15µs) by Eval::TypeTiny::import at line 17 # spent 24µs making 1 call to Exporter::Tiny::BEGIN@17
# spent 15µs making 1 call to strict::unimport |
18 | 9 | 14µs | 9 | 92µs | my $opts = mkopt(\@args); # spent 92µs making 9 calls to Exporter::Tiny::mkopt, avg 10µs/call |
19 | |||||
20 | 9 | 10µs | $global_opts->{into} = caller unless exists $global_opts->{into}; | ||
21 | 9 | 1µs | my @want; | ||
22 | |||||
23 | 9 | 3µs | while (@$opts) | ||
24 | { | ||||
25 | 55 | 11µs | my $opt = shift @{$opts}; | ||
26 | 55 | 13µs | my ($name, $value) = @$opt; | ||
27 | |||||
28 | 55 | 160µs | 57 | 101µs | $name =~ /^[:-](.+)$/ # spent 71µs making 2 calls to Type::Library::_exporter_expand_tag, avg 35µs/call
# spent 30µs making 55 calls to Exporter::Tiny::CORE:match, avg 551ns/call |
29 | ? push(@$opts, $class->_exporter_expand_tag($1, $value, $global_opts)) | ||||
30 | : push(@want, $opt); | ||||
31 | } | ||||
32 | |||||
33 | 9 | 26µs | 9 | 41µs | $class->_exporter_validate_opts($global_opts); # spent 34µs making 3 calls to Type::Library::_exporter_validate_opts, avg 11µs/call
# spent 7µs making 6 calls to Exporter::Tiny::_exporter_validate_opts, avg 1µs/call |
34 | 9 | 22µs | 9 | 885µs | my $permitted = $class->_exporter_permitted_regexp($global_opts); # spent 457µs making 3 calls to Type::Library::_exporter_permitted_regexp, avg 152µs/call
# spent 428µs making 6 calls to Exporter::Tiny::_exporter_permitted_regexp, avg 71µs/call |
35 | |||||
36 | 9 | 79µs | for my $wanted (@want) | ||
37 | { | ||||
38 | 53 | 142µs | 53 | 1.86ms | my %symbols = $class->_exporter_expand_sub(@$wanted, $global_opts, $permitted); # spent 1.48ms making 35 calls to Type::Library::_exporter_expand_sub, avg 42µs/call
# spent 380µs making 18 calls to Exporter::Tiny::_exporter_expand_sub, avg 21µs/call |
39 | $class->_exporter_install_sub($_, $wanted->[1], $global_opts, $symbols{$_}) | ||||
40 | 53 | 213µs | 53 | 954µs | for keys %symbols; # spent 954µs making 53 calls to Exporter::Tiny::_exporter_install_sub, avg 18µs/call |
41 | } | ||||
42 | } | ||||
43 | |||||
44 | # Called once per import, passed the "global" import options. Expected to | ||||
45 | # validate the import options and carp or croak if there are problems. Can | ||||
46 | # also take the opportunity to do other stuff if needed. | ||||
47 | # | ||||
48 | sub _exporter_validate_opts | ||||
49 | # spent 10µs within Exporter::Tiny::_exporter_validate_opts which was called 9 times, avg 1µs/call:
# 6 times (7µs+0s) by Exporter::Tiny::import at line 33, avg 1µs/call
# 3 times (3µs+0s) by Type::Library::_exporter_validate_opts at line 42 of Type/Library.pm, avg 1µs/call | ||||
50 | 9 | 24µs | 1; | ||
51 | } | ||||
52 | |||||
53 | # Given a tag name, looks it up in %EXPORT_TAGS and returns the list of | ||||
54 | # associated functions. The default implementation magically handles tags | ||||
55 | # "all" and "default". The default implementation interprets any undefined | ||||
56 | # tags as being global options. | ||||
57 | # | ||||
58 | sub _exporter_expand_tag | ||||
59 | # spent 9µs within Exporter::Tiny::_exporter_expand_tag which was called:
# once (9µs+0s) by Type::Library::_exporter_expand_tag at line 73 of Type/Library.pm | ||||
60 | 2 | 220µs | 2 | 42µs | # spent 28µs (14+14) within Exporter::Tiny::BEGIN@60 which was called:
# once (14µs+14µs) by Eval::TypeTiny::import at line 60 # spent 28µs making 1 call to Exporter::Tiny::BEGIN@60
# spent 14µs making 1 call to strict::unimport |
61 | |||||
62 | 1 | 500ns | my $class = shift; | ||
63 | 1 | 800ns | my ($name, $value, $globals) = @_; | ||
64 | 1 | 4µs | my $tags = \%{"$class\::EXPORT_TAGS"}; | ||
65 | |||||
66 | 1 | 700ns | return map [$_ => $value], $tags->{$name}->($class, @_) | ||
67 | if ref($tags->{$name}) eq q(CODE); | ||||
68 | |||||
69 | 1 | 400ns | return map [$_ => $value], @{$tags->{$name}} | ||
70 | if exists $tags->{$name}; | ||||
71 | |||||
72 | 1 | 100ns | return map [$_ => $value], @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"} | ||
73 | if $name eq 'all'; | ||||
74 | |||||
75 | 1 | 200ns | return map [$_ => $value], @{"$class\::EXPORT"} | ||
76 | if $name eq 'default'; | ||||
77 | |||||
78 | 1 | 600ns | $globals->{$name} = $value || 1; | ||
79 | 1 | 5µs | return; | ||
80 | } | ||||
81 | |||||
82 | # Helper for _exporter_expand_sub. Returns a regexp matching all subs in | ||||
83 | # the exporter package which are available for export. | ||||
84 | # | ||||
85 | sub _exporter_permitted_regexp | ||||
86 | # spent 496µs (154+341) within Exporter::Tiny::_exporter_permitted_regexp which was called 9 times, avg 55µs/call:
# 6 times (119µs+310µs) by Exporter::Tiny::import at line 34, avg 71µs/call
# 3 times (36µs+32µs) by Type::Library::_exporter_permitted_regexp at line 114 of Type/Library.pm, avg 22µs/call | ||||
87 | 2 | 174µs | 2 | 36µs | # spent 22µs (9+13) within Exporter::Tiny::BEGIN@87 which was called:
# once (9µs+13µs) by Eval::TypeTiny::import at line 87 # spent 22µs making 1 call to Exporter::Tiny::BEGIN@87
# spent 13µs making 1 call to strict::unimport |
88 | 9 | 2µs | my $class = shift; | ||
89 | my $re = join "|", map quotemeta, sort { | ||||
90 | length($b) <=> length($a) or $a cmp $b | ||||
91 | 9 | 140µs | 9 | 50µs | } @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"}; # spent 50µs making 9 calls to Exporter::Tiny::CORE:sort, avg 6µs/call |
92 | 9 | 364µs | 18 | 292µs | qr{^(?:$re)$}ms; # spent 275µs making 9 calls to Exporter::Tiny::CORE:regcomp, avg 31µs/call
# spent 16µs making 9 calls to Exporter::Tiny::CORE:qr, avg 2µs/call |
93 | } | ||||
94 | |||||
95 | # Given a sub name, returns a hash of subs to install (usually just one sub). | ||||
96 | # Keys are sub names, values are coderefs. | ||||
97 | # | ||||
98 | sub _exporter_expand_sub | ||||
99 | # spent 1.07ms (600µs+475µs) within Exporter::Tiny::_exporter_expand_sub which was called 53 times, avg 20µs/call:
# 35 times (384µs+311µs) by Type::Library::_exporter_expand_sub at line 151 of Type/Library.pm, avg 20µs/call
# 18 times (216µs+164µs) by Exporter::Tiny::import at line 38, avg 21µs/call | ||||
100 | 53 | 12µs | my $class = shift; | ||
101 | 53 | 18µs | my ($name, $value, $globals, $permitted) = @_; | ||
102 | 53 | 6µs | $permitted ||= $class->_exporter_permitted_regexp($globals); | ||
103 | |||||
104 | 2 | 398µs | 2 | 36µs | # spent 23µs (9+13) within Exporter::Tiny::BEGIN@104 which was called:
# once (9µs+13µs) by Eval::TypeTiny::import at line 104 # spent 23µs making 1 call to Exporter::Tiny::BEGIN@104
# spent 13µs making 1 call to strict::unimport |
105 | |||||
106 | 53 | 373µs | 106 | 193µs | if ($name =~ $permitted) # spent 108µs making 53 calls to Exporter::Tiny::CORE:match, avg 2µs/call
# spent 85µs making 53 calls to Exporter::Tiny::CORE:regcomp, avg 2µs/call |
107 | { | ||||
108 | 53 | 364µs | 53 | 223µs | my $generator = $class->can("_generate_$name"); # spent 223µs making 53 calls to UNIVERSAL::can, avg 4µs/call |
109 | 53 | 5µs | return $name => $class->$generator($name, $value, $globals) if $generator; | ||
110 | |||||
111 | 53 | 162µs | 53 | 58µs | my $sub = $class->can($name); # spent 58µs making 53 calls to UNIVERSAL::can, avg 1µs/call |
112 | 53 | 147µs | return $name => $sub if $sub; | ||
113 | } | ||||
114 | |||||
115 | $class->_exporter_fail(@_); | ||||
116 | } | ||||
117 | |||||
118 | # Called by _exporter_expand_sub if it is unable to generate a key-value | ||||
119 | # pair for a sub. | ||||
120 | # | ||||
121 | sub _exporter_fail | ||||
122 | { | ||||
123 | my $class = shift; | ||||
124 | my ($name, $value, $globals) = @_; | ||||
125 | _croak("Could not find sub '$name' to export in package '$class'"); | ||||
126 | } | ||||
127 | |||||
128 | # Actually performs the installation of the sub into the target package. This | ||||
129 | # also handles renaming the sub. | ||||
130 | # | ||||
131 | sub _exporter_install_sub | ||||
132 | # spent 954µs (808+146) within Exporter::Tiny::_exporter_install_sub which was called 53 times, avg 18µs/call:
# 53 times (808µs+146µs) by Exporter::Tiny::import at line 40, avg 18µs/call | ||||
133 | 53 | 11µs | my $class = shift; | ||
134 | 53 | 27µs | my ($name, $value, $globals, $sym) = @_; | ||
135 | |||||
136 | 53 | 17µs | my $into = $globals->{into}; | ||
137 | 53 | 17µs | my $installer = $globals->{installer} || $globals->{exporter}; | ||
138 | |||||
139 | 53 | 26µs | $name = $value->{-as} || $name; | ||
140 | 53 | 22µs | unless (ref($name) eq q(SCALAR)) | ||
141 | { | ||||
142 | 53 | 86µs | my ($prefix) = grep defined, $value->{-prefix}, $globals->{prefix}, q(); | ||
143 | 53 | 54µs | my ($suffix) = grep defined, $value->{-suffix}, $globals->{suffix}, q(); | ||
144 | 53 | 39µs | $name = "$prefix$name$suffix"; | ||
145 | } | ||||
146 | |||||
147 | 53 | 5µs | return $installer->($globals, [$name, $sym]) if $installer; | ||
148 | 53 | 6µs | return ($$name = $sym) if ref($name) eq q(SCALAR); | ||
149 | 53 | 5µs | return ($into->{$name} = $sym) if ref($into) eq q(HASH); | ||
150 | |||||
151 | 53 | 14µs | require B; | ||
152 | 53 | 378µs | 53 | 146µs | for (grep ref, $into->can($name)) # spent 146µs making 53 calls to UNIVERSAL::can, avg 3µs/call |
153 | { | ||||
154 | my $stash = B::svref_2object($_)->STASH; | ||||
155 | next unless $stash->can("NAME"); | ||||
156 | $stash->NAME eq $into | ||||
157 | and _croak("Refusing to overwrite local sub '$name' with export from $class"); | ||||
158 | } | ||||
159 | |||||
160 | 2 | 307µs | 2 | 36µs | # spent 23µs (9+14) within Exporter::Tiny::BEGIN@160 which was called:
# once (9µs+14µs) by Eval::TypeTiny::import at line 160 # spent 23µs making 1 call to Exporter::Tiny::BEGIN@160
# spent 14µs making 1 call to strict::unimport |
161 | 53 | 238µs | *{"$into\::$name"} = $sym; | ||
162 | } | ||||
163 | |||||
164 | sub mkopt | ||||
165 | # spent 92µs within Exporter::Tiny::mkopt which was called 9 times, avg 10µs/call:
# 9 times (92µs+0s) by Exporter::Tiny::import at line 18, avg 10µs/call | ||||
166 | 9 | 3µs | my $in = shift or return []; | ||
167 | 9 | 1µs | my @out; | ||
168 | |||||
169 | 9 | 4µs | $in = [map(($_ => ref($in->{$_}) ? $in->{$_} : ()), sort keys %$in)] | ||
170 | if ref($in) eq q(HASH); | ||||
171 | |||||
172 | 9 | 14µs | for (my $i = 0; $i < @$in; $i++) | ||
173 | { | ||||
174 | 20 | 6µs | my $k = $in->[$i]; | ||
175 | 20 | 300ns | my $v; | ||
176 | |||||
177 | 20 | 14µs | ($i == $#$in) ? ($v = undef) : | ||
178 | !defined($in->[$i+1]) ? (++$i, ($v = undef)) : | ||||
179 | !ref($in->[$i+1]) ? ($v = undef) : | ||||
180 | ($v = $in->[++$i]); | ||||
181 | |||||
182 | 20 | 18µs | push @out, [ $k => $v ]; | ||
183 | } | ||||
184 | |||||
185 | 9 | 40µs | \@out; | ||
186 | } | ||||
187 | |||||
188 | sub mkopt_hash | ||||
189 | { | ||||
190 | my $in = shift or return; | ||||
191 | my %out = map +($_->[0] => $_->[1]), @{ mkopt($in) }; | ||||
192 | \%out; | ||||
193 | } | ||||
194 | |||||
195 | 1 | 5µs | 1; | ||
196 | |||||
197 | __END__ | ||||
sub Exporter::Tiny::CORE:match; # opcode | |||||
# spent 16µs within Exporter::Tiny::CORE:qr which was called 9 times, avg 2µs/call:
# 9 times (16µs+0s) by Exporter::Tiny::_exporter_permitted_regexp at line 92, avg 2µs/call | |||||
sub Exporter::Tiny::CORE:regcomp; # opcode | |||||
# spent 50µs within Exporter::Tiny::CORE:sort which was called 9 times, avg 6µs/call:
# 9 times (50µs+0s) by Exporter::Tiny::_exporter_permitted_regexp at line 91, avg 6µs/call |