Profile of Sub/Exporter.pm

← Index
NYTProf Performance Profile «line view»
For t/optimization.t
Run on Thu Jan 8 22:47:42 2015
Reported on Thu Jan 8 22:48:06 2015

Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sub/Exporter.pm
Statements | Executed 264 statements in 3.00ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 705µs | 4.61ms | Sub::Exporter::::BEGIN@11Sub::Exporter::BEGIN@11
3 | 3 | 2 | 78µs | 758µs | Sub::Exporter::::__ANON__[:337]Sub::Exporter::__ANON__[:337]
4 | 2 | 1 | 76µs | 132µs | Sub::Exporter::::_expand_groupsSub::Exporter::_expand_groups (recurses: max depth 1, inclusive time 7µs)
2 | 1 | 1 | 66µs | 455µs | Sub::Exporter::::_rewrite_build_configSub::Exporter::_rewrite_build_config
3 | 1 | 1 | 61µs | 108µs | Sub::Exporter::::_collect_collectionsSub::Exporter::_collect_collections
3 | 1 | 1 | 59µs | 398µs | Sub::Exporter::::_do_importSub::Exporter::_do_import
1 | 1 | 1 | 42µs | 42µs | Data::DPath::::BEGIN@1 Data::DPath::BEGIN@1
1 | 1 | 1 | 27µs | 50µs | Sub::Exporter::::_expand_groupSub::Exporter::_expand_group
3 | 1 | 1 | 24µs | 111µs | Sub::Exporter::::default_installerSub::Exporter::default_installer
2 | 1 | 1 | 21µs | 227µs | Sub::Exporter::::default_generatorSub::Exporter::default_generator
1 | 1 | 1 | 20µs | 28µs | Sub::Exporter::::__ANON__[:159]Sub::Exporter::__ANON__[:159]
3 | 1 | 1 | 19µs | 19µs | Sub::Exporter::::_mk_collection_builderSub::Exporter::_mk_collection_builder
2 | 2 | 1 | 16µs | 472µs | Sub::Exporter::::build_exporterSub::Exporter::build_exporter
4 | 2 | 1 | 16µs | 16µs | Sub::Exporter::::_group_nameSub::Exporter::_group_name
1 | 1 | 1 | 15µs | 352µs | Sub::Exporter::::setup_exporterSub::Exporter::setup_exporter
2 | 1 | 1 | 14µs | 14µs | Sub::Exporter::::_key_intersectionSub::Exporter::_key_intersection
1 | 1 | 1 | 14µs | 24µs | Sub::Exporter::::BEGIN@12Sub::Exporter::BEGIN@12
2 | 1 | 1 | 14µs | 17µs | Sub::Exporter::::_assert_collector_names_okSub::Exporter::_assert_collector_names_ok
1 | 1 | 1 | 12µs | 12µs | Sub::Exporter::::BEGIN@217Sub::Exporter::BEGIN@217
1 | 1 | 1 | 11µs | 20µs | Sub::Exporter::::BEGIN@13Sub::Exporter::BEGIN@13
1 | 1 | 1 | 10µs | 17µs | Data::DPath::::BEGIN@3 Data::DPath::BEGIN@3
1 | 1 | 1 | 9µs | 26µs | Data::DPath::::BEGIN@2 Data::DPath::BEGIN@2
1 | 1 | 1 | 7µs | 7µs | Sub::Exporter::::_setupSub::Exporter::_setup
1 | 1 | 1 | 6µs | 202µs | Sub::Exporter::::__ANON__[:460]Sub::Exporter::__ANON__[:460]
1 | 1 | 1 | 4µs | 4µs | Sub::Exporter::::BEGIN@10Sub::Exporter::BEGIN@10
1 | 1 | 1 | 3µs | 3µs | Sub::Exporter::::CORE:matchSub::Exporter::CORE:match (opcode)
0 | 0 | 0 | 0s | 0s | Sub::Exporter::::__ANON__[:354]Sub::Exporter::__ANON__[:354]
0 | 0 | 0 | 0s | 0s | Sub::Exporter::::default_exporterSub::Exporter::default_exporter

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 | 2 | 81µs | 1 | 42µs | # spent 42µs within Data::DPath::BEGIN@1 which was called: # once (42µs+0s) by Data::DPath::BEGIN@42 at line 1 use 5.006; # spent 42µs making 1 call to Data::DPath::BEGIN@1
2 | 2 | 29µs | 2 | 42µs | # spent 26µs (9+16) within Data::DPath::BEGIN@2 which was called: # once (9µs+16µs) by Data::DPath::BEGIN@42 at line 2 use strict; # spent 26µs making 1 call to Data::DPath::BEGIN@2 # spent 16µs making 1 call to strict::import
3 | 2 | 45µs | 2 | 23µs | # spent 17µs (10+6) within Data::DPath::BEGIN@3 which was called: # once (10µs+6µs) by Data::DPath::BEGIN@42 at line 3 use warnings; # spent 17µs making 1 call to Data::DPath::BEGIN@3 # spent 6µs making 1 call to warnings::import
4 |  |  |  |  | package Sub::Exporter;
5 |  |  |  |  | {
6 | 2 | 1µs |  |  | $Sub::Exporter::VERSION = '0.985';
7 |  |  |  |  | }
8 |  |  |  |  | # ABSTRACT: a sophisticated exporter for custom-built routines
9 |  |  |  |  |
10 | 2 | 28µs | 1 | 4µs | # spent 4µs within Sub::Exporter::BEGIN@10 which was called: # once (4µs+0s) by Data::DPath::BEGIN@42 at line 10 use Carp (); # spent 4µs making 1 call to Sub::Exporter::BEGIN@10
11 | 3 | 138µs | 2 | 4.63ms | # spent 4.61ms (705µs+3.91) within Sub::Exporter::BEGIN@11 which was called: # once (705µs+3.91ms) by Data::DPath::BEGIN@42 at line 11 use Data::OptList 0.100 (); # spent 4.61ms making 1 call to Sub::Exporter::BEGIN@11 # spent 13µs making 1 call to UNIVERSAL::VERSION
12 | 3 | 44µs | 2 | 34µs | # spent 24µs (14+10) within Sub::Exporter::BEGIN@12 which was called: # once (14µs+10µs) by Data::DPath::BEGIN@42 at line 12 use Params::Util 0.14 (); # _CODELIKE # spent 24µs making 1 call to Sub::Exporter::BEGIN@12 # spent 10µs making 1 call to UNIVERSAL::VERSION
13 | 3 | 991µs | 2 | 29µs | # spent 20µs (11+9) within Sub::Exporter::BEGIN@13 which was called: # once (11µs+9µs) by Data::DPath::BEGIN@42 at line 13 use Sub::Install 0.92 (); # spent 20µs making 1 call to Sub::Exporter::BEGIN@13 # spent 9µs making 1 call to UNIVERSAL::VERSION
14 |  |  |  |  |
15 |  |  |  |  |
16 |  |  |  |  | # Given a potential import name, this returns the group name -- if it's got a
17 |  |  |  |  | # group prefix.
18 |  |  |  |  | # spent 16µs within Sub::Exporter::_group_name which was called 4 times, avg 4µs/call: # 3 times (14µs+0s) by Sub::Exporter::_expand_groups at line 36, avg 5µs/call # once (2µs+0s) by Sub::Exporter::_expand_group at line 76 sub _group_name {
19 | 4 | 2µs |  |  | my ($name) = @_;
20 |  |  |  |  |
21 | 4 | 16µs |  |  | return if (index q{-:}, (substr $name, 0, 1)) == -1;
22 | 2 | 8µs |  |  | return substr $name, 1;
23 |  |  |  |  | }
24 |  |  |  |  |
25 |  |  |  |  | # \@groups is a canonicalized opt list of exports and groups this returns
26 |  |  |  |  | # another canonicalized opt list with groups replaced with relevant exports.
27 |  |  |  |  | # \%seen is groups we've already expanded and can ignore.
28 |  |  |  |  | # \%merge is merged options from the group we're descending through.
29 |  |  |  |  | # spent 132µs (76+56) within Sub::Exporter::_expand_groups which was called 4 times, avg 33µs/call: # 3 times (69µs+63µs) by Sub::Exporter::__ANON__[/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sub/Exporter.pm:337] at line 323, avg 44µs/call # once (7µs+-7µs) by Sub::Exporter::_expand_group at line 124 sub _expand_groups {
30 | 4 | 20µs |  |  | my ($class, $config, $groups, $collection, $seen, $merge) = @_;
31 | 4 | 2µs |  |  | $seen ||= {};
32 | 4 | 1µs |  |  | $merge ||= {};
33 | 4 | 3µs |  |  | my @groups = @$groups;
34 |  |  |  |  |
35 | 4 | 13µs |  |  | for my $i (reverse 0 .. $#groups) {
36 | 3 | 9µs | 3 | 14µs | if (my $group_name = _group_name($groups[$i][0])) { # spent 14µs making 3 calls to Sub::Exporter::_group_name, avg 5µs/call
37 | 1 | 1µs |  |  | my $seen = { %$seen }; # faux-dynamic scoping
38 |  |  |  |  |
39 | 1 | 3µs | 1 | 50µs | splice @groups, $i, 1, # spent 50µs making 1 call to Sub::Exporter::_expand_group
40 |  |  |  |  | _expand_group($class, $config, $groups[$i], $collection, $seen, $merge);
41 |  |  |  |  | } else {
42 |  |  |  |  | # there's nothing to munge in this export's args
43 | 2 | 4µs |  |  | next unless my %merge = %$merge;
44 |  |  |  |  |
45 |  |  |  |  | # we have things to merge in; do so
46 |  |  |  |  | my $prefix = (delete $merge{-prefix}) || '';
47 |  |  |  |  | my $suffix = (delete $merge{-suffix}) || '';
48 |  |  |  |  |
49 |  |  |  |  | if (
50 |  |  |  |  | Params::Util::_CODELIKE($groups[$i][1]) ## no critic Private
51 |  |  |  |  | or
52 |  |  |  |  | Params::Util::_SCALAR0($groups[$i][1]) ## no critic Private
53 |  |  |  |  | ) {
54 |  |  |  |  | # this entry was build by a group generator
55 |  |  |  |  | $groups[$i][0] = $prefix . $groups[$i][0] . $suffix;
56 |  |  |  |  | } else {
57 |  |  |  |  | my $as
58 |  |  |  |  | = ref $groups[$i][1]{-as} ? $groups[$i][1]{-as}
59 |  |  |  |  | : $groups[$i][1]{-as} ? $prefix . $groups[$i][1]{-as} . $suffix
60 |  |  |  |  | : $prefix . $groups[$i][0] . $suffix;
61 |  |  |  |  |
62 |  |  |  |  | $groups[$i][1] = { %{ $groups[$i][1] }, %merge, -as => $as };
63 |  |  |  |  | }
64 |  |  |  |  | }
65 |  |  |  |  | }
66 |  |  |  |  |
67 | 4 | 18µs |  |  | return \@groups;
68 |  |  |  |  | }
69 |  |  |  |  |
70 |  |  |  |  | # \@group is a name/value pair from an opt list.
71 |  |  |  |  | # spent 50µs (27+23) within Sub::Exporter::_expand_group which was called: # once (27µs+23µs) by Sub::Exporter::_expand_groups at line 39 sub _expand_group {
72 | 1 | 1µs |  |  | my ($class, $config, $group, $collection, $seen, $merge) = @_;
73 | 1 | 200ns |  |  | $merge ||= {};
74 |  |  |  |  |
75 | 1 | 600ns |  |  | my ($group_name, $group_arg) = @$group;
76 | 1 | 1µs | 1 | 2µs | $group_name = _group_name($group_name); # spent 2µs making 1 call to Sub::Exporter::_group_name
77 |  |  |  |  |
78 | 1 | 800ns |  |  | Carp::croak qq(group "$group_name" is not exported by the $class module)
79 |  |  |  |  | unless exists $config->{groups}{$group_name};
80 |  |  |  |  |
81 | 1 | 1µs |  |  | return if $seen->{$group_name}++;
82 |  |  |  |  |
83 | 1 | 200ns |  |  | if (ref $group_arg) {
84 |  |  |  |  | my $prefix = (delete $merge->{-prefix}||'') . ($group_arg->{-prefix}||'');
85 |  |  |  |  | my $suffix = ($group_arg->{-suffix}||'') . (delete $merge->{-suffix}||'');
86 |  |  |  |  | $merge = {
87 |  |  |  |  | %$merge,
88 |  |  |  |  | %$group_arg,
89 |  |  |  |  | ($prefix ? (-prefix => $prefix) : ()),
90 |  |  |  |  | ($suffix ? (-suffix => $suffix) : ()),
91 |  |  |  |  | };
92 |  |  |  |  | }
93 |  |  |  |  |
94 | 1 | 700ns |  |  | my $exports = $config->{groups}{$group_name};
95 |  |  |  |  |
96 | 1 | 8µs | 2 | 2µs | if ( # spent 1µs making 1 call to Params::Util::_CODELIKE # spent 700ns making 1 call to Params::Util::_SCALAR0
97 |  |  |  |  | Params::Util::_CODELIKE($exports) ## no critic Private
98 |  |  |  |  | or
99 |  |  |  |  | Params::Util::_SCALAR0($exports) ## no critic Private
100 |  |  |  |  | ) {
101 |  |  |  |  | # I'm not very happy with this code for hiding -prefix and -suffix, but
102 |  |  |  |  | # it's needed, and I'm not sure, offhand, how to make it better.
103 |  |  |  |  | # -- rjbs, 2006-12-05
104 |  |  |  |  | my $group_arg = $merge ? { %$merge } : {};
105 |  |  |  |  | delete $group_arg->{-prefix};
106 |  |  |  |  | delete $group_arg->{-suffix};
107 |  |  |  |  |
108 |  |  |  |  | my $group = Params::Util::_CODELIKE($exports) ## no critic Private
109 |  |  |  |  | ? $exports->($class, $group_name, $group_arg, $collection)
110 |  |  |  |  | : $class->$$exports($group_name, $group_arg, $collection);
111 |  |  |  |  |
112 |  |  |  |  | Carp::croak qq(group generator "$group_name" did not return a hashref)
113 |  |  |  |  | if ref $group ne 'HASH';
114 |  |  |  |  |
115 |  |  |  |  | my $stuff = [ map { [ $_ => $group->{$_} ] } keys %$group ];
116 |  |  |  |  | return @{
117 |  |  |  |  | _expand_groups($class, $config, $stuff, $collection, $seen, $merge)
118 |  |  |  |  | };
119 |  |  |  |  | } else {
120 | 1 | 2µs | 1 | 12µs | $exports # spent 12µs making 1 call to Data::OptList::mkopt
121 |  |  |  |  | = Data::OptList::mkopt($exports, "$group_name exports");
122 |  |  |  |  |
123 |  |  |  |  | return @{
124 | 1 | 8µs | 1 | 0s | _expand_groups($class, $config, $exports, $collection, $seen, $merge) # spent 7µs making 1 call to Sub::Exporter::_expand_groups, recursion: max depth 1, sum of overlapping time 7µs
125 |  |  |  |  | };
126 |  |  |  |  | }
127 |  |  |  |  | }
128 |  |  |  |  |
129 |  |  |  |  | # spent 19µs within Sub::Exporter::_mk_collection_builder which was called 3 times, avg 6µs/call: # 3 times (19µs+0s) by Sub::Exporter::_collect_collections at line 175, avg 6µs/call sub _mk_collection_builder {
130 | 3 | 1µs |  |  | my ($col, $etc) = @_;
131 | 3 | 2µs |  |  | my ($config, $import_args, $class, $into) = @$etc;
132 |  |  |  |  |
133 | 3 | 400ns |  |  | my %seen;
134 |  |  |  |  | # spent 28µs (20+8) within Sub::Exporter::__ANON__[/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sub/Exporter.pm:159] which was called: # once (20µs+8µs) by Sub::Exporter::_collect_collections at line 177 sub {
135 | 1 | 400ns |  |  | my ($collection) = @_;
136 | 1 | 600ns |  |  | my ($name, $value) = @$collection;
137 |  |  |  |  |
138 | 1 | 900ns |  |  | Carp::croak "collection $name provided multiple times in import"
139 |  |  |  |  | if $seen{ $name }++;
140 |  |  |  |  |
141 | 1 | 1µs |  |  | if (ref(my $hook = $config->{collectors}{$name})) {
142 | 1 | 2µs |  |  | my $arg = {
143 |  |  |  |  | name => $name,
144 |  |  |  |  | config => $config,
145 |  |  |  |  | import_args => $import_args,
146 |  |  |  |  | class => $class,
147 |  |  |  |  | into => $into,
148 |  |  |  |  | };
149 |  |  |  |  |
150 | 1 | 1µs |  |  | my $error_msg = "collection $name failed validation";
151 | 1 | 8µs | 1 | 1µs | if (Params::Util::_SCALAR0($hook)) { ## no critic Private # spent 1µs making 1 call to Params::Util::_SCALAR0
152 |  |  |  |  | Carp::croak $error_msg unless $class->$$hook($value, $arg);
153 |  |  |  |  | } else {
154 | 1 | 2µs | 1 | 7µs | Carp::croak $error_msg unless $hook->($value, $arg); # spent 7µs making 1 call to Sub::Exporter::_setup
155 |  |  |  |  | }
156 |  |  |  |  | }
157 |  |  |  |  |
158 | 1 | 4µs |  |  | $col->{ $name } = $value;
159 |  |  |  |  | }
160 | 3 | 21µs |  |  | }
161 |  |  |  |  |
162 |  |  |  |  | # Given a config and pre-canonicalized importer args, remove collections from
163 |  |  |  |  | # the args and return them.
164 |  |  |  |  | # spent 108µs (61+47) within Sub::Exporter::_collect_collections which was called 3 times, avg 36µs/call: # 3 times (61µs+47µs) by Sub::Exporter::__ANON__[/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sub/Exporter.pm:337] at line 321, avg 36µs/call sub _collect_collections {
165 | 3 | 3µs |  |  | my ($config, $import_args, $class, $into) = @_;
166 |  |  |  |  |
167 |  |  |  |  | my @collections
168 |  |  |  |  | = map { splice @$import_args, $_, 1 }
169 | 3 | 13µs |  |  | grep { exists $config->{collectors}{ $import_args->[$_][0] } }
170 |  |  |  |  | reverse 0 .. $#$import_args;
171 |  |  |  |  |
172 | 3 | 2µs |  |  | unshift @collections, [ INIT => {} ] if $config->{collectors}{INIT};
173 |  |  |  |  |
174 | 3 | 1µs |  |  | my $col = {};
175 | 3 | 6µs | 3 | 19µs | my $builder = _mk_collection_builder($col, \@_); # spent 19µs making 3 calls to Sub::Exporter::_mk_collection_builder, avg 6µs/call
176 | 3 | 3µs |  |  | for my $collection (@collections) {
177 | 1 | 2µs | 1 | 28µs | $builder->($collection) # spent 28µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:159]
178 |  |  |  |  | }
179 |  |  |  |  |
180 | 3 | 29µs |  |  | return $col;
181 |  |  |  |  | }
182 |  |  |  |  |
183 |  |  |  |  |
184 |  |  |  |  | # spent 352µs (15+337) within Sub::Exporter::setup_exporter which was called: # once (15µs+337µs) by Data::DPath::BEGIN@42 at line 461 sub setup_exporter {
185 | 1 | 800ns |  |  | my ($config) = @_;
186 |  |  |  |  |
187 | 1 | 600ns |  |  | Carp::croak 'into and into_level may not both be supplied to exporter'
188 |  |  |  |  | if exists $config->{into} and exists $config->{into_level};
189 |  |  |  |  |
190 | 1 | 1µs |  |  | my $as = delete $config->{as} || 'import';
191 | 1 | 1µs |  |  | my $into
192 |  |  |  |  | = exists $config->{into} ? delete $config->{into}
193 |  |  |  |  | : exists $config->{into_level} ? caller(delete $config->{into_level})
194 |  |  |  |  | : caller(0);
195 |  |  |  |  |
196 | 1 | 1µs | 1 | 276µs | my $import = build_exporter($config); # spent 276µs making 1 call to Sub::Exporter::build_exporter
197 |  |  |  |  |
198 | 1 | 6µs | 1 | 62µs | Sub::Install::reinstall_sub({ # spent 62µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:132]
199 |  |  |  |  | code => $import,
200 |  |  |  |  | into => $into,
201 |  |  |  |  | as => $as,
202 |  |  |  |  | });
203 |  |  |  |  | }
204 |  |  |  |  |
205 |  |  |  |  |
206 |  |  |  |  | # spent 14µs within Sub::Exporter::_key_intersection which was called 2 times, avg 7µs/call: # 2 times (14µs+0s) by Sub::Exporter::_rewrite_build_config at line 262, avg 7µs/call sub _key_intersection {
207 | 2 | 1µs |  |  | my ($x, $y) = @_;
208 | 2 | 8µs |  |  | my %seen = map { $_ => 1 } keys %$x;
209 | 2 | 9µs |  |  | my @names = grep { $seen{$_} } keys %$y;
210 |  |  |  |  | }
211 |  |  |  |  |
212 |  |  |  |  | # Given the config passed to setup_exporter, which contains sugary opt list
213 |  |  |  |  | # data, rewrite the opt lists into hashes, catch a few kinds of invalid
214 |  |  |  |  | # configurations, and set up defaults. Since the config is a reference, it's
215 |  |  |  |  | # rewritten in place.
216 | 1 | 300ns |  |  | my %valid_config_key;
217 |  |  |  |  | # spent 12µs within Sub::Exporter::BEGIN@217 which was called: # once (12µs+0s) by Data::DPath::BEGIN@42 at line 222 BEGIN {
218 |  |  |  |  | %valid_config_key =
219 | 1 | 16µs |  |  | map { $_ => 1 }
220 |  |  |  |  | qw(as collectors installer generator exports groups into into_level),
221 |  |  |  |  | qw(exporter), # deprecated
222 | 1 | 1.08ms | 1 | 12µs | } # spent 12µs making 1 call to Sub::Exporter::BEGIN@217
223 |  |  |  |  |
224 |  |  |  |  | # spent 17µs (14+3) within Sub::Exporter::_assert_collector_names_ok which was called 2 times, avg 8µs/call: # 2 times (14µs+3µs) by Sub::Exporter::_rewrite_build_config at line 260, avg 8µs/call sub _assert_collector_names_ok {
225 | 2 | 900ns |  |  | my ($collectors) = @_;
226 |  |  |  |  |
227 | 3 | 19µs | 1 | 3µs | for my $reserved_name (grep { /\A[_A-Z]+\z/ } keys %$collectors) { # spent 3µs making 1 call to Sub::Exporter::CORE:match
228 |  |  |  |  | Carp::croak "unknown reserved collector name: $reserved_name"
229 |  |  |  |  | if $reserved_name ne 'INIT';
230 |  |  |  |  | }
231 |  |  |  |  | }
232 |  |  |  |  |
233 |  |  |  |  | # spent 455µs (66+389) within Sub::Exporter::_rewrite_build_config which was called 2 times, avg 228µs/call: # 2 times (66µs+389µs) by Sub::Exporter::build_exporter at line 290, avg 228µs/call sub _rewrite_build_config {
234 | 2 | 500ns |  |  | my ($config) = @_;
235 |  |  |  |  |
236 | 2 | 7µs |  |  | if (my @keys = grep { not exists $valid_config_key{$_} } keys %$config) {
237 |  |  |  |  | Carp::croak "unknown options (@keys) passed to Sub::Exporter";
238 |  |  |  |  | }
239 |  |  |  |  |
240 | 2 | 800ns |  |  | Carp::croak q(into and into_level may not both be supplied to exporter)
241 |  |  |  |  | if exists $config->{into} and exists $config->{into_level};
242 |  |  |  |  |
243 |  |  |  |  | # XXX: Remove after deprecation period.
244 | 2 | 800ns |  |  | if ($config->{exporter}) {
245 |  |  |  |  | Carp::cluck "'exporter' argument to build_exporter is deprecated. Use 'installer' instead; the semantics are identical.";
246 |  |  |  |  | $config->{installer} = delete $config->{exporter};
247 |  |  |  |  | }
248 |  |  |  |  |
249 | 2 | 400ns |  |  | Carp::croak q(into and into_level may not both be supplied to exporter)
250 |  |  |  |  | if exists $config->{into} and exists $config->{into_level};
251 |  |  |  |  |
252 | 2 | 2µs |  |  | for (qw(exports collectors)) {
253 | 4 | 16µs | 4 | 246µs | $config->{$_} = Data::OptList::mkopt_hash( # spent 246µs making 4 calls to Data::OptList::mkopt_hash, avg 62µs/call
254 |  |  |  |  | $config->{$_},
255 |  |  |  |  | $_,
256 |  |  |  |  | [ 'CODE', 'SCALAR' ],
257 |  |  |  |  | );
258 |  |  |  |  | }
259 |  |  |  |  |
260 | 2 | 4µs | 2 | 17µs | _assert_collector_names_ok($config->{collectors}); # spent 17µs making 2 calls to Sub::Exporter::_assert_collector_names_ok, avg 8µs/call
261 |  |  |  |  |
262 | 2 | 5µs | 2 | 14µs | if (my @names = _key_intersection(@$config{qw(exports collectors)})) { # spent 14µs making 2 calls to Sub::Exporter::_key_intersection, avg 7µs/call
263 |  |  |  |  | Carp::croak "names (@names) used in both collections and exports";
264 |  |  |  |  | }
265 |  |  |  |  |
266 | 2 | 7µs | 2 | 112µs | $config->{groups} = Data::OptList::mkopt_hash( # spent 112µs making 2 calls to Data::OptList::mkopt_hash, avg 56µs/call
267 |  |  |  |  | $config->{groups},
268 |  |  |  |  | 'groups',
269 |  |  |  |  | [
270 |  |  |  |  | 'HASH', # standard opt list
271 |  |  |  |  | 'ARRAY', # standard opt list
272 |  |  |  |  | 'CODE', # group generator
273 |  |  |  |  | 'SCALAR', # name of group generation method
274 |  |  |  |  | ]
275 |  |  |  |  | );
276 |  |  |  |  |
277 |  |  |  |  | # by default, export nothing
278 | 2 | 2µs |  |  | $config->{groups}{default} ||= [];
279 |  |  |  |  |
280 |  |  |  |  | # by default, build an all-inclusive 'all' group
281 | 2 | 700ns |  |  | $config->{groups}{all} ||= [ keys %{ $config->{exports} } ];
282 |  |  |  |  |
283 | 2 | 1µs |  |  | $config->{generator} ||= \&default_generator;
284 | 2 | 7µs |  |  | $config->{installer} ||= \&default_installer;
285 |  |  |  |  | }
286 |  |  |  |  |
287 |  |  |  |  | # spent 472µs (16+455) within Sub::Exporter::build_exporter which was called 2 times, avg 236µs/call: # once (10µs+266µs) by Sub::Exporter::setup_exporter at line 196 # once (6µs+190µs) by Sub::Exporter::__ANON__[/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sub/Exporter.pm:460] at line 460 sub build_exporter {
288 | 2 | 800ns |  |  | my ($config) = @_;
289 |  |  |  |  |
290 | 2 | 2µs | 2 | 455µs | _rewrite_build_config($config); # spent 455µs making 2 calls to Sub::Exporter::_rewrite_build_config, avg 228µs/call
291 |  |  |  |  |
292 |  |  |  |  | # spent 758µs (78+680) within Sub::Exporter::__ANON__[/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sub/Exporter.pm:337] which was called 3 times, avg 253µs/call: # once (28µs+436µs) by Data::DPath::BEGIN@42 at line 42 of lib/Data/DPath.pm # once (24µs+131µs) by main::BEGIN@8 at line 8 of t/optimization.t # once (26µs+113µs) by main::BEGIN@21 at line 21 of t/optimization.t my $import = sub {
293 | 3 | 2µs |  |  | my ($class) = shift;
294 |  |  |  |  |
295 |  |  |  |  | # XXX: clean this up -- rjbs, 2006-03-16
296 | 3 | 2µs |  |  | my $special = (ref $_[0]) ? shift(@_) : {};
297 | 3 | 2µs |  |  | Carp::croak q(into and into_level may not both be supplied to exporter)
298 |  |  |  |  | if exists $special->{into} and exists $special->{into_level};
299 |  |  |  |  |
300 | 3 | 1µs |  |  | if ($special->{exporter}) {
301 |  |  |  |  | Carp::cluck "'exporter' special import argument is deprecated. Use 'installer' instead; the semantics are identical.";
302 |  |  |  |  | $special->{installer} = delete $special->{exporter};
303 |  |  |  |  | }
304 |  |  |  |  |
305 | 3 | 5µs |  |  | my $into
306 |  |  |  |  | = defined $special->{into} ? delete $special->{into}
307 |  |  |  |  | : defined $special->{into_level} ? caller(delete $special->{into_level})
308 |  |  |  |  | : defined $config->{into} ? $config->{into}
309 |  |  |  |  | : defined $config->{into_level} ? caller($config->{into_level})
310 |  |  |  |  | : caller(0);
311 |  |  |  |  |
312 | 3 | 2µs |  |  | my $generator = delete $special->{generator} || $config->{generator};
313 | 3 | 1µs |  |  | my $installer = delete $special->{installer} || $config->{installer};
314 |  |  |  |  |
315 |  |  |  |  | # this builds a AOA, where the inner arrays are [ name => value_ref ]
316 | 3 | 7µs | 3 | 42µs | my $import_args = Data::OptList::mkopt([ @_ ]); # spent 42µs making 3 calls to Data::OptList::mkopt, avg 14µs/call
317 |  |  |  |  |
318 |  |  |  |  | # is this right? defaults first or collectors first? -- rjbs, 2006-06-24
319 | 3 | 3µs |  |  | $import_args = [ [ -default => undef ] ] unless @$import_args;
320 |  |  |  |  |
321 | 3 | 5µs | 3 | 108µs | my $collection = _collect_collections($config, $import_args, $class, $into); # spent 108µs making 3 calls to Sub::Exporter::_collect_collections, avg 36µs/call
322 |  |  |  |  |
323 | 3 | 5µs | 3 | 132µs | my $to_import = _expand_groups($class, $config, $import_args, $collection); # spent 132µs making 3 calls to Sub::Exporter::_expand_groups, avg 44µs/call
324 |  |  |  |  |
325 |  |  |  |  | # now, finally $import_arg is really the "to do" list
326 | 3 | 24µs | 3 | 398µs | _do_import( # spent 398µs making 3 calls to Sub::Exporter::_do_import, avg 133µs/call
327 |  |  |  |  | {
328 |  |  |  |  | class => $class,
329 |  |  |  |  | col => $collection,
330 |  |  |  |  | config => $config,
331 |  |  |  |  | into => $into,
332 |  |  |  |  | generator => $generator,
333 |  |  |  |  | installer => $installer,
334 |  |  |  |  | },
335 |  |  |  |  | $to_import,
336 |  |  |  |  | );
337 | 2 | 8µs |  |  | };
338 |  |  |  |  |
339 | 2 | 8µs |  |  | return $import;
340 |  |  |  |  | }
341 |  |  |  |  |
342 |  |  |  |  | # spent 398µs (59+339) within Sub::Exporter::_do_import which was called 3 times, avg 133µs/call: # 3 times (59µs+339µs) by Sub::Exporter::__ANON__[/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sub/Exporter.pm:337] at line 326, avg 133µs/call sub _do_import {
343 | 3 | 1µs |  |  | my ($arg, $to_import) = @_;
344 |  |  |  |  |
345 | 3 | 600ns |  |  | my @todo;
346 |  |  |  |  |
347 | 3 | 3µs |  |  | for my $pair (@$to_import) {
348 | 2 | 1µs |  |  | my ($name, $import_arg) = @$pair;
349 |  |  |  |  |
350 | 2 | 500ns |  |  | my ($generator, $as);
351 |  |  |  |  |
352 | 2 | 5µs | 1 | 1µs | if ($import_arg and Params::Util::_CODELIKE($import_arg)) { ## no critic # spent 1µs making 1 call to Params::Util::_CODELIKE
353 |  |  |  |  | # This is the case when a group generator has inserted name/code pairs.
354 |  |  |  |  | $generator = sub { $import_arg };
355 |  |  |  |  | $as = $name;
356 |  |  |  |  | } else {
357 | 2 | 4µs |  |  | $import_arg = { $import_arg ? %$import_arg : () };
358 |  |  |  |  |
359 | 2 | 2µs |  |  | Carp::croak qq("$name" is not exported by the $arg->{class} module)
360 |  |  |  |  | unless exists $arg->{config}{exports}{$name};
361 |  |  |  |  |
362 | 2 | 1µs |  |  | $generator = $arg->{config}{exports}{$name};
363 |  |  |  |  |
364 | 2 | 4µs |  |  | $as = exists $import_arg->{-as} ? (delete $import_arg->{-as}) : $name;
365 |  |  |  |  | }
366 |  |  |  |  |
367 | 2 | 9µs | 2 | 227µs | my $code = $arg->{generator}->( # spent 227µs making 2 calls to Sub::Exporter::default_generator, avg 114µs/call
368 |  |  |  |  | {
369 |  |  |  |  | class => $arg->{class},
370 |  |  |  |  | name => $name,
371 |  |  |  |  | arg => $import_arg,
372 |  |  |  |  | col => $arg->{col},
373 |  |  |  |  | generator => $generator,
374 |  |  |  |  | }
375 |  |  |  |  | );
376 |  |  |  |  |
377 | 2 | 4µs |  |  | push @todo, $as, $code;
378 |  |  |  |  | }
379 |  |  |  |  |
380 | 3 | 17µs | 3 | 111µs | $arg->{installer}->( # spent 111µs making 3 calls to Sub::Exporter::default_installer, avg 37µs/call
381 |  |  |  |  | {
382 |  |  |  |  | class => $arg->{class},
383 |  |  |  |  | into => $arg->{into},
384 |  |  |  |  | col => $arg->{col},
385 |  |  |  |  | },
386 |  |  |  |  | \@todo,
387 |  |  |  |  | );
388 |  |  |  |  | }
389 |  |  |  |  |
390 |  |  |  |  | ## Cute idea, possibly for future use: also supply an "unimport" for:
391 |  |  |  |  | ## no Module::Whatever qw(arg arg arg);
392 |  |  |  |  | # sub _unexport {
393 |  |  |  |  | # my (undef, undef, undef, undef, undef, $as, $into) = @_;
394 |  |  |  |  | #
395 |  |  |  |  | # if (ref $as eq 'SCALAR') {
396 |  |  |  |  | # undef $$as;
397 |  |  |  |  | # } elsif (ref $as) {
398 |  |  |  |  | # Carp::croak "invalid reference type for $as: " . ref $as;
399 |  |  |  |  | # } else {
400 |  |  |  |  | # no strict 'refs';
401 |  |  |  |  | # delete &{$into . '::' . $as};
402 |  |  |  |  | # }
403 |  |  |  |  | # }
404 |  |  |  |  |
405 |  |  |  |  |
406 |  |  |  |  | # spent 227µs (21+206) within Sub::Exporter::default_generator which was called 2 times, avg 114µs/call: # 2 times (21µs+206µs) by Sub::Exporter::_do_import at line 367, avg 114µs/call sub default_generator {
407 | 2 | 800ns |  |  | my ($arg) = @_;
408 | 2 | 3µs |  |  | my ($class, $name, $generator) = @$arg{qw(class name generator)};
409 |  |  |  |  |
410 | 2 | 500ns |  |  | if (not defined $generator) {
411 |  |  |  |  | my $code = $class->can($name)
412 |  |  |  |  | or Carp::croak "can't locate exported subroutine $name via $class";
413 |  |  |  |  | return $code;
414 |  |  |  |  | }
415 |  |  |  |  |
416 |  |  |  |  | # I considered making this "$class->$generator(" but it seems that
417 |  |  |  |  | # overloading precedence would turn an overloaded-as-code generator object
418 |  |  |  |  | # into a string before code. -- rjbs, 2006-06-11
419 | 2 | 22µs | 4 | 206µs | return $generator->($class, $name, $arg->{arg}, $arg->{col}) # spent 202µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:460] # spent 3µs making 1 call to Data::DPath::build_dpath # spent 2µs making 2 calls to Params::Util::_CODELIKE, avg 750ns/call
420 |  |  |  |  | if Params::Util::_CODELIKE($generator); ## no critic Private
421 |  |  |  |  |
422 |  |  |  |  | # This "must" be a scalar reference, to a generator method name.
423 |  |  |  |  | # -- rjbs, 2006-12-05
424 |  |  |  |  | return $class->$$generator($name, $arg->{arg}, $arg->{col});
425 |  |  |  |  | }
426 |  |  |  |  |
427 |  |  |  |  |
428 |  |  |  |  | # spent 111µs (24+87) within Sub::Exporter::default_installer which was called 3 times, avg 37µs/call: # 3 times (24µs+87µs) by Sub::Exporter::_do_import at line 380, avg 37µs/call sub default_installer {
429 | 3 | 2µs |  |  | my ($arg, $to_export) = @_;
430 |  |  |  |  |
431 | 3 | 13µs |  |  | for (my $i = 0; $i < @$to_export; $i += 2) {
432 | 2 | 3µs |  |  | my ($as, $code) = @$to_export[ $i, $i+1 ];
433 |  |  |  |  |
434 |  |  |  |  | # Allow as isa ARRAY to push onto an array?
435 |  |  |  |  | # Allow into isa HASH to install name=>code into hash?
436 |  |  |  |  |
437 | 2 | 1µs |  |  | if (ref $as eq 'SCALAR') {
438 |  |  |  |  | $$as = $code;
439 |  |  |  |  | } elsif (ref $as) {
440 |  |  |  |  | Carp::croak "invalid reference type for $as: " . ref $as;
441 |  |  |  |  | } else {
442 | 2 | 5µs | 2 | 87µs | Sub::Install::reinstall_sub({ # spent 87µs making 2 calls to Sub::Install::__ANON__[Sub/Install.pm:132], avg 44µs/call
443 |  |  |  |  | code => $code,
444 |  |  |  |  | into => $arg->{into},
445 |  |  |  |  | as => $as
446 |  |  |  |  | });
447 |  |  |  |  | }
448 |  |  |  |  | }
449 |  |  |  |  | }
450 |  |  |  |  |
451 |  |  |  |  | sub default_exporter {
452 |  |  |  |  | Carp::cluck "default_exporter is deprecated; call default_installer instead; the semantics are identical";
453 |  |  |  |  | goto &default_installer;
454 |  |  |  |  | }
455 |  |  |  |  |
456 |  |  |  |  |
457 |  |  |  |  | setup_exporter({
458 |  |  |  |  | exports => [
459 |  |  |  |  | qw(setup_exporter build_exporter),
460 | 1 | 5µs | 1 | 196µs | # spent 202µs (6+196) within Sub::Exporter::__ANON__[/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sub/Exporter.pm:460] which was called: # once (6µs+196µs) by Sub::Exporter::default_generator at line 419 _import => sub { build_exporter($_[2]) }, # spent 196µs making 1 call to Sub::Exporter::build_exporter
461 | 1 | 11µs | 1 | 352µs | ], # spent 352µs making 1 call to Sub::Exporter::setup_exporter
462 |  |  |  |  | groups => {
463 |  |  |  |  | all => [ qw(setup_exporter build_export) ],
464 |  |  |  |  | },
465 |  |  |  |  | collectors => { -setup => \&_setup },
466 |  |  |  |  | });
467 |  |  |  |  |
468 |  |  |  |  | # spent 7µs within Sub::Exporter::_setup which was called: # once (7µs+0s) by Sub::Exporter::__ANON__[/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sub/Exporter.pm:159] at line 154 sub _setup {
469 | 1 | 600ns |  |  | my ($value, $arg) = @_;
470 |  |  |  |  |
471 | 1 | 700ns |  |  | if (ref $value eq 'HASH') {
472 | 1 | 4µs |  |  | push @{ $arg->{import_args} }, [ _import => { -as => 'import', %$value } ];
473 | 1 | 4µs |  |  | return 1;
474 |  |  |  |  | } elsif (ref $value eq 'ARRAY') {
475 |  |  |  |  | push @{ $arg->{import_args} },
476 |  |  |  |  | [ _import => { -as => 'import', exports => $value } ];
477 |  |  |  |  | return 1;
478 |  |  |  |  | }
479 |  |  |  |  | return;
480 |  |  |  |  | }
481 |  |  |  |  |
- - |  |  |  |  |
484 | 1 | 7µs |  |  | "jn8:32"; # <-- magic true value
485 |  |  |  |  |
486 |  |  |  |  | __END__
|  |  |  |  | # spent 3µs within Sub::Exporter::CORE:match which was called: # once (3µs+0s) by Sub::Exporter::_assert_collector_names_ok at line 227 sub Sub::Exporter::CORE:match; # opcode