File Coverage

blib/lib/Export/These.pm
Criterion Covered Total %
statement 193 216 89.3
branch 68 106 64.1
condition 8 17 47.0
subroutine 17 17 100.0
pod n/a
total 286 356 80.3


line stmt bran cond sub pod time code
1             package Export::These;
2              
3 3     3   276475 use strict;
  3         8  
  3         226  
4 3     3   36 use warnings;
  3         8  
  3         986  
5              
6             our $VERSION="v0.3.0";
7              
8             sub import {
9 9     9   2928 my $package=shift;
10 9         31 my $exporter=caller;
11              
12             # Treat args as key value pairs, unless the value is a string. in
13             # this case it is the name of a symbol to export directly
14              
15 9         19 my ($k, $v);
16              
17 2     2   17 no strict "refs";
  2         20  
  2         1903  
18              
19             # Locate or create the EXPORT, EXPORT_OK and EXPORT_TAGS package
20             # variables. v0.2.0 adds EXPORT_PASS an array of names to allow to
21             # pass through for reexporting
22             # These are used to accumulate our exported symbol names across
23             # multiple use Export::Terse ...; statements
24             #
25 9         16 my $export_ok= \@{"@{[$exporter]}::EXPORT_OK"};
  9         17  
  9         77  
26 9         18 my $export= \@{"@{[$exporter]}::EXPORT"};
  9         13  
  9         94  
27 9         15 my $export_tags= \%{"@{[$exporter]}::EXPORT_TAGS"};
  9         17  
  9         48  
28              
29             #my $export_pass= \@{"@{[$exporter]}::EXPORT_PASS"};
30            
31             # This is a reference to a scalar, which is either undef
32             # or a reference to an array
33 9         21 my $export_pass=\${"@{[$exporter]}::EXPORT_PASS"};
  9         11  
  9         41  
34              
35            
36 9         34 while(@_){
37 20         32 $k=shift;
38              
39 20 50       48 die "Expecting symbol name or group name" if ref $k;
40 20         41 my $r=ref $_[0];
41 20 100       42 unless($r){
42 12         22 push @$export, $k;
43 12         21 push @$export_ok, $k;
44             next
45 12         31 }
46 8         32 my $v=shift;
47              
48 8         17 for($k){
49 8 50 33     92 if(/export_ok$/ and $r eq "ARRAY"){
    50 33        
    100 66        
    50          
50 0         0 push @$export_ok, @$v;
51             }
52             elsif(/export$/ and $r eq "ARRAY"){
53 0         0 push @$export, @$v;
54 0         0 push @$export_ok, @$v;
55             }
56             elsif(/export_pass/ and $r eq "ARRAY"){
57 2 50       6 unless($$export_pass){
58 2         5 $$export_pass=[];
59             }
60 2         10 push @$$export_pass, @$v;
61             }
62             elsif($r eq "ARRAY"){
63             #Assume key is a tag name
64 6         25 push $export_tags->{$k}->@*, @$v;
65 6         25 push @$export_ok, @$v;
66             }
67             else {
68 0         0 die "Unkown export grouping: $k";
69             }
70             }
71             }
72              
73             # Generate the import sub here if it doesn't exist already
74              
75 9         19 local $"= " ";
76             #my $exist=eval {*{\${$exporter."::"}{import}}{CODE}};
77 9         18 my $str="defined &$exporter"."::import" ;
78 9         745 my $exist=eval $str;
79              
80 9 100       55 if($exist){
81 2         459 return;
82             }
83 7         14 my $code=qq|
84             package $exporter;
85             no strict "refs";
86              
87              
88             sub _self_export {
89             shift;
90              
91 7         24 my \$ref_export_ok= \\\@@{[$exporter]}::EXPORT_OK;
92 7         15 my \$ref_export= \\\@@{[$exporter]}::EXPORT;
93 7         45 my \$ref_tags= \\\%@{[$exporter]}::EXPORT_TAGS;
94 7         25 my \$ref_export_pass= \\\$@{[$exporter]}::EXPORT_PASS;
95              
96             my \$target=shift;
97              
98             # Filter out any refs.. this config not symbol names
99             \@_=grep !ref, \@_;
100             no strict "refs";
101             my \@stack=\@_ ? \@_ :\@\$ref_export;
102            
103             local \$_;
104             while(\@stack){
105             \$_=shift \@stack;
106             if(ref){
107             # If not a simple scalar don't process here, but don't error
108             next;
109             }
110             elsif(!\$_){
111             # an empty name or undef value can be used to prevent default imports
112             next;
113             }
114             elsif(/^:/){
115             my \$name= s/^://r;
116              
117             my \$group=\$ref_tags->{\$name};
118             #die "Tag \$name does not exists" unless \$group;
119             push \@stack, \@\$group if \$group;
120             }
121             else {
122             #non tag symbol
123             my \$type;
124             my \$name=\$_;
125             if(\$name=~s/^(\\W)//){
126             # has sigil
127             \$type=\$1;
128              
129             }
130             else {
131             # No sigil
132             \$type="&";
133             }
134             #my \$name=\$_;
135              
136             my \$package=__PACKAGE__;
137             *{\$target."::".\$name}=
138             \$type eq '&' ? \\&{"\${package}::\$name"} :
139             \$type eq '\$' ? \\\${"\${package}::\$name"} :
140             \$type eq '\@' ? \\\@{"\${package}::\$name"} :
141             \$type eq '%' ? \\%{"\${package}::\$name"} :
142             \$type eq '*' ? *{"\${package}::\$name"} :
143             die "Can't export symbol: \$type\$name";
144             }
145             }
146             }
147              
148              
149             sub import {
150             my \$package=shift;
151             \$Exporter::ExportLevel//=0;
152             my \$target=(caller(\$Exporter::ExportLevel))[0];
153              
154             my \$defined=eval "defined &\$package"."::_preexport";
155             my \@args;
156             if(\$defined){
157             \@args=$exporter->_preexport(\$target, \@_);
158             }
159             else {
160             \@args=\@_;
161             }
162              
163             $exporter->_self_export(\$target, \@args);
164            
165             local \$Exporter::ExportLevel=\$Exporter::ExportLevel+3;
166             \$defined=eval "defined &\$package"."::_reexport";
167              
168             if(\$defined){
169             $exporter->_reexport(\$target, \@args);
170             }
171              
172             }
173              
174             1;
175             |;
176 2 100 50 2   16 my $res=eval $code;
  2 50 50 2   19  
  2 100 50 2   265  
  2 0 50 2   24  
  2 50   2   23  
  2 100   2   1516  
  2 100   3   18  
  2 100   2   34  
  2 50   2   300  
  2 50   8   16  
  2 100   3   3  
  2 100   2   1457  
  2 0   6   17  
  2 100       4  
  2 0       287  
  2 50       16  
  2 100       2  
  2 100       1531  
  7 100       788  
  3 50       7  
  3 50       6  
  3 50       8  
  3 100       7  
  3 50       6  
  3 50       6  
  3 0       14  
  3 0       12  
  3 0       6  
  3 0       11  
  14 50       23  
  14 50       51  
  0 50       0  
  0 100       0  
  2 100       7  
  2 50       21  
  2 100       11  
  12 100       19  
  12 50       20  
  12 50       50  
  7 100       17  
  5 100       9  
  12 50       21  
  12 50       34  
  12 100       73  
  5         19  
  3         11  
  2         8  
  2         6  
  0         0  
  2         5  
  2         6  
  2         4  
  2         3  
  2         6  
  2         5  
  2         6  
  2         12  
  2         3  
  2         8  
  6         11  
  6         41  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  6         11  
  6         10  
  6         21  
  3         8  
  3         6  
  6         11  
  6         23  
  6         37  
  3         12  
  1         3  
  1         3  
  1         4  
  0         0  
  2         4  
  2         6  
  2         5  
  2         5  
  2         4  
  2         4  
  2         8  
  2         7  
  2         4  
  2         14  
  2         4  
  2         11  
  0         0  
  0         0  
  1         5  
  1         2  
  1         5  
  1         2  
  1         3  
  1         5  
  0         0  
  1         2  
  1         2  
  1         22  
  1         9  
  1         8  
  0         0  
  0         0  
  0         0  
  0         0  
  8         98  
  8         24  
  8         25  
  8         148  
  8         21  
  8         17  
  6         20  
  8         31  
  8         36  
  8         21  
  13         206  
  13         59  
  2         11  
  3         138  
  5         19  
  5         20  
  5         224  
  12         45  
  12         29  
  9         31  
  4         16  
  11         27  
  12         22  
  12         256  
  12         1986  
  9         39  
  3         252  
  2         11  
  2         12  
  2         164  
  2         10  
  2         8  
  0         0  
  2         8  
  2         10  
  2         4  
  2         205  
  2         13  
  2         14  
  6         260  
  6         22  
  6         34  
  6         447  
  6         29  
  6         18  
  0         0  
  6         18  
  6         25  
  6         15  
  6         418  
  6         2474  
  0            
177 7 50       474 die $@ unless $res;
178             }
179             1;
180              
181              
182             =head1 NAME
183              
184             Export::These - Terse Module Configuration and Symbol (Re)Exporting
185              
186              
187             =head1 SYNOPSIS
188              
189             Take a fine package, exporting subroutines,
190              
191             package My::ModA;
192              
193             use Export::These "dog", "cat", ":colors"=>[qw];
194              
195             sub dog {...}
196             sub cat {...}
197             sub blue {...}
198             sub green {...}
199             1;
200              
201              
202             Another package which would like to reexport the subs from My::ModA:
203              
204             package My::ModB;
205             use My::ModA;
206              
207             use Export::These ":colors"=>["more_colours"];
208              
209             sub _reexport {
210             my ($packate, $target, @names)=@_;
211             My::ModA->import(":colours") if grep /:colours/, @names;
212             }
213            
214             sub more_colours { .... }
215             1;
216              
217              
218             Use package like usual:
219              
220             use My::ModB qw<:colors dog>
221              
222             # subroutines blue, green, more_colors and dog imported
223              
224              
225              
226             Also can use to pass in configuration information to a module:
227              
228             package My::ModB;
229              
230             use Export::These;
231              
232             sub _preexport {
233            
234             my @refs=grep ref, @_;
235             my @non_ref= grep !ref, @_;
236            
237             # Use @refs as configuration data
238            
239             @non_ref;
240             }
241              
242              
243             # Import the module, with configuration data
244             use My::ModB {option1=>"hello"}, "symbol";
245              
246             ...
247              
248              
249             =head1 DESCRIPTION
250              
251             A module to make exporting symbols less verbose and more powerful. Facilitate
252             reexporting and filtering of symbols from dependencies with minimal input from
253             the module author. Also provide the ability to pass in 'config data' data to a
254             module during import.
255              
256             By default listing a symbol for export, even in a group/tag, means it will be
257             automatically marked as 'export_ok', saving on duplication and managing two
258             separate lists.
259              
260             It B inherit from C nor does it utilise the C
261             routine from C. It injects its own C subroutine into the each
262             calling package. This injected subroutine adds the desired symbols to the
263             target package as you would expect.
264              
265             If the exporting package has a C<_preexport> subroutine, it is called as a
266             filter 'hook' prior to normal 'importing' to allow module wide configuration or
267             pre processing of requested import list. The return from this subroutine will
268             be the arguments used at subsequent stages so remember to return an appropriate
269             list.
270              
271             If the exporting package has a C<_reexport> subroutine, it is called after
272             normal importing. This is the 'hook' location where its safe to call
273             C<-Eimport> on any dependencies modules it might want to export. The
274             symbols from these packages will automatically be installed into the target
275             package with no extra configuration needed.
276              
277             Any reference types specified in an import are ignored during the normal import
278             process. This allows custom module configuration to be passed during import
279             and processed in the C<_preexport> and C<_reexport> hooks.
280              
281             Finally, warnings about symbols redefinition in the export process (i.e. exporting
282             to two subroutines with the same name into the same namespace) are silenced to
283             keep warning noise to a minimum. The last symbol definition will ultimately be
284             the one used.
285              
286              
287              
288             =head1 MOTIVATION
289              
290             Suppose you have a server module, which uses a configuration module to process
291             configuration data. However the main program (which imported the server module)
292             also needs to use the subroutines from the configuration module. The consumer
293             of the server module has to also add the configuration module as a dependency.
294              
295             With this module the server can simply reexport the required configuration
296             routines, injecting the dependency, instead of the consumer hard coding it.
297              
298              
299             =head1 USAGE
300            
301             =head2 Importing a module which uses this module
302              
303             Importing is like normal:
304              
305             require My::Module;
306             My::Moudle->import;
307              
308             use My::Moudle qw<:tag_name name2 ...>;
309              
310             However, from B modules exporting with L can also take
311             reference values as a key without error. This allows passing non names as
312             configuration data for the module to use:
313              
314             eg
315              
316             # Config module and export named symbols
317             use My::Module {prefork=>1, workers=>10}, "symname1", ":group1",['more', 'config'];
318              
319             # Config module and export default symbols
320             use My::Module {prefork=>1, workers=>10};
321              
322             # Config module only. No symbol export
323             use My::Module {prefork=>1, workers=>10}, undef;
324              
325             In this hypothetical example, the My::Module uses the hash and array ref as
326             configuration internally, and the normal scalars as the symbols/tag groups to
327             export. In the last case the undef value forces no importing of default symbols
328             when using a reference value.
329              
330              
331              
332              
333             =head2 Specifying Symbols to Export
334              
335             use Export::These ...;
336              
337             The pragma takes a list of arguments to add to the C<@EXPORT> and C
338             variables. The items are taken as a name of a symbol or tag, unless the
339             following argument in the list is an array ref.
340              
341             eg:
342              
343             use Export::These qw;
344              
345              
346             If the item name is "export_ok", then the items in the following array ref are
347             added to the C<@EXPORT_OK> variable.
348            
349              
350             eg
351             use Export::These export_ok=>[qw];
352              
353              
354             If the item name is "export", then the items in the following array ref are
355             added to the C<@EXPORT_OK> and the C variables. This is the same as
356             simply listing the items at the top level.
357            
358             eg
359              
360             use Export::These export=>[qw];
361             # same as
362             # use Export::These qw;
363              
364             If the item name is "export_pass", then the items in the following array ref
365             symbols will be allowed to be requested for import even if the module does not
366             export them directly. Use an empty array ref to allow any names for
367             reexporting:
368              
369             eg
370              
371             # Allow sym1 to be reexported from sub modules
372             use Export::These export_pass=>[qw];
373              
374             # Allow any name to be reexported from submodules
375             use Export::These export_pass=>[];
376              
377              
378              
379             If the item has any other name, it is a tag name and the items in the following
380             array ref are added to the C<%EXPORT_TAGS> variable and to C<@EXPORT_OK>
381              
382             eg use Export::These group1=>["sym1"];
383              
384              
385              
386             The list can contain any combination of the above:
387              
388             eq use Export::These "sym1", group1=>["sym2", "sym3"], export_ok=>"sym4";
389              
390              
391             =head2 Rexporting Symbols
392              
393             If a subroutine called C<_reexport> exists in the exporting package, it will be
394             called on (with the -> notation) during import, after the normal symbols have
395             been processed. The first argument is the package name of exporter, the second
396             is the package name of the importer (the target), and the remaining arguments
397             are the names of symbols or tags to import.
398              
399             In this subroutine, you call C on as any packages you want to reexport:
400              
401             eg
402             use Sub::Module;
403             use Another::Mod;
404              
405             sub _reexport {
406             my ($package, $target, @names)=@_;
407              
408             Sub::Module->import;
409             Another::Mod->import(@names);
410             ...
411             }
412              
413             =head2 Conditional Reexporting
414              
415             If you would only like to require and export on certain conditions, some extra
416             steps are needed to ensure correct setup of back end variables. Namely the
417             C<$Exporter::ExportLevel> variable needs to be localized and set to 0 inside a
418             block BEFORE calling the C<-Eimport> subroutine on the package.
419              
420             sub _reexport {
421             my ($package, $target, @names)=@_;
422              
423             if(SOME_CONDITION){
424             {
425             # In an localised block, reset the export level
426             local $Exporter::ExportLevel=0;
427             require Sub::Module;
428             require Another::Module;
429             }
430              
431             Sub::Module->import;
432             Another::Mod->import(@names);
433              
434             }
435             }
436              
437             =head2 Reexport Super Class Symbols
438              
439             Any exported symbols from the inheritance chain can be reexported in the same
440             manner, as long as they are package subroutines and not methods:
441              
442             eg
443              
444             package ModChild;
445             parent ModParent;
446              
447             # or
448            
449             class ModChild :isa(ModParent)
450              
451            
452             sub _reexport {
453             my ($package, $target, @names)=@_;
454             $package->SUPER::import(@names);
455             }
456              
457              
458             =head1 COMPARISON TO OTHER MODULES
459              
460             L Provides clean way to reexport symbols, though you will have to
461             roll your own 'normal' export of symbols from you own package.
462              
463             L Requires a custom package to group the imports and reexports
464             them. This is a different approach and might better suit your needs.
465              
466              
467             Reexporting symbols with C directly is a little cumbersome. You
468             either need to import everything into you module name space (even if you don't
469             need it) and then reexport from there. Alternatively you can import directly
470             into a package, but you need to know at what level in the call stack it is.
471             This is exactly what this module addresses.
472              
473              
474             =head1 REPOSITOTY and BUGS
475              
476             Please report and feature requests or bugs via the github repo:
477              
478             L
479              
480             =head1 AUTHOR
481              
482             Ruben Westerberg, Edrclaw@mac.comE
483              
484             =head1 COPYRIGHT AND LICENSE
485              
486             Copyright (C) 2023 by Ruben Westerberg
487              
488             Licensed under MIT
489              
490             =head1 DISCLAIMER OF WARRANTIES
491              
492             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
493             INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
494             FITNESS FOR A PARTICULAR PURPOSE.
495              
496             =cut
497