Filename | /home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter.pm |
Statements | Executed 502 statements in 3.90ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
5 | 5 | 5 | 219µs | 2.63ms | __ANON__[:756] | Sub::Exporter::
4 | 1 | 1 | 213µs | 1.21ms | _rewrite_build_config | Sub::Exporter::
5 | 1 | 1 | 183µs | 1.62ms | _do_import | Sub::Exporter::
7 | 2 | 1 | 174µs | 351µs | _expand_groups (recurses: max depth 1, inclusive time 58µs) | Sub::Exporter::
5 | 1 | 1 | 151µs | 338µs | _collect_collections | Sub::Exporter::
5 | 1 | 1 | 100µs | 438µs | default_installer | Sub::Exporter::
3 | 1 | 1 | 95µs | 132µs | __ANON__[:544] | Sub::Exporter::
5 | 1 | 1 | 79µs | 995µs | default_generator | Sub::Exporter::
2 | 1 | 1 | 76µs | 196µs | _expand_group | Sub::Exporter::
4 | 2 | 1 | 55µs | 1.26ms | build_exporter | Sub::Exporter::
5 | 1 | 1 | 54µs | 54µs | _mk_collection_builder | Sub::Exporter::
9 | 2 | 1 | 51µs | 51µs | _group_name | Sub::Exporter::
4 | 1 | 1 | 48µs | 48µs | _key_intersection | Sub::Exporter::
1 | 1 | 1 | 33µs | 33µs | BEGIN@1 | Sub::Exporter::Util::
4 | 1 | 1 | 32µs | 36µs | _assert_collector_names_ok | Sub::Exporter::
3 | 1 | 1 | 32µs | 32µs | _setup | Sub::Exporter::
1 | 1 | 1 | 22µs | 490µs | setup_exporter | Sub::Exporter::
3 | 1 | 1 | 21µs | 896µs | __ANON__[:937] | Sub::Exporter::
1 | 1 | 1 | 15µs | 20µs | BEGIN@2 | Sub::Exporter::Util::
1 | 1 | 1 | 13µs | 13µs | BEGIN@636 | Sub::Exporter::
1 | 1 | 1 | 12µs | 22µs | BEGIN@3 | Sub::Exporter::Util::
1 | 1 | 1 | 11µs | 22µs | BEGIN@9 | Sub::Exporter::
1 | 1 | 1 | 6µs | 6µs | BEGIN@7 | Sub::Exporter::
1 | 1 | 1 | 6µs | 6µs | BEGIN@6 | Sub::Exporter::
1 | 1 | 1 | 6µs | 6µs | BEGIN@8 | Sub::Exporter::
1 | 1 | 1 | 4µs | 4µs | CORE:match (opcode) | Sub::Exporter::
0 | 0 | 0 | 0s | 0s | __ANON__[:773] | Sub::Exporter::
0 | 0 | 0 | 0s | 0s | default_exporter | Sub::Exporter::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | 2 | 38µs | 1 | 33µs | # spent 33µs within Sub::Exporter::Util::BEGIN@1 which was called:
# once (33µs+0s) by Sub::Exporter::Util::BEGIN@332 at line 1 # spent 33µs making 1 call to Sub::Exporter::Util::BEGIN@1 |
2 | 2 | 29µs | 2 | 25µs | # spent 20µs (15+5) within Sub::Exporter::Util::BEGIN@2 which was called:
# once (15µs+5µs) by Sub::Exporter::Util::BEGIN@332 at line 2 # spent 20µs making 1 call to Sub::Exporter::Util::BEGIN@2
# spent 5µs making 1 call to strict::import |
3 | 2 | 29µs | 2 | 32µs | # spent 22µs (12+10) within Sub::Exporter::Util::BEGIN@3 which was called:
# once (12µs+10µs) by Sub::Exporter::Util::BEGIN@332 at line 3 # spent 22µs making 1 call to Sub::Exporter::Util::BEGIN@3
# spent 10µs making 1 call to warnings::import |
4 | package Sub::Exporter; | ||||
5 | |||||
6 | 2 | 22µs | 1 | 6µs | # spent 6µs within Sub::Exporter::BEGIN@6 which was called:
# once (6µs+0s) by Sub::Exporter::Util::BEGIN@332 at line 6 # spent 6µs making 1 call to Sub::Exporter::BEGIN@6 |
7 | 2 | 26µs | 1 | 6µs | # spent 6µs within Sub::Exporter::BEGIN@7 which was called:
# once (6µs+0s) by Sub::Exporter::Util::BEGIN@332 at line 7 # spent 6µs making 1 call to Sub::Exporter::BEGIN@7 |
8 | 2 | 23µs | 1 | 6µs | # spent 6µs within Sub::Exporter::BEGIN@8 which was called:
# once (6µs+0s) by Sub::Exporter::Util::BEGIN@332 at line 8 # spent 6µs making 1 call to Sub::Exporter::BEGIN@8 |
9 | 3 | 1.07ms | 2 | 33µs | # spent 22µs (11+11) within Sub::Exporter::BEGIN@9 which was called:
# once (11µs+11µs) by Sub::Exporter::Util::BEGIN@332 at line 9 # spent 22µs making 1 call to Sub::Exporter::BEGIN@9
# spent 11µs making 1 call to UNIVERSAL::VERSION |
10 | |||||
11 | =head1 NAME | ||||
12 | |||||
13 | Sub::Exporter - a sophisticated exporter for custom-built routines | ||||
14 | |||||
15 | =head1 VERSION | ||||
16 | |||||
17 | version 0.982 | ||||
18 | |||||
19 | =cut | ||||
20 | |||||
21 | 1 | 1µs | our $VERSION = '0.982'; | ||
22 | |||||
23 | =head1 SYNOPSIS | ||||
24 | |||||
25 | Sub::Exporter must be used in two places. First, in an exporting module: | ||||
26 | |||||
27 | # in the exporting module: | ||||
28 | package Text::Tweaker; | ||||
29 | use Sub::Exporter -setup => { | ||||
30 | exports => [ | ||||
31 | qw(squish titlecase), # always works the same way | ||||
32 | reformat => \&build_reformatter, # generator to build exported function | ||||
33 | trim => \&build_trimmer, | ||||
34 | indent => \&build_indenter, | ||||
35 | ], | ||||
36 | collectors => [ 'defaults' ], | ||||
37 | }; | ||||
38 | |||||
39 | Then, in an importing module: | ||||
40 | |||||
41 | # in the importing module: | ||||
42 | use Text::Tweaker | ||||
43 | 'squish', | ||||
44 | indent => { margin => 5 }, | ||||
45 | reformat => { width => 79, justify => 'full', -as => 'prettify_text' }, | ||||
46 | defaults => { eol => 'CRLF' }; | ||||
47 | |||||
48 | With this setup, the importing module ends up with three routines: C<squish>, | ||||
49 | C<indent>, and C<prettify_text>. The latter two have been built to the | ||||
50 | specifications of the importer -- they are not just copies of the code in the | ||||
51 | exporting package. | ||||
52 | |||||
53 | =head1 DESCRIPTION | ||||
54 | |||||
55 | B<ACHTUNG!> If you're not familiar with Exporter or exporting, read | ||||
56 | L<Sub::Exporter::Tutorial> first! | ||||
57 | |||||
58 | =head2 Why Generators? | ||||
59 | |||||
60 | The biggest benefit of Sub::Exporter over existing exporters (including the | ||||
61 | ubiquitous Exporter.pm) is its ability to build new coderefs for export, rather | ||||
62 | than to simply export code identical to that found in the exporting package. | ||||
63 | |||||
64 | If your module's consumers get a routine that works like this: | ||||
65 | |||||
66 | use Data::Analyze qw(analyze); | ||||
67 | my $value = analyze($data, $tolerance, $passes); | ||||
68 | |||||
69 | and they constantly pass only one or two different set of values for the | ||||
70 | non-C<$data> arguments, your code can benefit from Sub::Exporter. By writing a | ||||
71 | simple generator, you can let them do this, instead: | ||||
72 | |||||
73 | use Data::Analyze | ||||
74 | analyze => { tolerance => 0.10, passes => 10, -as => analyze10 }, | ||||
75 | analyze => { tolerance => 0.15, passes => 50, -as => analyze50 }; | ||||
76 | |||||
77 | my $value = analyze10($data); | ||||
78 | |||||
79 | The generator for that would look something like this: | ||||
80 | |||||
81 | sub build_analyzer { | ||||
82 | my ($class, $name, $arg) = @_; | ||||
83 | |||||
84 | return sub { | ||||
85 | my $data = shift; | ||||
86 | my $tolerance = shift || $arg->{tolerance}; | ||||
87 | my $passes = shift || $arg->{passes}; | ||||
88 | |||||
89 | analyze($data, $tolerance, $passes); | ||||
90 | } | ||||
91 | } | ||||
92 | |||||
93 | Your module's user now has to do less work to benefit from it -- and remember, | ||||
94 | you're often your own user! Investing in customized subroutines is an | ||||
95 | investment in future laziness. | ||||
96 | |||||
97 | This also avoids a common form of ugliness seen in many modules: package-level | ||||
98 | configuration. That is, you might have seen something like the above | ||||
99 | implemented like so: | ||||
100 | |||||
101 | use Data::Analyze qw(analyze); | ||||
102 | $Data::Analyze::default_tolerance = 0.10; | ||||
103 | $Data::Analyze::default_passes = 10; | ||||
104 | |||||
105 | This might save time, until you have multiple modules using Data::Analyze. | ||||
106 | Because there is only one global configuration, they step on each other's toes | ||||
107 | and your code begins to have mysterious errors. | ||||
108 | |||||
109 | Generators can also allow you to export class methods to be called as | ||||
110 | subroutines: | ||||
111 | |||||
112 | package Data::Methodical; | ||||
113 | use Sub::Exporter -setup => { exports => { some_method => \&_curry_class } }; | ||||
114 | |||||
115 | sub _curry_class { | ||||
116 | my ($class, $name) = @_; | ||||
117 | sub { $class->$name(@_); }; | ||||
118 | } | ||||
119 | |||||
120 | Because of the way that exporters and Sub::Exporter work, any package that | ||||
121 | inherits from Data::Methodical can inherit its exporter and override its | ||||
122 | C<some_method>. If a user imports C<some_method> from that package, he'll | ||||
123 | receive a subroutine that calls the method on the subclass, rather than on | ||||
124 | Data::Methodical itself. | ||||
125 | |||||
126 | =head2 Other Customizations | ||||
127 | |||||
128 | Building custom routines with generators isn't the only way that Sub::Exporters | ||||
129 | allows the importing code to refine its use of the exported routines. They may | ||||
130 | also be renamed to avoid naming collisions. | ||||
131 | |||||
132 | Consider the following code: | ||||
133 | |||||
134 | # this program determines to which circle of Hell you will be condemned | ||||
135 | use Morality qw(sin virtue); # for calculating viciousness | ||||
136 | use Math::Trig qw(:all); # for dealing with circles | ||||
137 | |||||
138 | The programmer has inadvertantly imported two C<sin> routines. The solution, | ||||
139 | in Exporter.pm-based modules, would be to import only one and then call the | ||||
140 | other by its fully-qualified name. Alternately, the importer could write a | ||||
141 | routine that did so, or could mess about with typeglobs. | ||||
142 | |||||
143 | How much easier to write: | ||||
144 | |||||
145 | # this program determines to which circle of Hell you will be condemned | ||||
146 | use Morality qw(virtue), sin => { -as => 'offense' }; | ||||
147 | use Math::Trig -all => { -prefix => 'trig_' }; | ||||
148 | |||||
149 | and to have at one's disposal C<offense> and C<trig_sin> -- not to mention | ||||
150 | C<trig_cos> and C<trig_tan>. | ||||
151 | |||||
152 | =head1 EXPORTER CONFIGURATION | ||||
153 | |||||
154 | You can configure an exporter for your package by using Sub::Exporter like so: | ||||
155 | |||||
156 | package Tools; | ||||
157 | use Sub::Exporter | ||||
158 | -setup => { exports => [ qw(function1 function2 function3) ] }; | ||||
159 | |||||
160 | This is the simplest way to use the exporter, and is basically equivalent to | ||||
161 | this: | ||||
162 | |||||
163 | package Tools; | ||||
164 | use base qw(Exporter); | ||||
165 | our @EXPORT_OK = qw(function1 function2 function2); | ||||
166 | |||||
167 | Any basic use of Sub::Exporter will look like this: | ||||
168 | |||||
169 | package Tools; | ||||
170 | use Sub::Exporter -setup => \%config; | ||||
171 | |||||
172 | The following keys are valid in C<%config>: | ||||
173 | |||||
174 | exports - a list of routines to provide for exporting; each routine may be | ||||
175 | followed by generator | ||||
176 | groups - a list of groups to provide for exporting; each must be followed by | ||||
177 | either (a) a list of exports, possibly with arguments for each | ||||
178 | export, or (b) a generator | ||||
179 | |||||
180 | collectors - a list of names into which values are collected for use in | ||||
181 | routine generation; each name may be followed by a validator | ||||
182 | |||||
183 | In addition to the basic options above, a few more advanced options may be | ||||
184 | passed: | ||||
185 | |||||
186 | into_level - how far up the caller stack to look for a target (default 0) | ||||
187 | into - an explicit target (package) into which to export routines | ||||
188 | |||||
189 | In other words: Sub::Exporter installs a C<import> routine which, when called, | ||||
190 | exports routines to the calling namespace. The C<into> and C<into_level> | ||||
191 | options change where those exported routines are installed. | ||||
192 | |||||
193 | generator - a callback used to produce the code that will be installed | ||||
194 | default: Sub::Exporter::default_generator | ||||
195 | |||||
196 | installer - a callback used to install the code produced by the generator | ||||
197 | default: Sub::Exporter::default_installer | ||||
198 | |||||
199 | For information on how these callbacks are used, see the documentation for | ||||
200 | C<L</default_generator>> and C<L</default_installer>>. | ||||
201 | |||||
202 | =head2 Export Configuration | ||||
203 | |||||
204 | The C<exports> list may be provided as an array reference or a hash reference. | ||||
205 | The list is processed in such a way that the following are equivalent: | ||||
206 | |||||
207 | { exports => [ qw(foo bar baz), quux => \&quux_generator ] } | ||||
208 | |||||
209 | { exports => | ||||
210 | { foo => undef, bar => undef, baz => undef, quux => \&quux_generator } } | ||||
211 | |||||
212 | Generators are code that return coderefs. They are called with four | ||||
213 | parameters: | ||||
214 | |||||
215 | $class - the class whose exporter has been called (the exporting class) | ||||
216 | $name - the name of the export for which the routine is being build | ||||
217 | \%arg - the arguments passed for this export | ||||
218 | \%col - the collections for this import | ||||
219 | |||||
220 | Given the configuration in the L</SYNOPSIS>, the following C<use> statement: | ||||
221 | |||||
222 | use Text::Tweaker | ||||
223 | reformat => { -as => 'make_narrow', width => 33 }, | ||||
224 | defaults => { eol => 'CR' }; | ||||
225 | |||||
226 | would result in the following call to C<&build_reformatter>: | ||||
227 | |||||
228 | my $code = build_reformatter( | ||||
229 | 'Text::Tweaker', | ||||
230 | 'reformat', | ||||
231 | { width => 33 }, # note that -as is not passed in | ||||
232 | { defaults => { eol => 'CR' } }, | ||||
233 | ); | ||||
234 | |||||
235 | The returned coderef (C<$code>) would then be installed as C<make_narrow> in the | ||||
236 | calling package. | ||||
237 | |||||
238 | Instead of providing a coderef in the configuration, a reference to a method | ||||
239 | name may be provided. This method will then be called on the invocant of the | ||||
240 | C<import> method. (In this case, we do not pass the C<$class> parameter, as it | ||||
241 | would be redundant.) | ||||
242 | |||||
243 | =head2 Group Configuration | ||||
244 | |||||
245 | The C<groups> list can be passed in the same forms as C<exports>. Groups must | ||||
246 | have values to be meaningful, which may either list exports that make up the | ||||
247 | group (optionally with arguments) or may provide a way to build the group. | ||||
248 | |||||
249 | The simpler case is the first: a group definition is a list of exports. Here's | ||||
250 | the example that could go in exporter in the L</SYNOPSIS>. | ||||
251 | |||||
252 | groups => { | ||||
253 | default => [ qw(reformat) ], | ||||
254 | shorteners => [ qw(squish trim) ], | ||||
255 | email_safe => [ | ||||
256 | 'indent', | ||||
257 | reformat => { -as => 'email_format', width => 72 } | ||||
258 | ], | ||||
259 | }, | ||||
260 | |||||
261 | Groups are imported by specifying their name prefixed be either a dash or a | ||||
262 | colon. This line of code would import the C<shorteners> group: | ||||
263 | |||||
264 | use Text::Tweaker qw(-shorteners); | ||||
265 | |||||
266 | Arguments passed to a group when importing are merged into the groups options | ||||
267 | and passed to any relevant generators. Groups can contain other groups, but | ||||
268 | looping group structures are ignored. | ||||
269 | |||||
270 | The other possible value for a group definition, a coderef, allows one | ||||
271 | generator to build several exportable routines simultaneously. This is useful | ||||
272 | when many routines must share enclosed lexical variables. The coderef must | ||||
273 | return a hash reference. The keys will be used as export names and the values | ||||
274 | are the subs that will be exported. | ||||
275 | |||||
276 | This example shows a simple use of the group generator. | ||||
277 | |||||
278 | package Data::Crypto; | ||||
279 | use Sub::Exporter -setup => { groups => { cipher => \&build_cipher_group } }; | ||||
280 | |||||
281 | sub build_cipher_group { | ||||
282 | my ($class, $group, $arg) = @_; | ||||
283 | my ($encode, $decode) = build_codec($arg->{secret}); | ||||
284 | return { cipher => $encode, decipher => $decode }; | ||||
285 | } | ||||
286 | |||||
287 | The C<cipher> and C<decipher> routines are built in a group because they are | ||||
288 | built together by code which encloses their secret in their environment. | ||||
289 | |||||
290 | =head3 Default Groups | ||||
291 | |||||
292 | If a module that uses Sub::Exporter is C<use>d with no arguments, it will try | ||||
293 | to export the group named C<default>. If that group has not been specifically | ||||
294 | configured, it will be empty, and nothing will happen. | ||||
295 | |||||
296 | Another group is also created if not defined: C<all>. The C<all> group | ||||
297 | contains all the exports from the exports list. | ||||
298 | |||||
299 | =head2 Collector Configuration | ||||
300 | |||||
301 | The C<collectors> entry in the exporter configuration gives names which, when | ||||
302 | found in the import call, have their values collected and passed to every | ||||
303 | generator. | ||||
304 | |||||
305 | For example, the C<build_analyzer> generator that we saw above could be | ||||
306 | rewritten as: | ||||
307 | |||||
308 | sub build_analyzer { | ||||
309 | my ($class, $name, $arg, $col) = @_; | ||||
310 | |||||
311 | return sub { | ||||
312 | my $data = shift; | ||||
313 | my $tolerance = shift || $arg->{tolerance} || $col->{defaults}{tolerance}; | ||||
314 | my $passes = shift || $arg->{passes} || $col->{defaults}{passes}; | ||||
315 | |||||
316 | analyze($data, $tolerance, $passes); | ||||
317 | } | ||||
318 | } | ||||
319 | |||||
320 | That would allow the import to specify global defaults for his imports: | ||||
321 | |||||
322 | use Data::Analyze | ||||
323 | 'analyze', | ||||
324 | analyze => { tolerance => 0.10, -as => analyze10 }, | ||||
325 | analyze => { tolerance => 0.15, passes => 50, -as => analyze50 }, | ||||
326 | defaults => { passes => 10 }; | ||||
327 | |||||
328 | my $A = analyze10($data); # equivalent to analyze($data, 0.10, 10); | ||||
329 | my $C = analyze50($data); # equivalent to analyze($data, 0.15, 10); | ||||
330 | my $B = analyze($data, 0.20); # equivalent to analyze($data, 0.20, 10); | ||||
331 | |||||
332 | If values are provided in the C<collectors> list during exporter setup, they | ||||
333 | must be code references, and are used to validate the importer's values. The | ||||
334 | validator is called when the collection is found, and if it returns false, an | ||||
335 | exception is thrown. We could ensure that no one tries to set a global data | ||||
336 | default easily: | ||||
337 | |||||
338 | collectors => { defaults => sub { return (exists $_[0]->{data}) ? 0 : 1 } } | ||||
339 | |||||
340 | Collector coderefs can also be used as hooks to perform arbitrary actions | ||||
341 | before anything is exported. | ||||
342 | |||||
343 | When the coderef is called, it is passed the value of the collection and a | ||||
344 | hashref containing the following entries: | ||||
345 | |||||
346 | name - the name of the collector | ||||
347 | config - the exporter configuration (hashref) | ||||
348 | import_args - the arguments passed to the exporter, sans collections (aref) | ||||
349 | class - the package on which the importer was called | ||||
350 | into - the package into which exports will be exported | ||||
351 | |||||
352 | Collectors with all-caps names (that is, made up of underscore or capital A | ||||
353 | through Z) are reserved for special use. The only currently implemented | ||||
354 | special collector is C<INIT>, whose hook (if present in the exporter | ||||
355 | configuration) is always run before any other hook. | ||||
356 | |||||
357 | =head1 CALLING THE EXPORTER | ||||
358 | |||||
359 | Arguments to the exporter (that is, the arguments after the module name in a | ||||
360 | C<use> statement) are parsed as follows: | ||||
361 | |||||
362 | First, the collectors gather any collections found in the arguments. Any | ||||
363 | reference type may be given as the value for a collector. For each collection | ||||
364 | given in the arguments, its validator (if any) is called. | ||||
365 | |||||
366 | Next, groups are expanded. If the group is implemented by a group generator, | ||||
367 | the generator is called. There are two special arguments which, if given to a | ||||
368 | group, have special meaning: | ||||
369 | |||||
370 | -prefix - a string to prepend to any export imported from this group | ||||
371 | -suffix - a string to append to any export imported from this group | ||||
372 | |||||
373 | Finally, individual export generators are called and all subs, generated or | ||||
374 | otherwise, are installed in the calling package. There is only one special | ||||
375 | argument for export generators: | ||||
376 | |||||
377 | -as - where to install the exported sub | ||||
378 | |||||
379 | Normally, C<-as> will contain an alternate name for the routine. It may, | ||||
380 | however, contain a reference to a scalar. If that is the case, a reference the | ||||
381 | generated routine will be placed in the scalar referenced by C<-as>. It will | ||||
382 | not be installed into the calling package. | ||||
383 | |||||
384 | =head2 Special Exporter Arguments | ||||
385 | |||||
386 | The generated exporter accept some special options, which may be passed as the | ||||
387 | first argument, in a hashref. | ||||
388 | |||||
389 | These options are: | ||||
390 | |||||
391 | into_level | ||||
392 | into | ||||
393 | generator | ||||
394 | installer | ||||
395 | |||||
396 | These override the same-named configuration options described in L</EXPORTER | ||||
397 | CONFIGURATION>. | ||||
398 | |||||
399 | =cut | ||||
400 | |||||
401 | # Given a potential import name, this returns the group name -- if it's got a | ||||
402 | # group prefix. | ||||
403 | sub _group_name { | ||||
404 | 22 | 64µs | my ($name) = @_; | ||
405 | |||||
406 | return if (index q{-:}, (substr $name, 0, 1)) == -1; | ||||
407 | return substr $name, 1; | ||||
408 | } | ||||
409 | |||||
410 | # \@groups is a canonicalized opt list of exports and groups this returns | ||||
411 | # another canonicalized opt list with groups replaced with relevant exports. | ||||
412 | # \%seen is groups we've already expanded and can ignore. | ||||
413 | # \%merge is merged options from the group we're descending through. | ||||
414 | # spent 351µs (174+177) within Sub::Exporter::_expand_groups which was called 7 times, avg 50µs/call:
# 5 times (125µs+226µs) by Sub::Exporter::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter.pm:756] at line 742, avg 70µs/call
# 2 times (49µs+-49µs) by Sub::Exporter::_expand_group at line 509, avg 0s/call | ||||
415 | 58 | 168µs | my ($class, $config, $groups, $collection, $seen, $merge) = @_; | ||
416 | $seen ||= {}; | ||||
417 | $merge ||= {}; | ||||
418 | my @groups = @$groups; | ||||
419 | |||||
420 | for my $i (reverse 0 .. $#groups) { | ||||
421 | 7 | 38µs | if (my $group_name = _group_name($groups[$i][0])) { # spent 38µs making 7 calls to Sub::Exporter::_group_name, avg 5µs/call | ||
422 | my $seen = { %$seen }; # faux-dynamic scoping | ||||
423 | |||||
424 | 2 | 196µs | splice @groups, $i, 1, # spent 196µs making 2 calls to Sub::Exporter::_expand_group, avg 98µs/call | ||
425 | _expand_group($class, $config, $groups[$i], $collection, $seen, $merge); | ||||
426 | } else { | ||||
427 | # there's nothing to munge in this export's args | ||||
428 | next unless my %merge = %$merge; | ||||
429 | |||||
430 | # we have things to merge in; do so | ||||
431 | my $prefix = (delete $merge{-prefix}) || ''; | ||||
432 | my $suffix = (delete $merge{-suffix}) || ''; | ||||
433 | |||||
434 | if ( | ||||
435 | Params::Util::_CODELIKE($groups[$i][1]) ## no critic Private | ||||
436 | or | ||||
437 | Params::Util::_SCALAR0($groups[$i][1]) ## no critic Private | ||||
438 | ) { | ||||
439 | # this entry was build by a group generator | ||||
440 | $groups[$i][0] = $prefix . $groups[$i][0] . $suffix; | ||||
441 | } else { | ||||
442 | my $as | ||||
443 | = ref $groups[$i][1]{-as} ? $groups[$i][1]{-as} | ||||
444 | : $groups[$i][1]{-as} ? $prefix . $groups[$i][1]{-as} . $suffix | ||||
445 | : $prefix . $groups[$i][0] . $suffix; | ||||
446 | |||||
447 | $groups[$i][1] = { %{ $groups[$i][1] }, %merge, -as => $as }; | ||||
448 | } | ||||
449 | } | ||||
450 | } | ||||
451 | |||||
452 | return \@groups; | ||||
453 | } | ||||
454 | |||||
455 | # \@group is a name/value pair from an opt list. | ||||
456 | # spent 196µs (76+120) within Sub::Exporter::_expand_group which was called 2 times, avg 98µs/call:
# 2 times (76µs+120µs) by Sub::Exporter::_expand_groups at line 424, avg 98µs/call | ||||
457 | 22 | 76µs | my ($class, $config, $group, $collection, $seen, $merge) = @_; | ||
458 | $merge ||= {}; | ||||
459 | |||||
460 | my ($group_name, $group_arg) = @$group; | ||||
461 | 2 | 13µs | $group_name = _group_name($group_name); # spent 13µs making 2 calls to Sub::Exporter::_group_name, avg 6µs/call | ||
462 | |||||
463 | Carp::croak qq(group "$group_name" is not exported by the $class module) | ||||
464 | unless exists $config->{groups}{$group_name}; | ||||
465 | |||||
466 | return if $seen->{$group_name}++; | ||||
467 | |||||
468 | if (ref $group_arg) { | ||||
469 | my $prefix = (delete $merge->{-prefix}||'') . ($group_arg->{-prefix}||''); | ||||
470 | my $suffix = ($group_arg->{-suffix}||'') . (delete $merge->{-suffix}||''); | ||||
471 | $merge = { | ||||
472 | %$merge, | ||||
473 | %$group_arg, | ||||
474 | ($prefix ? (-prefix => $prefix) : ()), | ||||
475 | ($suffix ? (-suffix => $suffix) : ()), | ||||
476 | }; | ||||
477 | } | ||||
478 | |||||
479 | my $exports = $config->{groups}{$group_name}; | ||||
480 | |||||
481 | 4 | 6µs | if ( # spent 4µs making 2 calls to Params::Util::_CODELIKE, avg 2µs/call
# spent 3µs making 2 calls to Params::Util::_SCALAR0, avg 1µs/call | ||
482 | Params::Util::_CODELIKE($exports) ## no critic Private | ||||
483 | or | ||||
484 | Params::Util::_SCALAR0($exports) ## no critic Private | ||||
485 | ) { | ||||
486 | # I'm not very happy with this code for hiding -prefix and -suffix, but | ||||
487 | # it's needed, and I'm not sure, offhand, how to make it better. | ||||
488 | # -- rjbs, 2006-12-05 | ||||
489 | my $group_arg = $merge ? { %$merge } : {}; | ||||
490 | delete $group_arg->{-prefix}; | ||||
491 | delete $group_arg->{-suffix}; | ||||
492 | |||||
493 | my $group = Params::Util::_CODELIKE($exports) ## no critic Private | ||||
494 | ? $exports->($class, $group_name, $group_arg, $collection) | ||||
495 | : $class->$$exports($group_name, $group_arg, $collection); | ||||
496 | |||||
497 | Carp::croak qq(group generator "$group_name" did not return a hashref) | ||||
498 | if ref $group ne 'HASH'; | ||||
499 | |||||
500 | my $stuff = [ map { [ $_ => $group->{$_} ] } keys %$group ]; | ||||
501 | return @{ | ||||
502 | _expand_groups($class, $config, $stuff, $collection, $seen, $merge) | ||||
503 | }; | ||||
504 | } else { | ||||
505 | 2 | 44µs | $exports # spent 44µs making 2 calls to Data::OptList::mkopt, avg 22µs/call | ||
506 | = Data::OptList::mkopt($exports, "$group_name exports"); | ||||
507 | |||||
508 | return @{ | ||||
509 | 2 | 0s | _expand_groups($class, $config, $exports, $collection, $seen, $merge) # spent 58µs making 2 calls to Sub::Exporter::_expand_groups, avg 29µs/call, recursion: max depth 1, sum of overlapping time 58µs | ||
510 | }; | ||||
511 | } | ||||
512 | } | ||||
513 | |||||
514 | # spent 54µs within Sub::Exporter::_mk_collection_builder which was called 5 times, avg 11µs/call:
# 5 times (54µs+0s) by Sub::Exporter::_collect_collections at line 560, avg 11µs/call | ||||
515 | 20 | 61µs | my ($col, $etc) = @_; | ||
516 | my ($config, $import_args, $class, $into) = @$etc; | ||||
517 | |||||
518 | my %seen; | ||||
519 | # spent 132µs (95+38) within Sub::Exporter::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter.pm:544] which was called 3 times, avg 44µs/call:
# 3 times (95µs+38µs) by Sub::Exporter::_collect_collections at line 562, avg 44µs/call | ||||
520 | 27 | 90µs | my ($collection) = @_; | ||
521 | my ($name, $value) = @$collection; | ||||
522 | |||||
523 | Carp::croak "collection $name provided multiple times in import" | ||||
524 | if $seen{ $name }++; | ||||
525 | |||||
526 | if (ref(my $hook = $config->{collectors}{$name})) { | ||||
527 | my $arg = { | ||||
528 | name => $name, | ||||
529 | config => $config, | ||||
530 | import_args => $import_args, | ||||
531 | class => $class, | ||||
532 | into => $into, | ||||
533 | }; | ||||
534 | |||||
535 | my $error_msg = "collection $name failed validation"; | ||||
536 | 3 | 6µs | if (Params::Util::_SCALAR0($hook)) { ## no critic Private # spent 6µs making 3 calls to Params::Util::_SCALAR0, avg 2µs/call | ||
537 | Carp::croak $error_msg unless $class->$$hook($value, $arg); | ||||
538 | } else { | ||||
539 | 3 | 32µs | Carp::croak $error_msg unless $hook->($value, $arg); # spent 32µs making 3 calls to Sub::Exporter::_setup, avg 11µs/call | ||
540 | } | ||||
541 | } | ||||
542 | |||||
543 | $col->{ $name } = $value; | ||||
544 | } | ||||
545 | } | ||||
546 | |||||
547 | # Given a config and pre-canonicalized importer args, remove collections from | ||||
548 | # the args and return them. | ||||
549 | # spent 338µs (151+187) within Sub::Exporter::_collect_collections which was called 5 times, avg 68µs/call:
# 5 times (151µs+187µs) by Sub::Exporter::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter.pm:756] at line 740, avg 68µs/call | ||||
550 | 38 | 148µs | my ($config, $import_args, $class, $into) = @_; | ||
551 | |||||
552 | my @collections | ||||
553 | = map { splice @$import_args, $_, 1 } | ||||
554 | grep { exists $config->{collectors}{ $import_args->[$_][0] } } | ||||
555 | reverse 0 .. $#$import_args; | ||||
556 | |||||
557 | unshift @collections, [ INIT => {} ] if $config->{collectors}{INIT}; | ||||
558 | |||||
559 | my $col = {}; | ||||
560 | 5 | 54µs | my $builder = _mk_collection_builder($col, \@_); # spent 54µs making 5 calls to Sub::Exporter::_mk_collection_builder, avg 11µs/call | ||
561 | for my $collection (@collections) { | ||||
562 | 3 | 132µs | $builder->($collection) # spent 132µs making 3 calls to Sub::Exporter::__ANON__[Sub/Exporter.pm:544], avg 44µs/call | ||
563 | } | ||||
564 | |||||
565 | return $col; | ||||
566 | } | ||||
567 | |||||
568 | =head1 SUBROUTINES | ||||
569 | |||||
570 | =head2 setup_exporter | ||||
571 | |||||
572 | This routine builds and installs an C<import> routine. It is called with one | ||||
573 | argument, a hashref containing the exporter configuration. Using this, it | ||||
574 | builds an exporter and installs it into the calling package with the name | ||||
575 | "import." In addition to the normal exporter configuration, a few named | ||||
576 | arguments may be passed in the hashref: | ||||
577 | |||||
578 | into - into what package should the exporter be installed | ||||
579 | into_level - into what level up the stack should the exporter be installed | ||||
580 | as - what name should the installed exporter be given | ||||
581 | |||||
582 | By default the exporter is installed with the name C<import> into the immediate | ||||
583 | caller of C<setup_exporter>. In other words, if your package calls | ||||
584 | C<setup_exporter> without providing any of the three above arguments, it will | ||||
585 | have an C<import> routine installed. | ||||
586 | |||||
587 | Providing both C<into> and C<into_level> will cause an exception to be thrown. | ||||
588 | |||||
589 | The exporter is built by C<L</build_exporter>>. | ||||
590 | |||||
591 | =cut | ||||
592 | |||||
593 | # spent 490µs (22+468) within Sub::Exporter::setup_exporter which was called:
# once (22µs+468µs) by Sub::Exporter::Util::BEGIN@332 at line 938 | ||||
594 | 6 | 19µs | my ($config) = @_; | ||
595 | |||||
596 | Carp::croak 'into and into_level may not both be supplied to exporter' | ||||
597 | if exists $config->{into} and exists $config->{into_level}; | ||||
598 | |||||
599 | my $as = delete $config->{as} || 'import'; | ||||
600 | my $into | ||||
601 | = exists $config->{into} ? delete $config->{into} | ||||
602 | : exists $config->{into_level} ? caller(delete $config->{into_level}) | ||||
603 | : caller(0); | ||||
604 | |||||
605 | 1 | 388µs | my $import = build_exporter($config); # spent 388µs making 1 call to Sub::Exporter::build_exporter | ||
606 | |||||
607 | 1 | 80µs | Sub::Install::reinstall_sub({ # spent 80µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:132] | ||
608 | code => $import, | ||||
609 | into => $into, | ||||
610 | as => $as, | ||||
611 | }); | ||||
612 | } | ||||
613 | |||||
614 | =head2 build_exporter | ||||
615 | |||||
616 | Given a standard exporter configuration, this routine builds and returns an | ||||
617 | exporter -- that is, a subroutine that can be installed as a class method to | ||||
618 | perform exporting on request. | ||||
619 | |||||
620 | Usually, this method is called by C<L</setup_exporter>>, which then installs | ||||
621 | the exporter as a package's import routine. | ||||
622 | |||||
623 | =cut | ||||
624 | |||||
625 | # spent 48µs within Sub::Exporter::_key_intersection which was called 4 times, avg 12µs/call:
# 4 times (48µs+0s) by Sub::Exporter::_rewrite_build_config at line 681, avg 12µs/call | ||||
626 | 12 | 52µs | my ($x, $y) = @_; | ||
627 | my %seen = map { $_ => 1 } keys %$x; | ||||
628 | my @names = grep { $seen{$_} } keys %$y; | ||||
629 | } | ||||
630 | |||||
631 | # Given the config passed to setup_exporter, which contains sugary opt list | ||||
632 | # data, rewrite the opt lists into hashes, catch a few kinds of invalid | ||||
633 | # configurations, and set up defaults. Since the config is a reference, it's | ||||
634 | # rewritten in place. | ||||
635 | 1 | 800ns | my %valid_config_key; | ||
636 | # spent 13µs within Sub::Exporter::BEGIN@636 which was called:
# once (13µs+0s) by Sub::Exporter::Util::BEGIN@332 at line 641 | ||||
637 | %valid_config_key = | ||||
638 | 1 | 13µs | map { $_ => 1 } | ||
639 | qw(as collectors installer generator exports groups into into_level), | ||||
640 | qw(exporter), # deprecated | ||||
641 | 1 | 1.02ms | 1 | 13µs | } # spent 13µs making 1 call to Sub::Exporter::BEGIN@636 |
642 | |||||
643 | # spent 36µs (32+4) within Sub::Exporter::_assert_collector_names_ok which was called 4 times, avg 9µs/call:
# 4 times (32µs+4µs) by Sub::Exporter::_rewrite_build_config at line 679, avg 9µs/call | ||||
644 | 9 | 42µs | my ($collectors) = @_; | ||
645 | |||||
646 | 1 | 4µs | for my $reserved_name (grep { /\A[_A-Z]+\z/ } keys %$collectors) { # spent 4µs making 1 call to Sub::Exporter::CORE:match | ||
647 | Carp::croak "unknown reserved collector name: $reserved_name" | ||||
648 | if $reserved_name ne 'INIT'; | ||||
649 | } | ||||
650 | } | ||||
651 | |||||
652 | # spent 1.21ms (213µs+995µs) within Sub::Exporter::_rewrite_build_config which was called 4 times, avg 302µs/call:
# 4 times (213µs+995µs) by Sub::Exporter::build_exporter at line 709, avg 302µs/call | ||||
653 | 60 | 200µs | my ($config) = @_; | ||
654 | |||||
655 | if (my @keys = grep { not exists $valid_config_key{$_} } keys %$config) { | ||||
656 | Carp::croak "unknown options (@keys) passed to Sub::Exporter"; | ||||
657 | } | ||||
658 | |||||
659 | Carp::croak q(into and into_level may not both be supplied to exporter) | ||||
660 | if exists $config->{into} and exists $config->{into_level}; | ||||
661 | |||||
662 | # XXX: Remove after deprecation period. | ||||
663 | if ($config->{exporter}) { | ||||
664 | Carp::cluck "'exporter' argument to build_exporter is deprecated. Use 'installer' instead; the semantics are identical."; | ||||
665 | $config->{installer} = delete $config->{exporter}; | ||||
666 | } | ||||
667 | |||||
668 | Carp::croak q(into and into_level may not both be supplied to exporter) | ||||
669 | if exists $config->{into} and exists $config->{into_level}; | ||||
670 | |||||
671 | for (qw(exports collectors)) { | ||||
672 | 8 | 597µs | $config->{$_} = Data::OptList::mkopt_hash( # spent 597µs making 8 calls to Data::OptList::mkopt_hash, avg 75µs/call | ||
673 | $config->{$_}, | ||||
674 | $_, | ||||
675 | [ 'CODE', 'SCALAR' ], | ||||
676 | ); | ||||
677 | } | ||||
678 | |||||
679 | 4 | 36µs | _assert_collector_names_ok($config->{collectors}); # spent 36µs making 4 calls to Sub::Exporter::_assert_collector_names_ok, avg 9µs/call | ||
680 | |||||
681 | 4 | 48µs | if (my @names = _key_intersection(@$config{qw(exports collectors)})) { # spent 48µs making 4 calls to Sub::Exporter::_key_intersection, avg 12µs/call | ||
682 | Carp::croak "names (@names) used in both collections and exports"; | ||||
683 | } | ||||
684 | |||||
685 | 4 | 314µs | $config->{groups} = Data::OptList::mkopt_hash( # spent 314µs making 4 calls to Data::OptList::mkopt_hash, avg 78µs/call | ||
686 | $config->{groups}, | ||||
687 | 'groups', | ||||
688 | [ | ||||
689 | 'HASH', # standard opt list | ||||
690 | 'ARRAY', # standard opt list | ||||
691 | 'CODE', # group generator | ||||
692 | 'SCALAR', # name of group generation method | ||||
693 | ] | ||||
694 | ); | ||||
695 | |||||
696 | # by default, export nothing | ||||
697 | $config->{groups}{default} ||= []; | ||||
698 | |||||
699 | # by default, build an all-inclusive 'all' group | ||||
700 | $config->{groups}{all} ||= [ keys %{ $config->{exports} } ]; | ||||
701 | |||||
702 | $config->{generator} ||= \&default_generator; | ||||
703 | $config->{installer} ||= \&default_installer; | ||||
704 | } | ||||
705 | |||||
706 | # spent 1.26ms (55µs+1.21) within Sub::Exporter::build_exporter which was called 4 times, avg 316µs/call:
# 3 times (36µs+838µs) by Sub::Exporter::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter.pm:937] at line 937, avg 292µs/call
# once (18µs+370µs) by Sub::Exporter::setup_exporter at line 605 | ||||
707 | 16 | 54µs | my ($config) = @_; | ||
708 | |||||
709 | 4 | 1.21ms | _rewrite_build_config($config); # spent 1.21ms making 4 calls to Sub::Exporter::_rewrite_build_config, avg 302µs/call | ||
710 | |||||
711 | # spent 2.63ms (219µs+2.41) within Sub::Exporter::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter.pm:756] which was called 5 times, avg 526µs/call:
# once (38µs+715µs) by Getopt::Long::Descriptive::BEGIN@260 at line 264 of Getopt/Long/Descriptive.pm
# once (48µs+544µs) by B::Hooks::EndOfScope::BEGIN@16 at line 16 of B/Hooks/EndOfScope.pm
# once (53µs+503µs) by Sub::Exporter::Util::BEGIN@332 at line 332 of Sub/Exporter/Util.pm
# once (40µs+325µs) by MouseX::Getopt::GLD::BEGIN@12 at line 12 of MouseX/Getopt/GLD.pm
# once (41µs+321µs) by namespace::clean::BEGIN@17 at line 17 of namespace/clean.pm | ||||
712 | 60 | 185µs | my ($class) = shift; | ||
713 | |||||
714 | # XXX: clean this up -- rjbs, 2006-03-16 | ||||
715 | my $special = (ref $_[0]) ? shift(@_) : {}; | ||||
716 | Carp::croak q(into and into_level may not both be supplied to exporter) | ||||
717 | if exists $special->{into} and exists $special->{into_level}; | ||||
718 | |||||
719 | if ($special->{exporter}) { | ||||
720 | Carp::cluck "'exporter' special import argument is deprecated. Use 'installer' instead; the semantics are identical."; | ||||
721 | $special->{installer} = delete $special->{exporter}; | ||||
722 | } | ||||
723 | |||||
724 | my $into | ||||
725 | = defined $special->{into} ? delete $special->{into} | ||||
726 | : defined $special->{into_level} ? caller(delete $special->{into_level}) | ||||
727 | : defined $config->{into} ? $config->{into} | ||||
728 | : defined $config->{into_level} ? caller($config->{into_level}) | ||||
729 | : caller(0); | ||||
730 | |||||
731 | my $generator = delete $special->{generator} || $config->{generator}; | ||||
732 | my $installer = delete $special->{installer} || $config->{installer}; | ||||
733 | |||||
734 | # this builds a AOA, where the inner arrays are [ name => value_ref ] | ||||
735 | 5 | 99µs | my $import_args = Data::OptList::mkopt([ @_ ]); # spent 99µs making 5 calls to Data::OptList::mkopt, avg 20µs/call | ||
736 | |||||
737 | # is this right? defaults first or collectors first? -- rjbs, 2006-06-24 | ||||
738 | $import_args = [ [ -default => undef ] ] unless @$import_args; | ||||
739 | |||||
740 | 5 | 338µs | my $collection = _collect_collections($config, $import_args, $class, $into); # spent 338µs making 5 calls to Sub::Exporter::_collect_collections, avg 68µs/call | ||
741 | |||||
742 | 5 | 351µs | my $to_import = _expand_groups($class, $config, $import_args, $collection); # spent 351µs making 5 calls to Sub::Exporter::_expand_groups, avg 70µs/call | ||
743 | |||||
744 | # now, finally $import_arg is really the "to do" list | ||||
745 | 5 | 1.62ms | _do_import( # spent 1.62ms making 5 calls to Sub::Exporter::_do_import, avg 324µs/call | ||
746 | { | ||||
747 | class => $class, | ||||
748 | col => $collection, | ||||
749 | config => $config, | ||||
750 | into => $into, | ||||
751 | generator => $generator, | ||||
752 | installer => $installer, | ||||
753 | }, | ||||
754 | $to_import, | ||||
755 | ); | ||||
756 | }; | ||||
757 | |||||
758 | return $import; | ||||
759 | } | ||||
760 | |||||
761 | # spent 1.62ms (183µs+1.44) within Sub::Exporter::_do_import which was called 5 times, avg 324µs/call:
# 5 times (183µs+1.44ms) by Sub::Exporter::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter.pm:756] at line 745, avg 324µs/call | ||||
762 | 65 | 190µs | my ($arg, $to_import) = @_; | ||
763 | |||||
764 | my @todo; | ||||
765 | |||||
766 | for my $pair (@$to_import) { | ||||
767 | my ($name, $import_arg) = @$pair; | ||||
768 | |||||
769 | my ($generator, $as); | ||||
770 | |||||
771 | 3 | 5µs | if ($import_arg and Params::Util::_CODELIKE($import_arg)) { ## no critic # spent 5µs making 3 calls to Params::Util::_CODELIKE, avg 2µs/call | ||
772 | # This is the case when a group generator has inserted name/code pairs. | ||||
773 | $generator = sub { $import_arg }; | ||||
774 | $as = $name; | ||||
775 | } else { | ||||
776 | $import_arg = { $import_arg ? %$import_arg : () }; | ||||
777 | |||||
778 | Carp::croak qq("$name" is not exported by the $arg->{class} module) | ||||
779 | unless exists $arg->{config}{exports}{$name}; | ||||
780 | |||||
781 | $generator = $arg->{config}{exports}{$name}; | ||||
782 | |||||
783 | $as = exists $import_arg->{-as} ? (delete $import_arg->{-as}) : $name; | ||||
784 | } | ||||
785 | |||||
786 | 5 | 995µs | my $code = $arg->{generator}->( # spent 995µs making 5 calls to Sub::Exporter::default_generator, avg 199µs/call | ||
787 | { | ||||
788 | class => $arg->{class}, | ||||
789 | name => $name, | ||||
790 | arg => $import_arg, | ||||
791 | col => $arg->{col}, | ||||
792 | generator => $generator, | ||||
793 | } | ||||
794 | ); | ||||
795 | |||||
796 | push @todo, $as, $code; | ||||
797 | } | ||||
798 | |||||
799 | 5 | 438µs | $arg->{installer}->( # spent 438µs making 5 calls to Sub::Exporter::default_installer, avg 88µs/call | ||
800 | { | ||||
801 | class => $arg->{class}, | ||||
802 | into => $arg->{into}, | ||||
803 | col => $arg->{col}, | ||||
804 | }, | ||||
805 | \@todo, | ||||
806 | ); | ||||
807 | } | ||||
808 | |||||
809 | ## Cute idea, possibly for future use: also supply an "unimport" for: | ||||
810 | ## no Module::Whatever qw(arg arg arg); | ||||
811 | # sub _unexport { | ||||
812 | # my (undef, undef, undef, undef, undef, $as, $into) = @_; | ||||
813 | # | ||||
814 | # if (ref $as eq 'SCALAR') { | ||||
815 | # undef $$as; | ||||
816 | # } elsif (ref $as) { | ||||
817 | # Carp::croak "invalid reference type for $as: " . ref $as; | ||||
818 | # } else { | ||||
819 | # no strict 'refs'; | ||||
820 | # delete &{$into . '::' . $as}; | ||||
821 | # } | ||||
822 | # } | ||||
823 | |||||
824 | =head2 default_generator | ||||
825 | |||||
826 | This is Sub::Exporter's default generator. It takes bits of configuration that | ||||
827 | have been gathered during the import and turns them into a coderef that can be | ||||
828 | installed. | ||||
829 | |||||
830 | my $code = default_generator(\%arg); | ||||
831 | |||||
832 | Passed arguments are: | ||||
833 | |||||
834 | class - the class on which the import method was called | ||||
835 | name - the name of the export being generated | ||||
836 | arg - the arguments to the generator | ||||
837 | col - the collections | ||||
838 | |||||
839 | generator - the generator to be used to build the export (code or scalar ref) | ||||
840 | |||||
841 | =cut | ||||
842 | |||||
843 | # spent 995µs (79+916) within Sub::Exporter::default_generator which was called 5 times, avg 199µs/call:
# 5 times (79µs+916µs) by Sub::Exporter::_do_import at line 786, avg 199µs/call | ||||
844 | 22 | 83µs | my ($arg) = @_; | ||
845 | my ($class, $name, $generator) = @$arg{qw(class name generator)}; | ||||
846 | |||||
847 | if (not defined $generator) { | ||||
848 | 1 | 3µs | my $code = $class->can($name) # spent 3µs making 1 call to UNIVERSAL::can | ||
849 | or Carp::croak "can't locate exported subroutine $name via $class"; | ||||
850 | return $code; | ||||
851 | } | ||||
852 | |||||
853 | # I considered making this "$class->$generator(" but it seems that | ||||
854 | # overloading precedence would turn an overloaded-as-code generator object | ||||
855 | # into a string before code. -- rjbs, 2006-06-11 | ||||
856 | 7 | 902µs | return $generator->($class, $name, $arg->{arg}, $arg->{col}) # spent 896µs making 3 calls to Sub::Exporter::__ANON__[Sub/Exporter.pm:937], avg 299µs/call
# spent 6µs making 4 calls to Params::Util::_CODELIKE, avg 1µs/call | ||
857 | if Params::Util::_CODELIKE($generator); ## no critic Private | ||||
858 | |||||
859 | # This "must" be a scalar reference, to a generator method name. | ||||
860 | # -- rjbs, 2006-12-05 | ||||
861 | 1 | 12µs | return $class->$$generator($name, $arg->{arg}, $arg->{col}); # spent 12µs making 1 call to Getopt::Long::Descriptive::_build_describe_options | ||
862 | } | ||||
863 | |||||
864 | =head2 default_installer | ||||
865 | |||||
866 | This is Sub::Exporter's default installer. It does what Sub::Exporter | ||||
867 | promises: it installs code into the target package. | ||||
868 | |||||
869 | default_installer(\%arg, \@to_export); | ||||
870 | |||||
871 | Passed arguments are: | ||||
872 | |||||
873 | into - the package into which exports should be delivered | ||||
874 | |||||
875 | C<@to_export> is a list of name/value pairs. The default exporter assigns code | ||||
876 | (the values) to named slots (the names) in the given package. If the name is a | ||||
877 | scalar reference, the scalar reference is made to point to the code reference | ||||
878 | instead. | ||||
879 | |||||
880 | =cut | ||||
881 | |||||
882 | # spent 438µs (100+338) within Sub::Exporter::default_installer which was called 5 times, avg 88µs/call:
# 5 times (100µs+338µs) by Sub::Exporter::_do_import at line 799, avg 88µs/call | ||||
883 | 30 | 99µs | my ($arg, $to_export) = @_; | ||
884 | |||||
885 | for (my $i = 0; $i < @$to_export; $i += 2) { | ||||
886 | my ($as, $code) = @$to_export[ $i, $i+1 ]; | ||||
887 | |||||
888 | # Allow as isa ARRAY to push onto an array? | ||||
889 | # Allow into isa HASH to install name=>code into hash? | ||||
890 | |||||
891 | if (ref $as eq 'SCALAR') { | ||||
892 | $$as = $code; | ||||
893 | } elsif (ref $as) { | ||||
894 | Carp::croak "invalid reference type for $as: " . ref $as; | ||||
895 | } else { | ||||
896 | 5 | 338µs | Sub::Install::reinstall_sub({ # spent 338µs making 5 calls to Sub::Install::__ANON__[Sub/Install.pm:132], avg 68µs/call | ||
897 | code => $code, | ||||
898 | into => $arg->{into}, | ||||
899 | as => $as | ||||
900 | }); | ||||
901 | } | ||||
902 | } | ||||
903 | } | ||||
904 | |||||
905 | sub default_exporter { | ||||
906 | Carp::cluck "default_exporter is deprecated; call default_installer instead; the semantics are identical"; | ||||
907 | goto &default_installer; | ||||
908 | } | ||||
909 | |||||
910 | =head1 EXPORTS | ||||
911 | |||||
912 | Sub::Exporter also offers its own exports: the C<setup_exporter> and | ||||
913 | C<build_exporter> routines described above. It also provides a special "setup" | ||||
914 | collector, which will set up an exporter using the parameters passed to it. | ||||
915 | |||||
916 | Note that the "setup" collector (seen in examples like the L</SYNOPSIS> above) | ||||
917 | uses C<build_exporter>, not C<setup_exporter>. This means that the special | ||||
918 | arguments like "into" and "as" for C<setup_exporter> are not accepted here. | ||||
919 | Instead, you may write something like: | ||||
920 | |||||
921 | use Sub::Exporter | ||||
922 | { into => 'Target::Package' }, | ||||
923 | -setup => { | ||||
924 | -as => 'do_import', | ||||
925 | exports => [ ... ], | ||||
926 | } | ||||
927 | ; | ||||
928 | |||||
929 | Finding a good reason for wanting to do this is left as as exercise for the | ||||
930 | reader. | ||||
931 | |||||
932 | =cut | ||||
933 | |||||
934 | setup_exporter({ | ||||
935 | exports => [ | ||||
936 | qw(setup_exporter build_exporter), | ||||
937 | 3 | 20µs | 3 | 875µs | # spent 896µs (21+875) within Sub::Exporter::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter.pm:937] which was called 3 times, avg 299µs/call:
# 3 times (21µs+875µs) by Sub::Exporter::default_generator at line 856, avg 299µs/call # spent 875µs making 3 calls to Sub::Exporter::build_exporter, avg 292µs/call |
938 | 1 | 11µs | 1 | 490µs | ], # spent 490µs making 1 call to Sub::Exporter::setup_exporter |
939 | groups => { | ||||
940 | all => [ qw(setup_exporter build_export) ], | ||||
941 | }, | ||||
942 | collectors => { -setup => \&_setup }, | ||||
943 | }); | ||||
944 | |||||
945 | # spent 32µs within Sub::Exporter::_setup which was called 3 times, avg 11µs/call:
# 3 times (32µs+0s) by Sub::Exporter::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Sub/Exporter.pm:544] at line 539, avg 11µs/call | ||||
946 | 12 | 46µs | my ($value, $arg) = @_; | ||
947 | |||||
948 | if (ref $value eq 'HASH') { | ||||
949 | push @{ $arg->{import_args} }, [ _import => { -as => 'import', %$value } ]; | ||||
950 | return 1; | ||||
951 | } elsif (ref $value eq 'ARRAY') { | ||||
952 | push @{ $arg->{import_args} }, | ||||
953 | [ _import => { -as => 'import', exports => $value } ]; | ||||
954 | return 1; | ||||
955 | } | ||||
956 | return; | ||||
957 | } | ||||
958 | |||||
959 | =head1 COMPARISONS | ||||
960 | |||||
961 | There are a whole mess of exporters on the CPAN. The features included in | ||||
962 | Sub::Exporter set it apart from any existing Exporter. Here's a summary of | ||||
963 | some other exporters and how they compare. | ||||
964 | |||||
965 | =over | ||||
966 | |||||
967 | =item * L<Exporter> and co. | ||||
968 | |||||
969 | This is the standard Perl exporter. Its interface is a little clunky, but it's | ||||
970 | fast and ubiquitous. It can do some things that Sub::Exporter can't: it can | ||||
971 | export things other than routines, it can import "everything in this group | ||||
972 | except this symbol," and some other more esoteric things. These features seem | ||||
973 | to go nearly entirely unused. | ||||
974 | |||||
975 | It always exports things exactly as they appear in the exporting module; it | ||||
976 | can't rename or customize routines. Its groups ("tags") can't be nested. | ||||
977 | |||||
978 | L<Exporter::Lite> is a whole lot like Exporter, but it does significantly less: | ||||
979 | it supports exporting symbols, but not groups, pattern matching, or negation. | ||||
980 | |||||
981 | The fact that Sub::Exporter can't export symbols other than subroutines is | ||||
982 | a good idea, not a missing feature. | ||||
983 | |||||
984 | For simple uses, setting up Sub::Exporter is about as easy as Exporter. For | ||||
985 | complex uses, Sub::Exporter makes hard things possible, which would not be | ||||
986 | possible with Exporter. | ||||
987 | |||||
988 | When using a module that uses Sub::Exporter, users familiar with Exporter will | ||||
989 | probably see no difference in the basics. These two lines do about the same | ||||
990 | thing in whether the exporting module uses Exporter or Sub::Exporter. | ||||
991 | |||||
992 | use Some::Module qw(foo bar baz); | ||||
993 | use Some::Module qw(foo :bar baz); | ||||
994 | |||||
995 | The definition for exporting in Exporter.pm might look like this: | ||||
996 | |||||
997 | package Some::Module; | ||||
998 | use base qw(Exporter); | ||||
999 | our @EXPORT_OK = qw(foo bar baz quux); | ||||
1000 | our %EXPORT_TAGS = (bar => [ qw(bar baz) ]); | ||||
1001 | |||||
1002 | Using Sub::Exporter, it would look like this: | ||||
1003 | |||||
1004 | package Some::Module; | ||||
1005 | use Sub::Exporter -setup => { | ||||
1006 | exports => [ qw(foo bar baz quux) ], | ||||
1007 | groups => { bar => [ qw(bar baz) ]} | ||||
1008 | }; | ||||
1009 | |||||
1010 | Sub::Exporter respects inheritance, so that a package may export inherited | ||||
1011 | routines, and will export the most inherited version. Exporting methods | ||||
1012 | without currying away the invocant is a bad idea, but Sub::Exporter allows you | ||||
1013 | to do just that -- and anyway, there are other uses for this feature, like | ||||
1014 | packages of exported subroutines which use inheritance specifically to allow | ||||
1015 | more specialized, but similar, packages. | ||||
1016 | |||||
1017 | L<Exporter::Easy> provides a wrapper around the standard Exporter. It makes it | ||||
1018 | simpler to build groups, but doesn't provide any more functionality. Because | ||||
1019 | it is a front-end to Exporter, it will store your exporter's configuration in | ||||
1020 | global package variables. | ||||
1021 | |||||
1022 | =item * Attribute-Based Exporters | ||||
1023 | |||||
1024 | Some exporters use attributes to mark variables to export. L<Exporter::Simple> | ||||
1025 | supports exporting any kind of symbol, and supports groups. Using a module | ||||
1026 | like Exporter or Sub::Exporter, it's easy to look at one place and see what is | ||||
1027 | exported, but it's impossible to look at a variable definition and see whether | ||||
1028 | it is exported by that alone. Exporter::Simple makes this trade in reverse: | ||||
1029 | each variable's declaration includes its export definition, but there is no one | ||||
1030 | place to look to find a manifest of exports. | ||||
1031 | |||||
1032 | More importantly, Exporter::Simple does not add any new features to those of | ||||
1033 | Exporter. In fact, like Exporter::Easy, it is just a front-end to Exporter, so | ||||
1034 | it ends up storing its configuration in global package variables. (This means | ||||
1035 | that there is one place to look for your exporter's manifest, actually. You | ||||
1036 | can inspect the C<@EXPORT> package variables, and other related package | ||||
1037 | variables, at runtime.) | ||||
1038 | |||||
1039 | L<Perl6::Export> isn't actually attribute based, but looks similar. Its syntax | ||||
1040 | is borrowed from Perl 6, and implemented by a source filter. It is a prototype | ||||
1041 | of an interface that is still being designed. It should probably be avoided | ||||
1042 | for production work. On the other hand, L<Perl6::Export::Attrs> implements | ||||
1043 | Perl 6-like exporting, but translates it into Perl 5 by providing attributes. | ||||
1044 | |||||
1045 | =item * Other Exporters | ||||
1046 | |||||
1047 | L<Exporter::Renaming> wraps the standard Exporter to allow it to export symbols | ||||
1048 | with changed names. | ||||
1049 | |||||
1050 | L<Class::Exporter> performs a special kind of routine generation, giving each | ||||
1051 | importing package an instance of your class, and then exporting the instance's | ||||
1052 | methods as normal routines. (Sub::Exporter, of course, can easily emulate this | ||||
1053 | behavior, as shown above.) | ||||
1054 | |||||
1055 | L<Exporter::Tidy> implements a form of renaming (using its C<_map> argument) | ||||
1056 | and of prefixing, and implements groups. It also avoids using package | ||||
1057 | variables for its configuration. | ||||
1058 | |||||
1059 | =back | ||||
1060 | |||||
1061 | =head1 TODO | ||||
1062 | |||||
1063 | =cut | ||||
1064 | |||||
1065 | =over | ||||
1066 | |||||
1067 | =item * write a set of longer, more demonstrative examples | ||||
1068 | |||||
1069 | =item * solidify the "custom exporter" interface (see C<&default_exporter>) | ||||
1070 | |||||
1071 | =item * add an "always" group | ||||
1072 | |||||
1073 | =back | ||||
1074 | |||||
1075 | =head1 AUTHOR | ||||
1076 | |||||
1077 | Ricardo SIGNES, C<< <rjbs@cpan.org> >> | ||||
1078 | |||||
1079 | =head1 THANKS | ||||
1080 | |||||
1081 | Hans Dieter Pearcey provided helpful advice while I was writing Sub::Exporter. | ||||
1082 | Ian Langworth and Shawn Sorichetti asked some good questions and hepled me | ||||
1083 | improve my documentation quite a bit. Yuval Kogman helped me find a bunch of | ||||
1084 | little problems. | ||||
1085 | |||||
1086 | Thanks, guys! | ||||
1087 | |||||
1088 | =head1 BUGS | ||||
1089 | |||||
1090 | Please report any bugs or feature requests through the web interface at | ||||
1091 | L<http://rt.cpan.org>. I will be notified, and then you'll automatically be | ||||
1092 | notified of progress on your bug as I make changes. | ||||
1093 | |||||
1094 | =head1 COPYRIGHT | ||||
1095 | |||||
1096 | Copyright 2006-2007, Ricardo SIGNES. This program is free software; you can | ||||
1097 | redistribute it and/or modify it under the same terms as Perl itself. | ||||
1098 | |||||
1099 | =cut | ||||
1100 | |||||
1101 | 1 | 6µs | "jn8:32"; # <-- magic true value | ||
# spent 4µs within Sub::Exporter::CORE:match which was called:
# once (4µs+0s) by Sub::Exporter::_assert_collector_names_ok at line 646 |