← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Wed Dec 14 15:57:08 2022
Reported on Wed Dec 14 16:00:32 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Exporter/Tiny.pm
StatementsExecuted 2319 statements in 11.1ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
59211.66ms1.66msExporter::Tiny::::CORE:regcompExporter::Tiny::CORE:regcomp (opcode)
1311804µs909µsExporter::Tiny::::__ANON__[:52]Exporter::Tiny::__ANON__[:52]
131312790µs8.94msExporter::Tiny::::importExporter::Tiny::import
1311775µs3.12msExporter::Tiny::::_exporter_permitted_regexpExporter::Tiny::_exporter_permitted_regexp
1311756µs756µsExporter::Tiny::::CORE:sortExporter::Tiny::CORE:sort (opcode)
4622693µs719µsExporter::Tiny::::_exporter_install_subExporter::Tiny::_exporter_install_sub
4622627µs993µsExporter::Tiny::::_exporter_expand_subExporter::Tiny::_exporter_expand_sub
37241233µs233µsExporter::Tiny::::CORE:matchExporter::Tiny::CORE:match (opcode)
1311159µs159µsExporter::Tiny::::mkoptExporter::Tiny::mkopt
111113µs113µsExporter::Tiny::::BEGIN@11Exporter::Tiny::BEGIN@11
11136µs36µsExporter::Tiny::::BEGIN@3Exporter::Tiny::BEGIN@3
131130µs30µsExporter::Tiny::::CORE:qrExporter::Tiny::CORE:qr (opcode)
11114µs21µsExporter::Tiny::::BEGIN@347Exporter::Tiny::BEGIN@347
11114µs14µsExporter::Tiny::::_exporter_expand_tagExporter::Tiny::_exporter_expand_tag
132213µs13µsExporter::Tiny::::_exporter_validate_optsExporter::Tiny::_exporter_validate_opts
11112µs19µsExporter::Tiny::::BEGIN@253Exporter::Tiny::BEGIN@253
11111µs20µsExporter::Tiny::::BEGIN@190Exporter::Tiny::BEGIN@190
11110µs27µsExporter::Tiny::::BEGIN@137Exporter::Tiny::BEGIN@137
11110µs16µsExporter::Tiny::::BEGIN@217Exporter::Tiny::BEGIN@217
11110µs14µsExporter::Tiny::::BEGIN@396Exporter::Tiny::BEGIN@396
11110µs21µsExporter::Tiny::::BEGIN@69Exporter::Tiny::BEGIN@69
1119µs12µsExporter::Tiny::::BEGIN@236Exporter::Tiny::BEGIN@236
1119µs28µsExporter::Tiny::::BEGIN@382Exporter::Tiny::BEGIN@382
1119µs14µsExporter::Tiny::::BEGIN@4Exporter::Tiny::BEGIN@4
1117µs47µsExporter::Tiny::::BEGIN@5Exporter::Tiny::BEGIN@5
1117µs28µsExporter::Tiny::::BEGIN@5.25Exporter::Tiny::BEGIN@5.25
0000s0sExporter::Tiny::::__ANON__[:126]Exporter::Tiny::__ANON__[:126]
0000s0sExporter::Tiny::::__ANON__[:139]Exporter::Tiny::__ANON__[:139]
0000s0sExporter::Tiny::::__ANON__[:145]Exporter::Tiny::__ANON__[:145]
0000s0sExporter::Tiny::::__ANON__[:364]Exporter::Tiny::__ANON__[:364]
0000s0sExporter::Tiny::::__ANON__[:368]Exporter::Tiny::__ANON__[:368]
0000s0sExporter::Tiny::::_carpExporter::Tiny::_carp
0000s0sExporter::Tiny::::_croakExporter::Tiny::_croak
0000s0sExporter::Tiny::::_exporter_expand_regexpExporter::Tiny::_exporter_expand_regexp
0000s0sExporter::Tiny::::_exporter_failExporter::Tiny::_exporter_fail
0000s0sExporter::Tiny::::_exporter_lexical_installerExporter::Tiny::_exporter_lexical_installer
0000s0sExporter::Tiny::::_exporter_merge_optsExporter::Tiny::_exporter_merge_opts
0000s0sExporter::Tiny::::_exporter_uninstall_subExporter::Tiny::_exporter_uninstall_sub
0000s0sExporter::Tiny::::_exporter_validate_unimport_optsExporter::Tiny::_exporter_validate_unimport_opts
0000s0sExporter::Tiny::::mkopt_hashExporter::Tiny::mkopt_hash
0000s0sExporter::Tiny::::unimportExporter::Tiny::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Exporter::Tiny;
2
3252µs136µs
# spent 36µs within Exporter::Tiny::BEGIN@3 which was called: # once (36µs+0s) by List::MoreUtils::BEGIN@24 at line 3
use 5.006001;
# spent 36µs making 1 call to Exporter::Tiny::BEGIN@3
4229µs219µs
# spent 14µs (9+5) within Exporter::Tiny::BEGIN@4 which was called: # once (9µs+5µs) by List::MoreUtils::BEGIN@24 at line 4
use strict;
# spent 14µs making 1 call to Exporter::Tiny::BEGIN@4 # spent 5µs making 1 call to strict::import
54180µs4136µs
# spent 47µs (7+40) within Exporter::Tiny::BEGIN@5 which was called: # once (7µs+40µs) by List::MoreUtils::BEGIN@24 at line 5 # spent 28µs (7+21) within Exporter::Tiny::BEGIN@5.25 which was called: # once (7µs+21µs) by List::MoreUtils::BEGIN@24 at line 5
use warnings; no warnings qw(void once uninitialized numeric redefine);
# spent 47µs making 1 call to Exporter::Tiny::BEGIN@5 # spent 40µs making 1 call to warnings::import # spent 28µs making 1 call to Exporter::Tiny::BEGIN@5.25 # spent 21µs making 1 call to warnings::unimport
6
711µsour $AUTHORITY = 'cpan:TOBYINK';
810sour $VERSION = '1.006000';
912µsour @EXPORT_OK = qw< mkopt mkopt_hash _croak _carp >;
10
11
# spent 113µs within Exporter::Tiny::BEGIN@11 which was called: # once (113µs+0s) by List::MoreUtils::BEGIN@24 at line 18
BEGIN {
12 *_HAS_NATIVE_LEXICAL_SUB = ( $] ge '5.037002' )
13 ? sub () { !!1 }
1412µs : sub () { !!0 };
15 *_HAS_MODULE_LEXICAL_SUB = ( $] ge '5.011002' and eval('require Lexical::Sub') )
16 ? sub () { !!1 }
17119µs : sub () { !!0 };
# spent 94µs executing statements in string eval
181535µs1113µs};
# spent 113µs making 1 call to Exporter::Tiny::BEGIN@11
19
20sub _croak ($;@) { require Carp; my $fmt = shift; @_ = sprintf($fmt, @_); goto \&Carp::croak }
21sub _carp ($;@) { require Carp; my $fmt = shift; @_ = sprintf($fmt, @_); goto \&Carp::carp }
22
23my $_process_optlist = sub
24
# spent 909µs (804+105) within Exporter::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Exporter/Tiny.pm:52] which was called 13 times, avg 70µs/call: # 13 times (804µs+105µs) by Exporter::Tiny::import at line 71, avg 70µs/call
{
25135µs my $class = shift;
26138µs my ($global_opts, $opts, $want, $not_want) = @_;
27
281341µs while (@$opts)
29 {
304716µs my $opt = shift @{$opts};
314716µs my ($name, $value) = @$opt;
32
33 ($name =~ m{\A\!(/.+/[msixpodual]*)\z}) ?
34 do {
35 my @not = $class->_exporter_expand_regexp("$1", $value, $global_opts);
36 ++$not_want->{$_->[0]} for @not;
37 } :
38 ($name =~ m{\A\![:-](.+)\z}) ?
39 do {
40 my @not = $class->_exporter_expand_tag("$1", $value, $global_opts);
41 ++$not_want->{$_->[0]} for @not;
42 } :
43 ($name =~ m{\A\!(.+)\z}) ?
4447819µs235105µs (++$not_want->{$1}) :
# spent 91µs making 234 calls to Exporter::Tiny::CORE:match, avg 389ns/call # spent 14µs making 1 call to Exporter::Tiny::_exporter_expand_tag
45 ($name =~ m{\A[:-](.+)\z}) ?
46 push(@$opts, $class->_exporter_expand_tag("$1", $value, $global_opts)) :
47 ($name =~ m{\A/.+/[msixpodual]*\z}) ?
48 push(@$opts, $class->_exporter_expand_regexp($name, $value, $global_opts)) :
49 # else ?
50 push(@$want, $opt);
51 }
52110µs};
53
54sub import
55
# spent 8.94ms (790µs+8.14) within Exporter::Tiny::import which was called 13 times, avg 687µs/call: # once (190µs+2.77ms) by JSON::Schema::Modern::BEGIN@31 at line 31 of JSON/Schema/Modern.pm # once (73µs+1.14ms) by JSON::Schema::Modern::Document::BEGIN@24 at line 24 of JSON/Schema/Modern/Document.pm # once (70µs+792µs) by JSON::Schema::Modern::Error::BEGIN@20 at line 20 of JSON/Schema/Modern/Error.pm # once (59µs+707µs) by JSON::Schema::Modern::Result::BEGIN@18 at line 18 of JSON/Schema/Modern/Result.pm # once (57µs+618µs) by JSON::Schema::Modern::Annotation::BEGIN@19 at line 19 of JSON/Schema/Modern/Annotation.pm # once (44µs+474µs) by File::ShareDir::BEGIN@1 at line 1 of (eval 29)[File/ShareDir.pm:430] # once (37µs+351µs) by JSON::Schema::Modern::Document::OpenAPI::BEGIN@26 at line 26 of JSON/Schema/Modern/Document/OpenAPI.pm # once (58µs+252µs) by Eval::TypeTiny::import at line 89 of Eval/TypeTiny.pm # once (49µs+239µs) by Types::Standard::BEGIN@23 at line 23 of Types/Standard.pm # once (66µs+211µs) by JSON::Schema::Modern::BEGIN@27 at line 430 of File/ShareDir.pm # once (33µs+227µs) by OpenAPI::Modern::BEGIN@31 at line 31 of OpenAPI/Modern.pm # once (20µs+236µs) by Data::Perl::Role::Collection::Array::BEGIN@9 at line 9 of Data/Perl/Role/Collection/Array.pm # once (34µs+133µs) by Types::Standard::BEGIN@19 at line 19 of Types/Standard.pm
{
56135µs my $class = shift;
571320µs my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () };
58
591313µs if ( defined $global_opts->{into} and $global_opts->{into} eq '-lexical' ) {
60 $global_opts->{lexical} = 1;
61 delete $global_opts->{into};
62 }
631336µs if ( not defined $global_opts->{into} ) {
64 $global_opts->{into} = caller;
65 }
66
671310µs my @want;
681315µs my %not_want; $global_opts->{not} = \%not_want;
6928524µs232µs
# spent 21µs (10+11) within Exporter::Tiny::BEGIN@69 which was called: # once (10µs+11µs) by List::MoreUtils::BEGIN@24 at line 69
my @args = do { no strict qw(refs); @_ ? @_ : @{"$class\::EXPORT"} };
# spent 21µs making 1 call to Exporter::Tiny::BEGIN@69 # spent 11µs making 1 call to strict::unimport
701334µs13159µs my $opts = mkopt(\@args);
# spent 159µs making 13 calls to Exporter::Tiny::mkopt, avg 12µs/call
711333µs13909µs $class->$_process_optlist($global_opts, $opts, \@want, \%not_want);
# spent 909µs making 13 calls to Exporter::Tiny::__ANON__[Exporter/Tiny.pm:52], avg 70µs/call
72
73 $global_opts->{installer} ||= $class->_exporter_lexical_installer( $global_opts )
74137µs if $global_opts->{lexical};
75
761349µs133.12ms my $permitted = $class->_exporter_permitted_regexp($global_opts);
# spent 3.12ms making 13 calls to Exporter::Tiny::_exporter_permitted_regexp, avg 240µs/call
771348µs13198µs $class->_exporter_validate_opts($global_opts);
# spent 192µs making 8 calls to Type::Library::_exporter_validate_opts, avg 24µs/call # spent 6µs making 5 calls to Exporter::Tiny::_exporter_validate_opts, avg 1µs/call
78
7913129µs for my $wanted (@want) {
804622µs next if $not_want{$wanted->[0]};
81
8246108µs462.05ms my %symbols = $class->_exporter_expand_sub(@$wanted, $global_opts, $permitted);
# spent 1.91ms making 40 calls to Type::Library::_exporter_expand_sub, avg 48µs/call # spent 137µs making 6 calls to Exporter::Tiny::_exporter_expand_sub, avg 23µs/call
83 $class->_exporter_install_sub($_, $wanted->[1], $global_opts, $symbols{$_})
8446143µs461.70ms for keys %symbols;
# spent 1.58ms making 40 calls to Type::Library::_exporter_install_sub, avg 40µs/call # spent 125µs making 6 calls to Exporter::Tiny::_exporter_install_sub, avg 21µs/call
85 }
86}
87
88sub unimport
89{
90 my $class = shift;
91 my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () };
92 $global_opts->{is_unimport} = 1;
93
94 if ( defined $global_opts->{into} and $global_opts->{into} eq '-lexical' ) {
95 $global_opts->{lexical} = 1;
96 delete $global_opts->{into};
97 }
98 if ( not defined $global_opts->{into} ) {
99 $global_opts->{into} = caller;
100 }
101
102 my @want;
103 my %not_want; $global_opts->{not} = \%not_want;
104 my @args = do { our %TRACKED; @_ ? @_ : keys(%{$TRACKED{$class}{$global_opts->{into}}}) };
105 my $opts = mkopt(\@args);
106 $class->$_process_optlist($global_opts, $opts, \@want, \%not_want);
107
108 my $permitted = $class->_exporter_permitted_regexp($global_opts);
109 $class->_exporter_validate_unimport_opts($global_opts);
110
111 my $expando = $class->can('_exporter_expand_sub');
112 $expando = undef if $expando == \&_exporter_expand_sub;
113
114 for my $wanted (@want)
115 {
116 next if $not_want{$wanted->[0]};
117
118 if ($wanted->[1])
119 {
120 _carp("Passing options to unimport '%s' makes no sense", $wanted->[0])
121 unless (ref($wanted->[1]) eq 'HASH' and not keys %{$wanted->[1]});
122 }
123
124 my %symbols = defined($expando)
125 ? $class->$expando(@$wanted, $global_opts, $permitted)
126 : ($wanted->[0] => sub { "dummy" });
127 $class->_exporter_uninstall_sub($_, $wanted->[1], $global_opts)
128 for keys %symbols;
129 }
130}
131
132# Returns a coderef suitable to be used as a sub installer for lexical imports.
133#
134sub _exporter_lexical_installer {
135 _HAS_NATIVE_LEXICAL_SUB and return sub {
136 my ( $sigilname, $sym ) = @{ $_[1] };
1372578µs244µs
# spent 27µs (10+17) within Exporter::Tiny::BEGIN@137 which was called: # once (10µs+17µs) by List::MoreUtils::BEGIN@24 at line 137
no warnings ( $] ge '5.037002' ? 'experimental::builtin' : () );
# spent 27µs making 1 call to Exporter::Tiny::BEGIN@137 # spent 17µs making 1 call to warnings::unimport
138 builtin::export_lexically( $sigilname, $sym );
139 };
140 _HAS_MODULE_LEXICAL_SUB and return sub {
141 my ( $sigilname, $sym ) = @{ $_[1] };
142 ( $sigilname =~ /^\w/ )
143 ? 'Lexical::Sub'->import( $sigilname, $sym )
144 : 'Lexical::Var'->import( $sigilname, $sym );
145 };
146 _croak( 'Lexical export requires Perl 5.37.2+ for native support, or Perl 5.11.2+ with the Lexical::Sub module' );
147}
148
149# Called once per import/unimport, passed the "global" import options.
150# Expected to validate the options and carp or croak if there are problems.
151# Can also take the opportunity to do other stuff if needed.
152#
15313101µs
# spent 13µs within Exporter::Tiny::_exporter_validate_opts which was called 13 times, avg 1µs/call: # 8 times (7µs+0s) by Type::Library::_exporter_validate_opts at line 36 of Type/Library.pm, avg 875ns/call # 5 times (6µs+0s) by Exporter::Tiny::import at line 77, avg 1µs/call
sub _exporter_validate_opts { 1 }
154sub _exporter_validate_unimport_opts { 1 }
155
156# Called after expanding a tag or regexp to merge the tag's options with
157# any sub-specific options.
158#
159sub _exporter_merge_opts
160{
161 my $class = shift;
162 my ($tag_opts, $global_opts, @stuff) = @_;
163
164 $tag_opts = {} unless ref($tag_opts) eq q(HASH);
165 _croak('Cannot provide an -as option for tags')
166 if exists $tag_opts->{-as} && ref $tag_opts->{-as} ne 'CODE';
167
168 my $optlist = mkopt(\@stuff);
169 for my $export (@$optlist)
170 {
171 next if defined($export->[1]) && ref($export->[1]) ne q(HASH);
172
173 my %sub_opts = ( %{ $export->[1] or {} }, %$tag_opts );
174 $sub_opts{-prefix} = sprintf('%s%s', $tag_opts->{-prefix}, $export->[1]{-prefix})
175 if exists($export->[1]{-prefix}) && exists($tag_opts->{-prefix});
176 $sub_opts{-suffix} = sprintf('%s%s', $export->[1]{-suffix}, $tag_opts->{-suffix})
177 if exists($export->[1]{-suffix}) && exists($tag_opts->{-suffix});
178 $export->[1] = \%sub_opts;
179 }
180 return @$optlist;
181}
182
183# Given a tag name, looks it up in %EXPORT_TAGS and returns the list of
184# associated functions. The default implementation magically handles tags
185# "all" and "default". The default implementation interprets any undefined
186# tags as being global options.
187#
188sub _exporter_expand_tag
189
# spent 14µs within Exporter::Tiny::_exporter_expand_tag which was called: # once (14µs+0s) by Exporter::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Exporter/Tiny.pm:52] at line 44
{
1902161µs229µs
# spent 20µs (11+9) within Exporter::Tiny::BEGIN@190 which was called: # once (11µs+9µs) by List::MoreUtils::BEGIN@24 at line 190
no strict qw(refs);
# spent 20µs making 1 call to Exporter::Tiny::BEGIN@190 # spent 9µs making 1 call to strict::unimport
191
19211µs my $class = shift;
19311µs my ($name, $value, $globals) = @_;
19415µs my $tags = \%{"$class\::EXPORT_TAGS"};
195
196 return $class->_exporter_merge_opts($value, $globals, $tags->{$name}->($class, @_))
19711µs if ref($tags->{$name}) eq q(CODE);
198
199 return $class->_exporter_merge_opts($value, $globals, @{$tags->{$name}})
20010s if exists $tags->{$name};
201
20211µs return $class->_exporter_merge_opts($value, $globals, @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"})
203 if $name eq 'all';
204
20511µs return $class->_exporter_merge_opts($value, $globals, @{"$class\::EXPORT"})
206 if $name eq 'default';
207
20811µs $globals->{$name} = $value || 1;
20915µs return;
210}
211
212# Given a regexp-like string, looks it up in @EXPORT_OK and returns the
213# list of matching functions.
214#
215sub _exporter_expand_regexp
216{
2172133µs222µs
# spent 16µs (10+6) within Exporter::Tiny::BEGIN@217 which was called: # once (10µs+6µs) by List::MoreUtils::BEGIN@24 at line 217
no strict qw(refs);
# spent 16µs making 1 call to Exporter::Tiny::BEGIN@217 # spent 6µs making 1 call to strict::unimport
218 our %TRACKED;
219
220 my $class = shift;
221 my ($name, $value, $globals) = @_;
222 my $compiled = eval("qr$name");
223
224 my @possible = $globals->{is_unimport}
225 ? keys( %{$TRACKED{$class}{$globals->{into}}} )
226 : @{"$class\::EXPORT_OK"};
227
228 $class->_exporter_merge_opts($value, $globals, grep /$compiled/, @possible);
229}
230
231# Helper for _exporter_expand_sub. Returns a regexp matching all subs in
232# the exporter package which are available for export.
233#
234sub _exporter_permitted_regexp
235
# spent 3.12ms (775µs+2.35) within Exporter::Tiny::_exporter_permitted_regexp which was called 13 times, avg 240µs/call: # 13 times (775µs+2.35ms) by Exporter::Tiny::import at line 76, avg 240µs/call
{
2362218µs215µs
# spent 12µs (9+3) within Exporter::Tiny::BEGIN@236 which was called: # once (9µs+3µs) by List::MoreUtils::BEGIN@24 at line 236
no strict qw(refs);
# spent 12µs making 1 call to Exporter::Tiny::BEGIN@236 # spent 3µs making 1 call to strict::unimport
237134µs my $class = shift;
238 my $re = join "|", map quotemeta, sort {
239 length($b) <=> length($a) or $a cmp $b
240131.36ms13756µs } @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"};
# spent 756µs making 13 calls to Exporter::Tiny::CORE:sort, avg 58µs/call
241131.77ms261.59ms qr{^(?:$re)$}ms;
# spent 1.56ms making 13 calls to Exporter::Tiny::CORE:regcomp, avg 120µs/call # spent 30µs making 13 calls to Exporter::Tiny::CORE:qr, avg 2µs/call
242}
243
244# Given a sub name, returns a hash of subs to install (usually just one sub).
245# Keys are sub names, values are coderefs.
246#
247sub _exporter_expand_sub
248
# spent 993µs (627+366) within Exporter::Tiny::_exporter_expand_sub which was called 46 times, avg 22µs/call: # 40 times (545µs+311µs) by Type::Library::_exporter_expand_sub at line 113 of Type/Library.pm, avg 21µs/call # 6 times (82µs+55µs) by Exporter::Tiny::import at line 82, avg 23µs/call
{
249466µs my $class = shift;
2504621µs my ($name, $value, $globals, $permitted) = @_;
251465µs $permitted ||= $class->_exporter_permitted_regexp($globals);
252
25321.06ms226µs
# spent 19µs (12+7) within Exporter::Tiny::BEGIN@253 which was called: # once (12µs+7µs) by List::MoreUtils::BEGIN@24 at line 253
no strict qw(refs);
# spent 19µs making 1 call to Exporter::Tiny::BEGIN@253 # spent 7µs making 1 call to strict::unimport
254
2554616µs my $sigil = "&";
2564687µs4624µs if ($name =~ /\A([&\$\%\@\*])(.+)\z/) {
# spent 24µs making 46 calls to Exporter::Tiny::CORE:match, avg 522ns/call
257 $sigil = $1;
258 $name = $2;
259 if ($sigil eq '*') {
260 _croak("Cannot export symbols with a * sigil");
261 }
262 }
2634621µs my $sigilname = $sigil eq '&' ? $name : "$sigil$name";
264
26546286µs92187µs if ($sigilname =~ $permitted)
# spent 95µs making 46 calls to Exporter::Tiny::CORE:regcomp, avg 2µs/call # spent 92µs making 46 calls to Exporter::Tiny::CORE:match, avg 2µs/call
266 {
267 my $generatorprefix = {
268 '&' => "_generate_",
269 '$' => "_generateScalar_",
270 '@' => "_generateArray_",
271 '%' => "_generateHash_",
27246142µs }->{$sigil};
273
27446221µs46118µs my $generator = $class->can("$generatorprefix$name");
# spent 118µs making 46 calls to UNIVERSAL::can, avg 3µs/call
275462µs return $sigilname => $class->$generator($sigilname, $value, $globals) if $generator;
276
277468µs if ($sigil eq '&') {
27846107µs4637µs my $sub = $class->can($name);
# spent 37µs making 46 calls to UNIVERSAL::can, avg 804ns/call
27946100µs return $sigilname => $sub if $sub;
280 }
281 else {
282 # Could do this more cleverly, but this works.
283 my $evalled = eval "\\${sigil}${class}::${name}";
284 return $sigilname => $evalled if $evalled;
285 }
286 }
287
288 $class->_exporter_fail(@_);
289}
290
291# Called by _exporter_expand_sub if it is unable to generate a key-value
292# pair for a sub.
293#
294sub _exporter_fail
295{
296 my $class = shift;
297 my ($name, $value, $globals) = @_;
298 return if $globals->{is_unimport};
299 _croak("Could not find sub '%s' exported by %s", $name, $class);
300}
301
302# Actually performs the installation of the sub into the target package. This
303# also handles renaming the sub.
304#
305sub _exporter_install_sub
306
# spent 719µs (693+26) within Exporter::Tiny::_exporter_install_sub which was called 46 times, avg 16µs/call: # 40 times (571µs+23µs) by Type::Library::_exporter_install_sub at line 154 of Type/Library.pm, avg 15µs/call # 6 times (122µs+3µs) by Exporter::Tiny::import at line 84, avg 21µs/call
{
307466µs my $class = shift;
3084614µs my ($name, $value, $globals, $sym) = @_;
3094626µs my $value_hash = ( ref($value) eq 'HASH' ) ? $value : {};
310
3114612µs my $into = $globals->{into};
3124613µs my $installer = $globals->{installer} || $globals->{exporter};
313
314 $name =
315 ref $globals->{as} ? $globals->{as}->($name) :
316 ref $value_hash->{-as} ? $value_hash->{-as}->($name) :
317 exists $value_hash->{-as} ? $value_hash->{-as} :
3184620µs $name;
319
320463µs return unless defined $name;
321
322466µs my $sigil = "&";
3234617µs unless (ref($name)) {
32446106µs4626µs if ($name =~ /\A([&\$\%\@\*])(.+)\z/) {
# spent 26µs making 46 calls to Exporter::Tiny::CORE:match, avg 565ns/call
325 $sigil = $1;
326 $name = $2;
327 if ($sigil eq '*') {
328 _croak("Cannot export symbols with a * sigil");
329 }
330 }
3314655µs my ($prefix) = grep defined, $value_hash->{-prefix}, $globals->{prefix}, q();
3324631µs my ($suffix) = grep defined, $value_hash->{-suffix}, $globals->{suffix}, q();
3334629µs $name = "$prefix$name$suffix";
334 }
335
3364621µs my $sigilname = $sigil eq '&' ? $name : ( $sigil . $name );
337
338# if ({qw/$ SCALAR @ ARRAY % HASH & CODE/}->{$sigil} ne ref($sym)) {
339# warn $sym;
340# warn $sigilname;
341# _croak("Reference type %s does not match sigil %s", ref($sym), $sigil);
342# }
343
344469µs return ($$name = $sym) if ref($name) eq q(SCALAR);
3454612µs return ($into->{$sigilname} = $sym) if ref($into) eq q(HASH);
346
3472198µs228µs
# spent 21µs (14+7) within Exporter::Tiny::BEGIN@347 which was called: # once (14µs+7µs) by List::MoreUtils::BEGIN@24 at line 347
no strict qw(refs);
# spent 21µs making 1 call to Exporter::Tiny::BEGIN@347 # spent 7µs making 1 call to strict::unimport
348 our %TRACKED;
349
35046150µs if ( ref($sym) eq 'CODE'
351 and ref($into) ? exists($into->{$name}) : exists(&{"$into\::$name"})
352 and $sym != ( ref($into) ? $into->{$name} : \&{"$into\::$name"} ) )
353 {
354 my ($level) = grep defined, $value_hash->{-replace}, $globals->{replace}, q(0);
355 my $action = {
356 carp => \&_carp,
357 0 => \&_carp,
358 '' => \&_carp,
359 warn => \&_carp,
360 nonfatal => \&_carp,
361 croak => \&_croak,
362 fatal => \&_croak,
363 die => \&_croak,
364 }->{$level} || sub {};
365
366 # Don't complain about double-installing the same sub. This isn't ideal
367 # because the same named sub might be generated in two different ways.
368 $action = sub {} if $TRACKED{$class}{$into}{$sigilname};
369
370 $action->(
371 $action == \&_croak
372 ? "Refusing to overwrite existing sub '%s' with sub '%s' exported by %s"
373 : "Overwriting existing sub '%s' with sub '%s' exported by %s",
374 ref($into) ? $name : "$into\::$name",
375 $_[0],
376 $class,
377 );
378 }
379
3804644µs $TRACKED{$class}{$into}{$sigilname} = $sym;
381
3822144µs247µs
# spent 28µs (9+19) within Exporter::Tiny::BEGIN@382 which was called: # once (9µs+19µs) by List::MoreUtils::BEGIN@24 at line 382
no warnings qw(prototype);
# spent 28µs making 1 call to Exporter::Tiny::BEGIN@382 # spent 19µs making 1 call to warnings::unimport
383 $installer
384 ? $installer->($globals, [$sigilname, $sym])
38546189µs : (*{"$into\::$name"} = $sym);
386}
387
388sub _exporter_uninstall_sub
389{
390 our %TRACKED;
391 my $class = shift;
392 my ($name, $value, $globals, $sym) = @_;
393 my $into = $globals->{into};
394 ref $into and return;
395
3962489µs218µs
# spent 14µs (10+4) within Exporter::Tiny::BEGIN@396 which was called: # once (10µs+4µs) by List::MoreUtils::BEGIN@24 at line 396
no strict qw(refs);
# spent 14µs making 1 call to Exporter::Tiny::BEGIN@396 # spent 4µs making 1 call to strict::unimport
397
398 my $sigil = "&";
399 if ($name =~ /\A([&\$\%\@\*])(.+)\z/) {
400 $sigil = $1;
401 $name = $2;
402 if ($sigil eq '*') {
403 _croak("Cannot export symbols with a * sigil");
404 }
405 }
406 my $sigilname = $sigil eq '&' ? $name : "$sigil$name";
407
408 if ($sigil ne '&') {
409 _croak("Unimporting non-code symbols not supported yet");
410 }
411
412 # Cowardly refuse to uninstall a sub that differs from the one
413 # we installed!
414 my $our_coderef = $TRACKED{$class}{$into}{$name};
415 my $cur_coderef = exists(&{"$into\::$name"}) ? \&{"$into\::$name"} : -1;
416 return unless $our_coderef == $cur_coderef;
417
418 my $stash = \%{"$into\::"};
419 my $old = delete $stash->{$name};
420 my $full_name = join('::', $into, $name);
421 foreach my $type (qw(SCALAR HASH ARRAY IO)) # everything but the CODE
422 {
423 next unless defined(*{$old}{$type});
424 *$full_name = *{$old}{$type};
425 }
426
427 delete $TRACKED{$class}{$into}{$name};
428}
429
430sub mkopt
431
# spent 159µs within Exporter::Tiny::mkopt which was called 13 times, avg 12µs/call: # 13 times (159µs+0s) by Exporter::Tiny::import at line 70, avg 12µs/call
{
432134µs my $in = shift or return [];
433134µs my @out;
434
4351312µs $in = [map(($_ => ref($in->{$_}) ? $in->{$_} : ()), sort keys %$in)]
436 if ref($in) eq q(HASH);
437
4381334µs for (my $i = 0; $i < @$in; $i++)
439 {
4404712µs my $k = $in->[$i];
441473µs my $v;
442
4434727µs ($i == $#$in) ? ($v = undef) :
444 !defined($in->[$i+1]) ? (++$i, ($v = undef)) :
445 !ref($in->[$i+1]) ? ($v = undef) :
446 ($v = $in->[++$i]);
447
4484732µs push @out, [ $k => $v ];
449 }
450
4511353µs \@out;
452}
453
454sub mkopt_hash
455{
456 my $in = shift or return;
457 my %out = map +($_->[0] => $_->[1]), @{ mkopt($in) };
458 \%out;
459}
460
46116µs1;
462
463__END__
 
# spent 233µs within Exporter::Tiny::CORE:match which was called 372 times, avg 626ns/call: # 234 times (91µs+0s) by Exporter::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Exporter/Tiny.pm:52] at line 44, avg 389ns/call # 46 times (92µs+0s) by Exporter::Tiny::_exporter_expand_sub at line 265, avg 2µs/call # 46 times (26µs+0s) by Exporter::Tiny::_exporter_install_sub at line 324, avg 565ns/call # 46 times (24µs+0s) by Exporter::Tiny::_exporter_expand_sub at line 256, avg 522ns/call
sub Exporter::Tiny::CORE:match; # opcode
# spent 30µs within Exporter::Tiny::CORE:qr which was called 13 times, avg 2µs/call: # 13 times (30µs+0s) by Exporter::Tiny::_exporter_permitted_regexp at line 241, avg 2µs/call
sub Exporter::Tiny::CORE:qr; # opcode
# spent 1.66ms within Exporter::Tiny::CORE:regcomp which was called 59 times, avg 28µs/call: # 46 times (95µs+0s) by Exporter::Tiny::_exporter_expand_sub at line 265, avg 2µs/call # 13 times (1.56ms+0s) by Exporter::Tiny::_exporter_permitted_regexp at line 241, avg 120µs/call
sub Exporter::Tiny::CORE:regcomp; # opcode
# spent 756µs within Exporter::Tiny::CORE:sort which was called 13 times, avg 58µs/call: # 13 times (756µs+0s) by Exporter::Tiny::_exporter_permitted_regexp at line 240, avg 58µs/call
sub Exporter::Tiny::CORE:sort; # opcode
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.