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