File | /usr/local/share/perl/5.10.0/Sub/Exporter.pm |
Statements Executed | 3750 |
Total Time | 0.0135234 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
21 | 1 | 1 | 1.90ms | 13.4ms | _do_import | Sub::Exporter::
43 | 2 | 1 | 1.25ms | 3.86ms | _expand_groups | Sub::Exporter::
110 | 1 | 1 | 1.06ms | 4.09ms | default_generator | Sub::Exporter::
21 | 1 | 1 | 1.05ms | 7.42ms | default_installer | Sub::Exporter::
154 | 2 | 1 | 798µs | 798µs | _group_name | Sub::Exporter::
21 | 14 | 12 | 756µs | 19.4ms | __ANON__[:756] | Sub::Exporter::
21 | 1 | 1 | 642µs | 1.09ms | _collect_collections | Sub::Exporter::
22 | 1 | 1 | 544µs | 3.13ms | _expand_group | Sub::Exporter::
21 | 1 | 1 | 356µs | 356µs | _mk_collection_builder | Sub::Exporter::
6 | 1 | 1 | 249µs | 2.40ms | _rewrite_build_config | Sub::Exporter::
6 | 3 | 2 | 109µs | 2.51ms | build_exporter | Sub::Exporter::
6 | 1 | 1 | 106µs | 106µs | _key_intersection | Sub::Exporter::
6 | 1 | 1 | 58µs | 58µs | _assert_collector_names_ok | Sub::Exporter::
2 | 1 | 1 | 52µs | 93µs | __ANON__[:544] | Sub::Exporter::
2 | 2 | 2 | 39µs | 1.00ms | setup_exporter | Sub::Exporter::
2 | 1 | 1 | 26µs | 26µs | _setup | Sub::Exporter::
2 | 1 | 1 | 11µs | 394µs | __ANON__[:937] | Sub::Exporter::
0 | 0 | 0 | 0s | 0s | BEGIN | Devel::GlobalDestruction::
0 | 0 | 0 | 0s | 0s | BEGIN | Sub::Exporter::
0 | 0 | 0 | 0s | 0s | __ANON__[:773] | Sub::Exporter::
0 | 0 | 0 | 0s | 0s | default_exporter | Sub::Exporter::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | 3 | 45µs | 15µs | use 5.006; |
2 | 3 | 26µs | 9µs | use strict; # spent 12µs making 1 call to strict::import |
3 | 3 | 42µs | 14µs | use warnings; # spent 20µs making 1 call to warnings::import |
4 | package Sub::Exporter; | |||
5 | ||||
6 | 3 | 23µs | 8µs | use Carp (); |
7 | 3 | 19µs | 6µs | use Data::OptList (); |
8 | 3 | 27µs | 9µs | use Params::Util (); |
9 | 3 | 1.48ms | 492µs | use Sub::Install 0.92 (); # spent 20µ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 | 900ns | 900ns | 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 | 352 | 461µs | 1µ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 3.86ms (1.25+2.60) within Sub::Exporter::_expand_groups which was called 43 times, avg 90µs/call:
# 22 times (712µs+-712µs) by Sub::Exporter::_expand_group at line 509, avg 0s/call
# 21 times (539µs+3.32ms) by Sub::Exporter::build_exporter or Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756] at line 742, avg 184µs/call | |||
415 | 258 | 527µs | 2µ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 | 286 | 925µs | 3µs | if (my $group_name = _group_name($groups[$i][0])) { # spent 689µs making 132 calls to Sub::Exporter::_group_name, avg 5µs/call |
422 | my $seen = { %$seen }; # faux-dynamic scoping | |||
423 | ||||
424 | splice @groups, $i, 1, # spent 5.16ms making 22 calls to Sub::Exporter::_expand_group, avg 142µs/call, max recursion depth 1 | |||
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 3.13ms (544µs+2.58) within Sub::Exporter::_expand_group which was called 22 times, avg 142µs/call:
# 22 times (544µs+2.58ms) by Sub::Exporter::_expand_groups at line 424, avg 142µs/call | |||
457 | 198 | 482µs | 2µs | my ($class, $config, $group, $collection, $seen, $merge) = @_; |
458 | $merge ||= {}; | |||
459 | ||||
460 | my ($group_name, $group_arg) = @$group; | |||
461 | $group_name = _group_name($group_name); # spent 110µs making 22 calls to Sub::Exporter::_group_name, avg 5µ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 | 44 | 291µs | 7µs | if ( # spent 89µs making 22 calls to Params::Util::_CODELIKE, avg 4µs/call
# spent 57µs making 22 calls to Params::Util::_SCALAR0, avg 3µ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 | $exports # spent 1.12ms making 22 calls to Data::OptList::mkopt, avg 51µs/call | |||
506 | = Data::OptList::mkopt($exports, "$group_name exports"); | |||
507 | ||||
508 | return @{ | |||
509 | _expand_groups($class, $config, $exports, $collection, $seen, $merge) # spent 3.25ms making 22 calls to Sub::Exporter::_expand_groups, avg 0s/call, max recursion depth 1 | |||
510 | }; | |||
511 | } | |||
512 | } | |||
513 | ||||
514 | # spent 356µs within Sub::Exporter::_mk_collection_builder which was called 21 times, avg 17µs/call:
# 21 times (356µs+0s) by Sub::Exporter::_collect_collections at line 560, avg 17µs/call | |||
515 | 84 | 276µs | 3µs | my ($col, $etc) = @_; |
516 | my ($config, $import_args, $class, $into) = @$etc; | |||
517 | ||||
518 | my %seen; | |||
519 | # spent 93µs (52+41) within Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:544] which was called 2 times, avg 47µs/call:
# 2 times (52µs+41µs) by Sub::Exporter::_collect_collections at line 562, avg 47µs/call | |||
520 | 10 | 16µs | 2µ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 | 6 | 36µs | 6µs | 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 | 2 | 9µs | 4µs | if (Params::Util::_SCALAR0($hook)) { ## no critic Private # spent 14µs making 2 calls to Params::Util::_SCALAR0, avg 7µs/call |
537 | Carp::croak $error_msg unless $class->$$hook($value, $arg); | |||
538 | } else { | |||
539 | Carp::croak $error_msg unless $hook->($value, $arg); # spent 26µs making 2 calls to Sub::Exporter::_setup, avg 13µ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 1.09ms (642µs+449µs) within Sub::Exporter::_collect_collections which was called 21 times, avg 52µs/call:
# 21 times (642µs+449µs) by Sub::Exporter::build_exporter or Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756] at line 740, avg 52µs/call | |||
550 | 147 | 638µs | 4µ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 | my $builder = _mk_collection_builder($col, \@_); # spent 356µs making 21 calls to Sub::Exporter::_mk_collection_builder, avg 17µs/call | |||
561 | for my $collection (@collections) { | |||
562 | 2 | 16µs | 8µs | $builder->($collection) # spent 93µs making 2 calls to Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:544], avg 47µ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 1.00ms (39µs+966µs) within Sub::Exporter::setup_exporter which was called 2 times, avg 502µs/call:
# once (18µs+521µs) at line 938
# once (21µs+445µs) at line 35 of /usr/local/lib/perl/5.10.0/Moose/Util.pm | |||
594 | 12 | 52µs | 4µ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 | my $import = build_exporter($config); # spent 773µs making 2 calls to Sub::Exporter::build_exporter, avg 386µs/call | |||
606 | ||||
607 | Sub::Install::reinstall_sub({ # spent 193µs making 2 calls to Sub::Install::__ANON__[/usr/local/share/perl/5.10.0/Sub/Install.pm:132], avg 97µs/call | |||
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 106µs within Sub::Exporter::_key_intersection which was called 6 times, avg 18µs/call:
# 6 times (106µs+0s) by Sub::Exporter::_rewrite_build_config at line 681, avg 18µs/call | |||
626 | 18 | 88µs | 5µ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 | 300ns | 300ns | my %valid_config_key; |
636 | BEGIN { | |||
637 | %valid_config_key = | |||
638 | 1 | 15µs | 15µs | map { $_ => 1 } |
639 | qw(as collectors installer generator exports groups into into_level), | |||
640 | qw(exporter), # deprecated | |||
641 | 1 | 1.45ms | 1.45ms | } |
642 | ||||
643 | # spent 58µs within Sub::Exporter::_assert_collector_names_ok which was called 6 times, avg 10µs/call:
# 6 times (58µs+0s) by Sub::Exporter::_rewrite_build_config at line 679, avg 10µs/call | |||
644 | 12 | 28µs | 2µs | my ($collectors) = @_; |
645 | ||||
646 | 1 | 5µs | 5µs | for my $reserved_name (grep { /\A[_A-Z]+\z/ } keys %$collectors) { |
647 | Carp::croak "unknown reserved collector name: $reserved_name" | |||
648 | if $reserved_name ne 'INIT'; | |||
649 | } | |||
650 | } | |||
651 | ||||
652 | # spent 2.40ms (249µs+2.16) within Sub::Exporter::_rewrite_build_config which was called 6 times, avg 401µs/call:
# 6 times (249µs+2.16ms) by Sub::Exporter::build_exporter at line 709, avg 401µs/call | |||
653 | 78 | 231µs | 3µ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 | 12 | 97µs | 8µs | $config->{$_} = Data::OptList::mkopt_hash( # spent 1.48ms making 12 calls to Data::OptList::mkopt_hash, avg 123µs/call |
673 | $config->{$_}, | |||
674 | $_, | |||
675 | [ 'CODE', 'SCALAR' ], | |||
676 | ); | |||
677 | } | |||
678 | ||||
679 | _assert_collector_names_ok($config->{collectors}); # spent 58µs making 6 calls to Sub::Exporter::_assert_collector_names_ok, avg 10µs/call | |||
680 | ||||
681 | if (my @names = _key_intersection(@$config{qw(exports collectors)})) { # spent 106µs making 6 calls to Sub::Exporter::_key_intersection, avg 18µs/call | |||
682 | Carp::croak "names (@names) used in both collections and exports"; | |||
683 | } | |||
684 | ||||
685 | $config->{groups} = Data::OptList::mkopt_hash( # spent 512µs making 6 calls to Data::OptList::mkopt_hash, avg 85µ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 2.51ms (109µs+2.40) within Sub::Exporter::build_exporter which was called 6 times, avg 419µs/call:
# 2 times (40µs+1.32ms) by Moose::Exporter::build_import_methods at line 54 of /usr/local/lib/perl/5.10.0/Moose/Exporter.pm, avg 679µs/call
# 2 times (40µs+733µs) by Sub::Exporter::setup_exporter at line 605, avg 386µs/call
# 2 times (30µs+354µs) by Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:937] at line 937, avg 192µs/call | |||
707 | 24 | 101µs | 4µs | my ($config) = @_; |
708 | ||||
709 | _rewrite_build_config($config); # spent 2.40ms making 6 calls to Sub::Exporter::_rewrite_build_config, avg 401µs/call | |||
710 | ||||
711 | # spent 19.4ms (756µs+18.7) within Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756] which was called 21 times, avg 925µs/call:
# 8 times (308µs+15.1ms) by Moose::Exporter::_make_import_sub or Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:425] at line 418 of /usr/local/lib/perl/5.10.0/Moose/Exporter.pm, avg 1.93ms/call
# once (35µs+514µs) by B::Hooks::EndOfScope::BEGIN at line 11 of /usr/local/share/perl/5.10.0/B/Hooks/EndOfScope.pm
# once (30µs+514µs) at line 26 of /usr/local/lib/perl/5.10.0/Devel/GlobalDestruction.pm
# once (41µs+318µs) at line 14 of /usr/local/share/perl/5.10.0/namespace/autoclean.pm
# once (29µs+314µs) at line 14 of /usr/local/share/perl/5.10.0/namespace/clean.pm
# once (42µs+266µs) at line 7 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application/ToClass.pm
# once (36µs+262µs) at line 10 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role.pm
# once (36µs+258µs) at line 9 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/DuckType.pm
# once (34µs+244µs) at line 22 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role.pm
# once (28µs+216µs) at line 16 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm
# once (38µs+181µs) at line 8 of /usr/local/lib/perl/5.10.0/Moose/Util.pm
# once (35µs+161µs) at line 7 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Method/Conflicting.pm
# once (33µs+161µs) at line 26 of /usr/local/lib/perl/5.10.0/Moose/Meta/Class.pm
# once (31µs+160µs) at line 16 of /usr/local/lib/perl/5.10.0/Moose/Exporter.pm | |||
712 | 252 | 929µs | 4µ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 | my $import_args = Data::OptList::mkopt([ @_ ]); # spent 295µs making 21 calls to Data::OptList::mkopt, avg 14µ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 | my $collection = _collect_collections($config, $import_args, $class, $into); # spent 1.09ms making 21 calls to Sub::Exporter::_collect_collections, avg 52µs/call | |||
741 | ||||
742 | my $to_import = _expand_groups($class, $config, $import_args, $collection); # spent 3.86ms making 21 calls to Sub::Exporter::_expand_groups, avg 184µs/call | |||
743 | ||||
744 | # now, finally $import_arg is really the "to do" list | |||
745 | _do_import( # spent 13.4ms making 21 calls to Sub::Exporter::_do_import, avg 639µ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 13.4ms (1.90+11.5) within Sub::Exporter::_do_import which was called 21 times, avg 639µs/call:
# 21 times (1.90ms+11.5ms) by Sub::Exporter::build_exporter or Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756] at line 745, avg 639µs/call | |||
762 | 84 | 264µs | 3µs | my ($arg, $to_import) = @_; |
763 | ||||
764 | my @todo; | |||
765 | ||||
766 | for my $pair (@$to_import) { | |||
767 | 550 | 1.30ms | 2µs | my ($name, $import_arg) = @$pair; |
768 | ||||
769 | my ($generator, $as); | |||
770 | ||||
771 | 440 | 650µs | 1µs | if ($import_arg and Params::Util::_CODELIKE($import_arg)) { ## no critic # spent 14µs making 2 calls to Params::Util::_CODELIKE, avg 7µ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 | my $code = $arg->{generator}->( # spent 4.09ms making 110 calls to Sub::Exporter::default_generator, avg 37µ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 | $arg->{installer}->( # spent 7.42ms making 21 calls to Sub::Exporter::default_installer, avg 353µ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 4.09ms (1.06+3.04) within Sub::Exporter::default_generator which was called 110 times, avg 37µs/call:
# 110 times (1.06ms+3.04ms) by Sub::Exporter::_do_import at line 786, avg 37µs/call | |||
844 | 433 | 1.54ms | 4µs | my ($arg) = @_; |
845 | my ($class, $name, $generator) = @$arg{qw(class name generator)}; | |||
846 | ||||
847 | 14 | 85µs | 6µs | if (not defined $generator) { |
848 | my $code = $class->can($name) # spent 38µs making 7 calls to UNIVERSAL::can, avg 5µs/call | |||
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 | return $generator->($class, $name, $arg->{arg}, $arg->{col}) # spent 2.06ms making 56 calls to Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:292], avg 37µs/call
# spent 394µs making 2 calls to Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:937], avg 197µs/call
# spent 297µs making 45 calls to Moose::Exporter::__ANON__[/usr/local/lib/perl/5.10.0/Moose/Exporter.pm:222], avg 7µs/call
# spent 253µs making 103 calls to Params::Util::_CODELIKE, avg 2µ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 | return $class->$$generator($name, $arg->{arg}, $arg->{col}); | |||
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 7.42ms (1.05+6.36) within Sub::Exporter::default_installer which was called 21 times, avg 353µs/call:
# 21 times (1.05ms+6.36ms) by Sub::Exporter::_do_import at line 799, avg 353µs/call | |||
883 | 63 | 90µs | 1µs | my ($arg, $to_export) = @_; |
884 | ||||
885 | 220 | 321µs | 1µs | for (my $i = 0; $i < @$to_export; $i += 2) { |
886 | 1 | 241µs | 241µs | 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 | 110 | 642µs | 6µs | 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 | Sub::Install::reinstall_sub({ # spent 6.36ms making 110 calls to Sub::Install::__ANON__[/usr/local/share/perl/5.10.0/Sub/Install.pm:132], avg 58µ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 | 2 | 10µs | 5µs | # spent 394µs (11+384) within Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:937] which was called 2 times, avg 197µs/call:
# 2 times (11µs+384µs) by Sub::Exporter::default_generator at line 856, avg 197µs/call # spent 384µs making 2 calls to Sub::Exporter::build_exporter, avg 192µs/call |
938 | 1 | 22µs | 22µs | ], # spent 539µ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 26µs within Sub::Exporter::_setup which was called 2 times, avg 13µs/call:
# 2 times (26µs+0s) by Sub::Exporter::_mk_collection_builder or Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:544] at line 539, avg 13µs/call | |||
946 | 4 | 5µs | 1µs | my ($value, $arg) = @_; |
947 | ||||
948 | 4 | 15µs | 4µs | 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 | 11µs | 11µs | "jn8:32"; # <-- magic true value |