← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Thu Dec 15 15:23:56 2022
Reported on Thu Dec 15 15:27:02 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Exporter/Tiny.pm
StatementsExecuted 2319 statements in 7.11ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
59211.34ms1.34msExporter::Tiny::::CORE:regcompExporter::Tiny::CORE:regcomp (opcode)
1311634µs634µsExporter::Tiny::::CORE:sortExporter::Tiny::CORE:sort (opcode)
1311522µs2.48msExporter::Tiny::::_exporter_permitted_regexpExporter::Tiny::_exporter_permitted_regexp
131312483µs5.96msExporter::Tiny::::importExporter::Tiny::import
4622467µs679µsExporter::Tiny::::_exporter_expand_subExporter::Tiny::_exporter_expand_sub
4622397µs411µsExporter::Tiny::::_exporter_install_subExporter::Tiny::_exporter_install_sub
1311296µs368µsExporter::Tiny::::__ANON__[:52]Exporter::Tiny::__ANON__[:52]
37241156µs156µsExporter::Tiny::::CORE:matchExporter::Tiny::CORE:match (opcode)
111124µs124µsExporter::Tiny::::BEGIN@11Exporter::Tiny::BEGIN@11
1311122µs122µsExporter::Tiny::::mkoptExporter::Tiny::mkopt
11131µs31µsExporter::Tiny::::BEGIN@3Exporter::Tiny::BEGIN@3
131126µs26µsExporter::Tiny::::CORE:qrExporter::Tiny::CORE:qr (opcode)
132213µs13µsExporter::Tiny::::_exporter_validate_optsExporter::Tiny::_exporter_validate_opts
1117µs10µsExporter::Tiny::::BEGIN@4Exporter::Tiny::BEGIN@4
1117µs14µsExporter::Tiny::::BEGIN@69Exporter::Tiny::BEGIN@69
1116µs16µsExporter::Tiny::::BEGIN@137Exporter::Tiny::BEGIN@137
1116µs37µsExporter::Tiny::::BEGIN@5Exporter::Tiny::BEGIN@5
1116µs6µsExporter::Tiny::::_exporter_expand_tagExporter::Tiny::_exporter_expand_tag
1115µs17µsExporter::Tiny::::BEGIN@382Exporter::Tiny::BEGIN@382
1115µs8µsExporter::Tiny::::BEGIN@396Exporter::Tiny::BEGIN@396
1114µs8µsExporter::Tiny::::BEGIN@190Exporter::Tiny::BEGIN@190
1114µs6µsExporter::Tiny::::BEGIN@217Exporter::Tiny::BEGIN@217
1114µs8µsExporter::Tiny::::BEGIN@347Exporter::Tiny::BEGIN@347
1114µs21µsExporter::Tiny::::BEGIN@5.25Exporter::Tiny::BEGIN@5.25
1113µs5µsExporter::Tiny::::BEGIN@236Exporter::Tiny::BEGIN@236
1113µs5µsExporter::Tiny::::BEGIN@253Exporter::Tiny::BEGIN@253
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
3240µs131µs
# spent 31µs within Exporter::Tiny::BEGIN@3 which was called: # once (31µs+0s) by List::MoreUtils::BEGIN@24 at line 3
use 5.006001;
# spent 31µs making 1 call to Exporter::Tiny::BEGIN@3
4219µs213µs
# spent 10µs (7+3) within Exporter::Tiny::BEGIN@4 which was called: # once (7µs+3µs) by List::MoreUtils::BEGIN@24 at line 4
use strict;
# spent 10µs making 1 call to Exporter::Tiny::BEGIN@4 # spent 3µs making 1 call to strict::import
54120µs4106µs
# spent 37µs (6+31) within Exporter::Tiny::BEGIN@5 which was called: # once (6µs+31µs) by List::MoreUtils::BEGIN@24 at line 5 # spent 21µs (4+17) within Exporter::Tiny::BEGIN@5.25 which was called: # once (4µs+17µs) by List::MoreUtils::BEGIN@24 at line 5
use warnings; no warnings qw(void once uninitialized numeric redefine);
# spent 37µs making 1 call to Exporter::Tiny::BEGIN@5 # spent 31µs making 1 call to warnings::import # spent 21µs making 1 call to Exporter::Tiny::BEGIN@5.25 # spent 17µs making 1 call to warnings::unimport
6
711µsour $AUTHORITY = 'cpan:TOBYINK';
810sour $VERSION = '1.006000';
911µsour @EXPORT_OK = qw< mkopt mkopt_hash _croak _carp >;
10
11
# spent 124µs within Exporter::Tiny::BEGIN@11 which was called: # once (124µs+0s) by List::MoreUtils::BEGIN@24 at line 18
BEGIN {
12 *_HAS_NATIVE_LEXICAL_SUB = ( $] ge '5.037002' )
13 ? sub () { !!1 }
1411µs : sub () { !!0 };
15 *_HAS_MODULE_LEXICAL_SUB = ( $] ge '5.011002' and eval('require Lexical::Sub') )
16 ? sub () { !!1 }
17115µs : sub () { !!0 };
# spent 110µs executing statements in string eval
181304µs1124µs};
# spent 124µ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 368µs (296+72) within Exporter::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Exporter/Tiny.pm:52] which was called 13 times, avg 28µs/call: # 13 times (296µs+72µs) by Exporter::Tiny::import at line 71, avg 28µs/call
{
25136µs my $class = shift;
26138µs my ($global_opts, $opts, $want, $not_want) = @_;
27
281327µs while (@$opts)
29 {
30477µs my $opt = shift @{$opts};
314717µ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}) ?
4447297µs23572µs (++$not_want->{$1}) :
# spent 66µs making 234 calls to Exporter::Tiny::CORE:match, avg 282ns/call # spent 6µ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 }
5213µs};
53
54sub import
55
# spent 5.96ms (483µs+5.47) within Exporter::Tiny::import which was called 13 times, avg 458µs/call: # once (87µs+1.32ms) by JSON::Schema::Modern::BEGIN@31 at line 31 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern.pm # once (46µs+958µs) by JSON::Schema::Modern::Document::BEGIN@24 at line 24 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Document.pm # once (53µs+642µs) by JSON::Schema::Modern::Error::BEGIN@20 at line 20 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Error.pm # once (45µs+462µs) by JSON::Schema::Modern::Document::OpenAPI::BEGIN@26 at line 26 of JSON/Schema/Modern/Document/OpenAPI.pm # once (44µs+398µs) by JSON::Schema::Modern::Result::BEGIN@18 at line 18 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Result.pm # once (31µs+314µs) by Data::Perl::Role::Collection::Array::BEGIN@9 at line 9 of Data/Perl/Role/Collection/Array.pm # once (25µs+299µs) by JSON::Schema::Modern::Annotation::BEGIN@19 at line 19 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Annotation.pm # once (27µs+282µs) by OpenAPI::Modern::BEGIN@31 at line 31 of OpenAPI/Modern.pm # once (19µs+257µs) by File::ShareDir::BEGIN@1 at line 1 of (eval 29)[File/ShareDir.pm:430] # once (43µs+228µs) by Eval::TypeTiny::import at line 89 of Eval/TypeTiny.pm # once (20µs+131µs) by Types::Standard::BEGIN@23 at line 23 of Types/Standard.pm # once (21µs+103µs) by JSON::Schema::Modern::BEGIN@27 at line 430 of File/ShareDir.pm # once (22µs+80µs) by Types::Standard::BEGIN@19 at line 19 of Types/Standard.pm
{
56134µs my $class = shift;
571316µs my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () };
58
59137µs if ( defined $global_opts->{into} and $global_opts->{into} eq '-lexical' ) {
60 $global_opts->{lexical} = 1;
61 delete $global_opts->{into};
62 }
631315µs if ( not defined $global_opts->{into} ) {
64 $global_opts->{into} = caller;
65 }
66
67134µs my @want;
68138µs my %not_want; $global_opts->{not} = \%not_want;
6928326µs221µs
# spent 14µs (7+7) within Exporter::Tiny::BEGIN@69 which was called: # once (7µs+7µs) by List::MoreUtils::BEGIN@24 at line 69
my @args = do { no strict qw(refs); @_ ? @_ : @{"$class\::EXPORT"} };
# spent 14µs making 1 call to Exporter::Tiny::BEGIN@69 # spent 7µs making 1 call to strict::unimport
701327µs13122µs my $opts = mkopt(\@args);
# spent 122µs making 13 calls to Exporter::Tiny::mkopt, avg 9µs/call
711326µs13368µs $class->$_process_optlist($global_opts, $opts, \@want, \%not_want);
# spent 368µs making 13 calls to Exporter::Tiny::__ANON__[Exporter/Tiny.pm:52], avg 28µs/call
72
73 $global_opts->{installer} ||= $class->_exporter_lexical_installer( $global_opts )
74138µs if $global_opts->{lexical};
75
761330µs132.48ms my $permitted = $class->_exporter_permitted_regexp($global_opts);
# spent 2.48ms making 13 calls to Exporter::Tiny::_exporter_permitted_regexp, avg 191µs/call
771330µs1384µs $class->_exporter_validate_opts($global_opts);
# spent 79µs making 8 calls to Type::Library::_exporter_validate_opts, avg 10µs/call # spent 5µs making 5 calls to Exporter::Tiny::_exporter_validate_opts, avg 1µs/call
78
7913126µs for my $wanted (@want) {
804614µs next if $not_want{$wanted->[0]};
81
824665µs461.43ms my %symbols = $class->_exporter_expand_sub(@$wanted, $global_opts, $permitted);
# spent 1.33ms making 40 calls to Type::Library::_exporter_expand_sub, avg 33µs/call # spent 101µs making 6 calls to Exporter::Tiny::_exporter_expand_sub, avg 17µs/call
83 $class->_exporter_install_sub($_, $wanted->[1], $global_opts, $symbols{$_})
844673µs46992µs for keys %symbols;
# spent 918µs making 40 calls to Type::Library::_exporter_install_sub, avg 23µs/call # spent 74µs making 6 calls to Exporter::Tiny::_exporter_install_sub, avg 12µ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] };
1372219µs226µs
# spent 16µs (6+10) within Exporter::Tiny::BEGIN@137 which was called: # once (6µs+10µs) by List::MoreUtils::BEGIN@24 at line 137
no warnings ( $] ge '5.037002' ? 'experimental::builtin' : () );
# spent 16µs making 1 call to Exporter::Tiny::BEGIN@137 # spent 10µ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#
1531323µs
# spent 13µs within Exporter::Tiny::_exporter_validate_opts which was called 13 times, avg 1µs/call: # 8 times (8µs+0s) by Type::Library::_exporter_validate_opts at line 36 of Type/Library.pm, avg 1µs/call # 5 times (5µ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 6µs within Exporter::Tiny::_exporter_expand_tag which was called: # once (6µs+0s) by Exporter::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Exporter/Tiny.pm:52] at line 44
{
190296µs212µs
# spent 8µs (4+4) within Exporter::Tiny::BEGIN@190 which was called: # once (4µs+4µs) by List::MoreUtils::BEGIN@24 at line 190
no strict qw(refs);
# spent 8µs making 1 call to Exporter::Tiny::BEGIN@190 # spent 4µs making 1 call to strict::unimport
191
19210s my $class = shift;
19311µs my ($name, $value, $globals) = @_;
19412µs my $tags = \%{"$class\::EXPORT_TAGS"};
195
196 return $class->_exporter_merge_opts($value, $globals, $tags->{$name}->($class, @_))
19710s if ref($tags->{$name}) eq q(CODE);
198
199 return $class->_exporter_merge_opts($value, $globals, @{$tags->{$name}})
20011µs if exists $tags->{$name};
201
20210s return $class->_exporter_merge_opts($value, $globals, @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"})
203 if $name eq 'all';
204
20510s return $class->_exporter_merge_opts($value, $globals, @{"$class\::EXPORT"})
206 if $name eq 'default';
207
20811µs $globals->{$name} = $value || 1;
20913µ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{
217271µs28µs
# spent 6µs (4+2) within Exporter::Tiny::BEGIN@217 which was called: # once (4µs+2µs) by List::MoreUtils::BEGIN@24 at line 217
no strict qw(refs);
# spent 6µs making 1 call to Exporter::Tiny::BEGIN@217 # spent 2µ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 2.48ms (522µs+1.96) within Exporter::Tiny::_exporter_permitted_regexp which was called 13 times, avg 191µs/call: # 13 times (522µs+1.96ms) by Exporter::Tiny::import at line 76, avg 191µs/call
{
236284µs27µs
# spent 5µs (3+2) within Exporter::Tiny::BEGIN@236 which was called: # once (3µs+2µs) by List::MoreUtils::BEGIN@24 at line 236
no strict qw(refs);
# spent 5µs making 1 call to Exporter::Tiny::BEGIN@236 # spent 2µs making 1 call to strict::unimport
237131µs my $class = shift;
238 my $re = join "|", map quotemeta, sort {
239 length($b) <=> length($a) or $a cmp $b
240131.03ms13634µs } @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"};
# spent 634µs making 13 calls to Exporter::Tiny::CORE:sort, avg 49µs/call
241131.44ms261.32ms qr{^(?:$re)$}ms;
# spent 1.29ms making 13 calls to Exporter::Tiny::CORE:regcomp, avg 100µs/call # spent 26µ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 679µs (467+212) within Exporter::Tiny::_exporter_expand_sub which was called 46 times, avg 15µs/call: # 40 times (400µs+178µs) by Type::Library::_exporter_expand_sub at line 113 of Type/Library.pm, avg 14µs/call # 6 times (67µs+34µs) by Exporter::Tiny::import at line 82, avg 17µs/call
{
249464µs my $class = shift;
2504612µs my ($name, $value, $globals, $permitted) = @_;
251465µs $permitted ||= $class->_exporter_permitted_regexp($globals);
252
2532624µs27µs
# spent 5µs (3+2) within Exporter::Tiny::BEGIN@253 which was called: # once (3µs+2µs) by List::MoreUtils::BEGIN@24 at line 253
no strict qw(refs);
# spent 5µs making 1 call to Exporter::Tiny::BEGIN@253 # spent 2µs making 1 call to strict::unimport
254
255466µs my $sigil = "&";
2564654µs4613µs if ($name =~ /\A([&\$\%\@\*])(.+)\z/) {
# spent 13µs making 46 calls to Exporter::Tiny::CORE:match, avg 283ns/call
257 $sigil = $1;
258 $name = $2;
259 if ($sigil eq '*') {
260 _croak("Cannot export symbols with a * sigil");
261 }
262 }
2634613µs my $sigilname = $sigil eq '&' ? $name : "$sigil$name";
264
26546190µs92105µs if ($sigilname =~ $permitted)
# spent 63µs making 46 calls to Exporter::Tiny::CORE:match, avg 1µs/call # spent 42µs making 46 calls to Exporter::Tiny::CORE:regcomp, avg 913ns/call
266 {
267 my $generatorprefix = {
268 '&' => "_generate_",
269 '$' => "_generateScalar_",
270 '@' => "_generateArray_",
271 '%' => "_generateHash_",
2724671µs }->{$sigil};
273
27446184µs4664µs my $generator = $class->can("$generatorprefix$name");
# spent 64µs making 46 calls to UNIVERSAL::can, avg 1µs/call
275464µs return $sigilname => $class->$generator($sigilname, $value, $globals) if $generator;
276
2774612µs if ($sigil eq '&') {
2784679µs4630µs my $sub = $class->can($name);
# spent 30µs making 46 calls to UNIVERSAL::can, avg 652ns/call
2794692µ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 411µs (397+14) within Exporter::Tiny::_exporter_install_sub which was called 46 times, avg 9µs/call: # 40 times (324µs+13µs) by Type::Library::_exporter_install_sub at line 154 of Type/Library.pm, avg 8µs/call # 6 times (73µs+1000ns) by Exporter::Tiny::import at line 84, avg 12µs/call
{
307462µs my $class = shift;
3084615µs my ($name, $value, $globals, $sym) = @_;
3094617µs my $value_hash = ( ref($value) eq 'HASH' ) ? $value : {};
310
311467µ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
320466µs return unless defined $name;
321
322464µs my $sigil = "&";
3234610µs unless (ref($name)) {
3244652µs4614µs if ($name =~ /\A([&\$\%\@\*])(.+)\z/) {
# spent 14µs making 46 calls to Exporter::Tiny::CORE:match, avg 304ns/call
325 $sigil = $1;
326 $name = $2;
327 if ($sigil eq '*') {
328 _croak("Cannot export symbols with a * sigil");
329 }
330 }
3314631µs my ($prefix) = grep defined, $value_hash->{-prefix}, $globals->{prefix}, q();
3324621µs my ($suffix) = grep defined, $value_hash->{-suffix}, $globals->{suffix}, q();
3334624µs $name = "$prefix$name$suffix";
334 }
335
3364612µ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
344466µs return ($$name = $sym) if ref($name) eq q(SCALAR);
345465µs return ($into->{$sigilname} = $sym) if ref($into) eq q(HASH);
346
3472121µs212µs
# spent 8µs (4+4) within Exporter::Tiny::BEGIN@347 which was called: # once (4µs+4µs) by List::MoreUtils::BEGIN@24 at line 347
no strict qw(refs);
# spent 8µs making 1 call to Exporter::Tiny::BEGIN@347 # spent 4µs making 1 call to strict::unimport
348 our %TRACKED;
349
3504647µ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
3804620µs $TRACKED{$class}{$into}{$sigilname} = $sym;
381
382299µs229µs
# spent 17µs (5+12) within Exporter::Tiny::BEGIN@382 which was called: # once (5µs+12µs) by List::MoreUtils::BEGIN@24 at line 382
no warnings qw(prototype);
# spent 17µs making 1 call to Exporter::Tiny::BEGIN@382 # spent 12µs making 1 call to warnings::unimport
383 $installer
384 ? $installer->($globals, [$sigilname, $sym])
38546126µ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
3962333µs211µs
# spent 8µs (5+3) within Exporter::Tiny::BEGIN@396 which was called: # once (5µs+3µs) by List::MoreUtils::BEGIN@24 at line 396
no strict qw(refs);
# spent 8µs making 1 call to Exporter::Tiny::BEGIN@396 # spent 3µ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 122µs within Exporter::Tiny::mkopt which was called 13 times, avg 9µs/call: # 13 times (122µs+0s) by Exporter::Tiny::import at line 70, avg 9µs/call
{
432135µs my $in = shift or return [];
433138µs my @out;
434
435138µs $in = [map(($_ => ref($in->{$_}) ? $in->{$_} : ()), sort keys %$in)]
436 if ref($in) eq q(HASH);
437
4381328µs for (my $i = 0; $i < @$in; $i++)
439 {
440478µs my $k = $in->[$i];
441473µs my $v;
442
4434721µ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
4484721µs push @out, [ $k => $v ];
449 }
450
4511336µ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
46115µs1;
462
463__END__
 
# spent 156µs within Exporter::Tiny::CORE:match which was called 372 times, avg 419ns/call: # 234 times (66µs+0s) by Exporter::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Exporter/Tiny.pm:52] at line 44, avg 282ns/call # 46 times (63µs+0s) by Exporter::Tiny::_exporter_expand_sub at line 265, avg 1µs/call # 46 times (14µs+0s) by Exporter::Tiny::_exporter_install_sub at line 324, avg 304ns/call # 46 times (13µs+0s) by Exporter::Tiny::_exporter_expand_sub at line 256, avg 283ns/call
sub Exporter::Tiny::CORE:match; # opcode
# spent 26µs within Exporter::Tiny::CORE:qr which was called 13 times, avg 2µs/call: # 13 times (26µs+0s) by Exporter::Tiny::_exporter_permitted_regexp at line 241, avg 2µs/call
sub Exporter::Tiny::CORE:qr; # opcode
# spent 1.34ms within Exporter::Tiny::CORE:regcomp which was called 59 times, avg 23µs/call: # 46 times (42µs+0s) by Exporter::Tiny::_exporter_expand_sub at line 265, avg 913ns/call # 13 times (1.29ms+0s) by Exporter::Tiny::_exporter_permitted_regexp at line 241, avg 100µs/call
sub Exporter::Tiny::CORE:regcomp; # opcode
# spent 634µs within Exporter::Tiny::CORE:sort which was called 13 times, avg 49µs/call: # 13 times (634µs+0s) by Exporter::Tiny::_exporter_permitted_regexp at line 240, avg 49µ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.