File Coverage

blib/lib/Export/These.pm
Criterion Covered Total %
statement 180 188 95.7
branch 41 62 66.1
condition 11 18 61.1
subroutine 16 16 100.0
pod n/a
total 248 284 87.3


line stmt bran cond sub pod time code
1             package Export::These;
2              
3 2     2   145087 use strict;
  2         16  
  2         57  
4 2     2   10 use warnings;
  2         8  
  2         138  
5              
6             our $VERSION="v0.1.1";
7              
8             sub import {
9 7     7   1515 my $package=shift;
10 7         14 my $exporter=caller;
11              
12             #Treat args as key value pairs, unless the value is a string.
13             #in this case it is the name of a symbol to export
14 7         12 my ($k, $v);
15              
16 2     2   11 no strict "refs";
  2         4  
  2         1027  
17              
18             # Locate or create the EXPORT, EXPORT_OK and EXPORT_TAGS package variables.
19             # These are used to accumulate our exported symbol names across multiple
20             # use Export::Terse ...; statements
21             #
22 7         11 my $export_ok= \@{"@{[$exporter]}::EXPORT_OK"};
  7         10  
  7         48  
23 7         14 my $export= \@{"@{[$exporter]}::EXPORT"};
  7         10  
  7         25  
24 7         17 my $export_tags= \%{"@{[$exporter]}::EXPORT_TAGS"};
  7         7  
  7         27  
25              
26 7         22 while(@_){
27 16         23 $k=shift;
28              
29 16 50       32 die "Expecting symbol name or group name" if ref $k;
30 16         22 my $r=ref $_[0];
31 16 100       28 unless($r){
32 12         18 push @$export, $k;
33 12         17 push @$export_ok, $k;
34             next
35 12         27 }
36 4         6 my $v=shift;
37              
38 4         9 for($k){
39 4 50 33     24 if(/export_ok$/ and $r eq "ARRAY"){
    50 33        
    50          
40 0         0 push @$export_ok, @$v;
41             }
42             elsif(/export$/ and $r eq "ARRAY"){
43 0         0 push @$export, @$v;
44 0         0 push @$export_ok, @$v;
45             }
46             elsif($r eq "ARRAY"){
47             #Assume key is a tag name
48 4         12 push $export_tags->{$k}->@*, @$v;
49 4         17 push @$export_ok, @$v;
50             }
51             else {
52 0         0 die "Unkown export grouping: $k";
53             }
54             }
55             }
56              
57             # Generate the import sub here if it doesn't exist already
58              
59 7         12 local $"= " ";
60 7         16 my $exist=eval {*{\${$exporter."::"}{import}}{CODE}};
  7         8  
  7         22  
  7         51  
61 7 100       21 if($exist){
62 2         386 return;
63             }
64              
65 2 100 100 2   15 my $res=eval qq|
  2 50 100 2   4  
  2 50 100 2   139  
  2 50 50 2   13  
  2 100 50 1   3  
  2 100 50 1   891  
  2 50   4   15  
  2 100   2   4  
  2 50   1   161  
  2 100   4   21  
  2 50   2   4  
  2 100   1   870  
  1 100       7  
  1 50       2  
  1 50       94  
  1 0       6  
  1 100       2  
  1 50       468  
  5 50       9  
  4 100       5  
  4 50       8  
  4 50       7  
  4 50       7  
  4 50       7  
  4         14  
  6         9  
  6         26  
  2         7  
  2         5  
  2         7  
  4         6  
  4         11  
  4         34  
  4         13  
  4         9  
  6         19  
  6         13  
  8         19  
  8         9  
  8         13  
  8         17  
  8         29  
  8         12  
  8         11  
  8         31  
  8         11  
  8         20  
  8         34  
  2         7  
  2         5  
  2         3  
  2         4  
  2         4  
  2         7  
  5         7  
  5         14  
  1         3  
  1         3  
  1         4  
  4         7  
  4         11  
  4         51  
  4         11  
  4         8  
  5         14  
  5         9  
  8         13  
  8         13  
  8         12  
  8         17  
  8         21  
  8         10  
  8         10  
  8         68  
  8         9  
  8         33  
  8         31  
  1         2  
  1         2  
  1         1  
  1         2  
  1         2  
  1         3  
  5         8  
  5         10  
  0         0  
  0         0  
  0         0  
  5         9  
  5         12  
  5         61  
  5         12  
  5         10  
  5         13  
  5         9  
  5         10  
  5         6  
  5         8  
  5         10  
  5         15  
  5         8  
  5         7  
  5         22  
  5         5  
  5         13  
  5         20  
  4         135  
  4         14  
  4         21  
  4         16  
  4         14  
  4         8  
  4         4  
  4         6  
  4         31  
  4         2996  
  0         0  
  2         82  
  2         7  
  2         12  
  2         9  
  2         4  
  2         4  
  2         3  
  2         3  
  2         7  
  2         6  
  2         8  
  1         133  
  1         4  
  1         7  
  1         5  
  1         3  
  1         1  
  1         2  
  1         1  
  1         4  
  1         5  
  1         3  
66             package $exporter;
67             no strict "refs";
68              
69              
70             sub _self_export {
71             shift;
72              
73 5         14 my \$ref_export_ok= \\\@@{[$exporter]}::EXPORT_OK;
74 5         12 my \$ref_export= \\\@@{[$exporter]}::EXPORT;
75 5         417 my \$ref_tags= \\\%@{[$exporter]}::EXPORT_TAGS;
76              
77             my \$target=shift;
78              
79             no strict "refs";
80             for(\@_ ? \@_ : \@\$ref_export){
81             my \@syms;
82             if(/^:/){
83             my \$name= s/^://r;
84              
85             my \$group=\$ref_tags->{\$name};
86             #die "Tag \$name does not exists" unless \$group;
87             push \@syms, \@\$group if \$group;
88             }
89             else {
90             #non tag symbol
91             my \$t=\$_;
92             \$t="\\\\\$t" if \$t =~ /^\\\$/;
93             my \$found=grep /\$t/, \@\$ref_export_ok;
94             die "\$_ is not exported from ".__PACKAGE__."\n" unless \$found;
95             push \@syms, \$_;
96             }
97            
98             my \%map=(
99             '\$'=>"SCALAR",
100             '\@'=>"ARRAY",
101             '\%'=>"HASH",
102             '\&'=>"CODE"
103             );
104              
105             for(\@syms){
106             my \$prefix=substr(\$_,0,1);
107             my \$name=\$_;
108             my \$type=\$map{\$prefix};
109              
110             \$name=substr \$_, 1 if \$type;
111             \$type//="CODE";
112             eval { *{\$target."::".\$name}= *{ \\\${__PACKAGE__ ."::"}{\$name}}{\$type}; };
113             die "Could not export \$prefix\$name from ".__PACKAGE__ if \$\@;
114              
115              
116             }
117             }
118              
119              
120             }
121              
122              
123             sub import {
124             my \$package=shift;
125             \$Exporter::ExportLevel//=0;
126             my \$target=(caller(\$Exporter::ExportLevel))[0];
127              
128             $exporter->_self_export(\$target, \@_);
129            
130             local \$Exporter::ExportLevel=\$Exporter::ExportLevel+3;
131             my \$ref=eval {*{\\\${\$package."::"}{_reexport}}{CODE}};
132              
133             if(\$ref){
134             $exporter->_reexport(\$target, \@_);
135             }
136              
137             }
138              
139             1;
140             |;
141 5 50       245 die $@ unless $res;
142             }
143             1;
144              
145              
146             =head1 NAME
147              
148             Export::These - Terse Symbol (Re)Exporting
149              
150              
151             =head1 SYNOPSIS
152              
153             A fine package, exporting subroutines,
154              
155             package My::ModA;
156              
157             use Export::These "dog", "cat", ":colors"=>[qw];
158              
159             sub dog {...}
160             sub cat {...}
161             sub blue {...}
162             sub green {...}
163             1;
164              
165             Another package which would like to reexport the subs from My::ModA:
166              
167             package My::ModB;
168             use My::ModA;
169              
170             use Export::These ":colors"=>["more_colours"];
171              
172             sub _reexport {
173             my ($packate, $target, @names)=@_;
174             My::ModA->import(":colours") if grep /:colours/, @names;
175             }
176            
177             sub more_colours { .... }
178             1;
179              
180              
181             Use package like usual:
182              
183             use My::ModB qw<:colors dog>
184              
185             # suburtines blue, green , more_colors and dog imported
186              
187              
188              
189             =head1 DESCRIPTION
190              
191             A module to make exporting symbols less verbose and facilitate reexporting of
192             symbols from dependencies with minimal input from the module author.
193              
194             By default listing a symbol for export, even in a group/tag, means it will be
195             automatically marked as 'export_ok', saving on duplication and managing two
196             separate lists.
197              
198             It B inherit from C nor does it utilise the C
199             routine from C. It injects its own C subroutine into the each
200             calling package. This injected subroutine adds the desired symbols to the
201             target package as you would expect.
202              
203             If the exporting package has a C<_reexport> subroutine, it is called when being
204             imported. This is the 'hook' location where its safe to call C<-Eimport> on
205             any dependencies modules it might want to export. The symbols from these
206             packages will automatically be installed into the target package with no extra
207             configuration needed.
208              
209              
210              
211             =head1 MOTIVATION
212              
213             Suppose you have a server module, which uses a configuration module to process
214             configuration data. However the main program (which imported the server module)
215             also needs to use the subroutines from the configuration module. The consumer
216             of the server module has to also add the configuration module as a dependency.
217              
218             With this module the server can simply reexport the required configuration
219             routines, injecting the dependency, in stead of hard coding it.
220              
221              
222             =head1 USAGE
223              
224             =head2 Specifying Symbols to Export
225              
226             use Export::These ...;
227              
228             The pragma takes a list of arguments to add to the C<@EXPORT> and C
229             variables. The items are taken as a name of a symbol or tag, unless the
230             following argument in the list is an array ref.
231              
232             eg:
233              
234             use Export::These qw;
235              
236              
237             If the item name is "export_ok", then the items in the following array ref are
238             added to the C<@EXPORT_OK> variable.
239            
240              
241             eg
242             use Export::These export_ok=>[qw];
243              
244              
245             If the item name is "export", then the items in the following array ref are
246             added to the C<@EXPORT_OK> and the C variables. This is the same as
247             simply listing the items at the top level.
248            
249             eg
250              
251             use Export::These export=>[qw];
252             # same as
253             # use Export::These qw;
254              
255              
256             If the item has another name, it is a tag name and the items in the following
257             array ref are added to the C<%EXPORT_TAGS> variable and to C<@EXPORT_OK>
258              
259             eg use Export::These group1=>["sym1"];
260              
261              
262             The list can contain any combination of the above:
263              
264             eq use Export::These "sym1", group1=>["sym2", "sym3"], export_ok=>"sym4";
265              
266              
267             =head2 Rexporting Symbols
268              
269             If a subroutine called C<_reexport> exists in the exporting package, it will be
270             called on (with the -> notation) during import, after the normal symbols have
271             been processed. The first argument is the package name of exporter, the second
272             is the package name of the importer (the target), and the remaining arguments
273             are the names of symbols or tags to import.
274              
275             In this subroutine, you call C on as any packages you want to reexport:
276              
277             eg
278             use Sub::Module;
279             use Another::Mod;
280              
281             sub _reexport {
282             my ($package, $target, @names)=@_;
283              
284             Sub::Module->import;
285             Another::Mod->import(@names);
286             ...
287             }
288              
289             =head2 Conditional Reexporting
290              
291             If you would only like to require and export on certain conditions, some extra
292             steps are needed to ensure correct setup of back end variables. Namely the
293             C<$Exporter::ExportLevel> variable needs to be localized and set to 0 inside a
294             block BEFORE calling the C<-Eimport> subroutine on the package.
295              
296             sub _reexport {
297             my ($package, $target, @names)=@_;
298              
299             if(SOME_CONDITION){
300             {
301             # In an localised block, reset the export level
302             local $Exporter::ExportLevel=0;
303             require Sub::Module;
304             require Another::Module;
305             }
306              
307             Sub::Module->import;
308             Another::Mod->import(@names);
309              
310             }
311             }
312              
313             =head2 Reexport Super Class Symbols
314              
315             Any exported symbols from the inheritance chain can be reexported in the same
316             manner, as long as they are package subroutines and not methods:
317              
318             eg
319              
320             package ModChild;
321             parent ModParent;
322              
323             # or
324            
325             class ModChild :isa(ModParent)
326              
327            
328             sub _reexport {
329             my ($package, $target, @names)=@_;
330             $package->SUPER::import(@names);
331             }
332              
333              
334             =head1 COMPARISON TO OTHER MODULES
335              
336             L Provides clean way to reexport symbols, though you will have to
337             roll your own 'normal' export of symbols from you own package.
338              
339             L Requires a custom package to group the imports and reexports
340             them. This is a different approach and might better suit your needs.
341              
342              
343             Reexporting symbols with C directly is a little cumbersome. You
344             either need to import everything into you module name space (even if you don't
345             need it) and then reexport from there. Alternatively you can import directly
346             into a package, but you need to know at what level in the call stack it is.
347             This is exactly what this module addresses.
348              
349              
350             =head1 REPOSITOTY and BUGS
351              
352             Please report and feature requests or bugs via the github repo:
353              
354             L
355              
356             =head1 AUTHOR
357              
358             Ruben Westerberg, Edrclaw@mac.comE
359              
360             =head1 COPYRIGHT AND LICENSE
361              
362             Copyright (C) 2023 by Ruben Westerberg
363              
364             Licensed under MIT
365              
366             =head1 DISCLAIMER OF WARRANTIES
367              
368             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
369             INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
370             FITNESS FOR A PARTICULAR PURPOSE.
371              
372             =cut
373