File Coverage

blib/lib/Export/These.pm
Criterion Covered Total %
statement 180 188 95.7
branch 43 62 69.3
condition 8 12 66.6
subroutine 16 16 100.0
pod n/a
total 247 278 88.8


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