| 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__ |