1#+############################################################################## 2# # 3# File: No/Worries/Export.pm # 4# # 5# Description: symbol exporting without worries # 6# # 7#-############################################################################## 8 9# 10# module definition 11# 12 13package No::Worries::Export; 14use strict; 15use warnings; 16our $VERSION = "1.6"; 17our $REVISION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/); 18 19# 20# used modules 21# 22 23use Params::Validate qw(validate_with :types); 24 25# 26# simple yet powerful export control 27# 28 29sub export_control ($$$@) { 30 my($callpkg, $pkg, $exported, @names) = @_; 31 my($name, $regexp, $ref); 32 33 validate_with( 34 params => \@_, 35 spec => [ { type => SCALAR }, { type => SCALAR }, { type => HASHREF } ], 36 allow_extra => 1, 37 ); 38 while (@names) { 39 $name = shift(@names); 40 # special case for * and /.../ and x.y 41 if ($name eq "*") { 42 unshift(@names, grep(!ref($exported->{$_}), keys(%{ $exported }))); 43 next; 44 } elsif ($name =~ /^\/(.*)\/$/) { 45 $regexp = $1; 46 unshift(@names, grep(/$regexp/, grep(!ref($exported->{$_}), 47 keys(%{ $exported })))); 48 next; 49 } elsif ($name =~ /^\d/) { 50 # version checking via UNIVERSAL 51 $pkg->VERSION($name); 52 next; 53 } 54 die("\"$name\" is not exported by the $pkg module\n") 55 unless defined($exported->{$name}); 56 $ref = ref($exported->{$name}); 57 if ($ref eq "") { 58 # normal symbol 59 if ($name =~ /^(\w+)$/) { 60 # function 61 no strict qw(refs); 62 no warnings qw(once prototype); 63 *{"${callpkg}::${1}"} = \&{"${pkg}::${1}"}; 64 } elsif ($name =~ /^\$(\w+)$/) { 65 # scalar 66 no strict qw(refs); 67 *{"${callpkg}::${1}"} = \${"${pkg}::${1}"}; 68 } elsif ($name =~ /^\@(\w+)$/) { 69 # array 70 no strict qw(refs); 71 *{"${callpkg}::${1}"} = \@{"${pkg}::${1}"}; 72 } elsif ($name =~ /^\%(\w+)$/) { 73 # hash 74 no strict qw(refs); 75 *{"${callpkg}::${1}"} = \%{"${pkg}::${1}"}; 76 } else { 77 die("unsupported export by the $pkg module: $name\n"); 78 } 79 } elsif ($ref eq "CODE") { 80 # special symbol 81 $exported->{$name}->($name); 82 } else { 83 die("unsupported export by the $pkg module: $name=$ref\n"); 84 } 85 } 86} 87 88# 89# export control 90# 91 92sub import : method { 93 my($pkg, %exported); 94 95 $pkg = shift(@_); 96 grep($exported{$_}++, qw(export_control)); 97 export_control(scalar(caller()), $pkg, \%exported, @_); 98} 99 1001; 101 102__DATA__ 103 104=head1 NAME 105 106No::Worries::Export - symbol exporting without worries 107 108=head1 SYNOPSIS 109 110 use No::Worries::Export qw(export_control); 111 112 sub foo () { ... } 113 114 our $bar = 42; 115 116 sub import : method { 117 my($pkg, %exported); 118 $pkg = shift(@_); 119 grep($exported{$_}++, qw(foo $bar)); 120 export_control(scalar(caller()), $pkg, \%exported, @_); 121 } 122 123=head1 DESCRIPTION 124 125This module eases symbol exporting by providing a simple yet powerful 126alternative to the L<Exporter> module. 127 128The symbols that can be imported are defined in a hash (the third 129argument of export_control()), the key being the symbol name and the 130value being: 131 132=over 133 134=item * a scalar: indicating a normal symbol 135 136=item * a code reference: to be called at import time 137 138=back 139 140The normal symbols can be functions (such as C<foo>), scalars 141(<$foo>), arrays (<@foo>) or hashes (<%foo>). 142 143All the normal symbols can be imported at once by using an asterisk in 144the import code: 145 146 use Foo qw(*); 147 148Alternatively, a regular expression can be given to filter what to 149import: 150 151 # import "foo" and all the normal symbols starting with "bar" 152 use Foo qw(foo /^bar/); 153 154The special symbols can be used to execute any code. For instance: 155 156 # exporting module 157 our $backend = "stdout"; 158 sub import : method { 159 my($pkg, %exported); 160 $pkg = shift(@_); 161 $exported{syslog} = sub { $backend = "syslog" }; 162 export_control(scalar(caller()), $pkg, \%exported, @_); 163 } 164 165 # importing code 166 use Foo qw(syslog); 167 168Finally, anything looking like a number will trigger a version check: 169 170 use Foo qw(1.2); 171 # will trigger 172 Foo->VERSION(1.2); 173 174See L<UNIVERSAL> for more information on the VERSION() mthod. 175 176=head1 FUNCTIONS 177 178This module provides the following function (not exported by default): 179 180=over 181 182=item export_control(CALLERPKG, PKG, EXPORT, NAMES...) 183 184control the symbols exported by the module; this should be called from 185an C<import> method 186 187=back 188 189=head1 SEE ALSO 190 191L<Exporter>, 192L<No::Worries>. 193 194=head1 AUTHOR 195 196Lionel Cons L<http://cern.ch/lionel.cons> 197 198Copyright (C) CERN 2012-2019 199