Commit | Line | Data |
8990e307 |
1 | package Exporter; |
2 | |
cb1a09d0 |
3 | =head1 NAME |
4 | |
5 | Exporter - provide inport/export controls for Perl modules |
6 | |
7 | =head1 SYNOPSIS |
8 | |
9 | use Module; |
10 | use Module qw(name1 name2 :tag /pattern/ !name); |
11 | |
12 | =head1 DESCRIPTION |
748a9306 |
13 | |
f06db76b |
14 | If the first entry in an import list begins with !, : or / then the |
15 | list is treated as a series of specifications which either add to or |
16 | delete from the list of names to import. They are processed left to |
17 | right. Specifications are in the form: |
748a9306 |
18 | |
748a9306 |
19 | [!]name This name only |
748a9306 |
20 | [!]:DEFAULT All names in @EXPORT |
f06db76b |
21 | [!]:tag All names in $EXPORT_TAGS{tag} anonymous list |
22 | [!]/pattern/ All names in @EXPORT and @EXPORT_OK which match |
748a9306 |
23 | |
f06db76b |
24 | A leading ! indicates that matching names should be deleted from the |
25 | list of names to import. If the first specification is a deletion it |
26 | is treated as though preceded by :DEFAULT. If you just want to import |
27 | extra names in addition to the default set you will still need to |
28 | include :DEFAULT explicitly. |
29 | |
30 | e.g., Module.pm defines: |
748a9306 |
31 | |
32 | @EXPORT = qw(A1 A2 A3 A4 A5); |
33 | @EXPORT_OK = qw(B1 B2 B3 B4 B5); |
f06db76b |
34 | %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]); |
748a9306 |
35 | |
36 | Note that you cannot use tags in @EXPORT or @EXPORT_OK. |
37 | Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK. |
38 | |
39 | Application says: |
40 | |
f06db76b |
41 | use Module qw(:DEFAULT :T2 !B3 A3); |
748a9306 |
42 | use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET); |
43 | use POSIX qw(/^S_/ acos asin atan /^E/ !/^EXIT/); |
44 | |
f06db76b |
45 | You can set C<$Exporter::Verbose=1;> to see how the specifications are |
46 | being processed and what is actually being imported into modules. |
47 | |
e50aee73 |
48 | =head2 Module Version Checking |
49 | |
50 | The Exporter module will convert an attempt to import a number from a |
51 | module into a call to $module_name->require_version($value). This can |
52 | be used to validate that the version of the module being used is |
53 | greater than or equal to the required version. |
54 | |
55 | The Exporter module supplies a default require_version method which |
56 | checks the value of $VERSION in the exporting module. |
57 | |
748a9306 |
58 | =cut |
59 | |
60 | require 5.001; |
8990e307 |
61 | |
a0d0e21e |
62 | $ExportLevel = 0; |
748a9306 |
63 | $Verbose = 0; |
64 | |
65 | require Carp; |
a0d0e21e |
66 | |
67 | sub export { |
748a9306 |
68 | |
69 | # First make import warnings look like they're coming from the "use". |
70 | local $SIG{__WARN__} = sub { |
71 | my $text = shift; |
72 | $text =~ s/ at \S*Exporter.pm line \d+.\n//; |
73 | local $Carp::CarpLevel = 1; # ignore package calling us too. |
74 | Carp::carp($text); |
75 | }; |
4633a7c4 |
76 | local $SIG{__DIE__} = sub { |
77 | Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT") |
78 | if $_[0] =~ /^Unable to create sub named "(.*?)::"/; |
79 | }; |
748a9306 |
80 | |
81 | my $pkg = shift; |
82 | my $callpkg = shift; |
8990e307 |
83 | my @imports = @_; |
748a9306 |
84 | my($type, $sym); |
85 | *exports = \@{"${pkg}::EXPORT"}; |
8990e307 |
86 | if (@imports) { |
87 | my $oops; |
748a9306 |
88 | *exports = \%{"${pkg}::EXPORT"}; |
8990e307 |
89 | if (!%exports) { |
90 | grep(s/^&//, @exports); |
91 | @exports{@exports} = (1) x @exports; |
748a9306 |
92 | foreach $extra (@{"${pkg}::EXPORT_OK"}) { |
a0d0e21e |
93 | $exports{$extra} = 1; |
94 | } |
8990e307 |
95 | } |
748a9306 |
96 | |
97 | if ($imports[0] =~ m#^[/!:]#){ |
98 | my(@allexports) = keys %exports; |
99 | my $tagsref = \%{"${pkg}::EXPORT_TAGS"}; |
100 | my $tagdata; |
101 | my %imports; |
102 | # negated first item implies starting with default set: |
103 | unshift(@imports, ':DEFAULT') if $imports[0] =~ m/^!/; |
104 | foreach (@imports){ |
105 | my(@names); |
106 | my($mode,$spec) = m/^(!)?(.*)/; |
107 | $mode = '+' unless defined $mode; |
108 | |
109 | @names = ($spec); # default, maybe overridden below |
110 | |
111 | if ($spec =~ m:^/(.*)/$:){ |
112 | my $patn = $1; |
113 | @names = grep(/$patn/, @allexports); # XXX anchor by default? |
114 | } |
115 | elsif ($spec =~ m#^:(.*)# and $tagsref){ |
116 | if ($1 eq 'DEFAULT'){ |
117 | @names = @exports; |
118 | } |
119 | elsif ($tagsref and $tagdata = $tagsref->{$1}) { |
120 | @names = @$tagdata; |
121 | } |
122 | } |
123 | |
124 | warn "Import Mode $mode, Spec $spec, Names @names\n" if $Verbose; |
125 | if ($mode eq '!') { |
126 | map {delete $imports{$_}} @names; # delete @imports{@names} would be handy :-) |
127 | } |
128 | else { |
129 | @imports{@names} = (1) x @names; |
130 | } |
131 | } |
132 | @imports = keys %imports; |
133 | } |
134 | |
8990e307 |
135 | foreach $sym (@imports) { |
136 | if (!$exports{$sym}) { |
e50aee73 |
137 | if ($sym =~ m/^\d/) { |
138 | $pkg->require_version($sym); |
139 | # If the version number was the only thing specified |
140 | # then we should act as if nothing was specified: |
141 | if (@imports == 1) { |
142 | @imports = @exports; |
143 | last; |
144 | } |
145 | } elsif ($sym !~ s/^&// || !$exports{$sym}) { |
748a9306 |
146 | warn qq["$sym" is not exported by the $pkg module ], |
8990e307 |
147 | "at $callfile line $callline\n"; |
148 | $oops++; |
149 | next; |
150 | } |
151 | } |
152 | } |
f06db76b |
153 | Carp::croak("Can't continue with import errors.\n") if $oops; |
8990e307 |
154 | } |
155 | else { |
156 | @imports = @exports; |
157 | } |
748a9306 |
158 | warn "Importing from $pkg into $callpkg: ", |
159 | join(", ",@imports),"\n" if ($Verbose && @imports); |
8990e307 |
160 | foreach $sym (@imports) { |
161 | $type = '&'; |
162 | $type = $1 if $sym =~ s/^(\W)//; |
748a9306 |
163 | *{"${callpkg}::$sym"} = |
164 | $type eq '&' ? \&{"${pkg}::$sym"} : |
165 | $type eq '$' ? \${"${pkg}::$sym"} : |
166 | $type eq '@' ? \@{"${pkg}::$sym"} : |
167 | $type eq '%' ? \%{"${pkg}::$sym"} : |
168 | $type eq '*' ? *{"${pkg}::$sym"} : |
8990e307 |
169 | warn "Can't export symbol: $type$sym\n"; |
170 | } |
171 | }; |
172 | |
a0d0e21e |
173 | sub import { |
748a9306 |
174 | local ($callpkg, $callfile, $callline) = caller($ExportLevel); |
175 | my $pkg = shift; |
176 | export $pkg, $callpkg, @_; |
177 | } |
178 | |
179 | sub export_tags { |
180 | my ($pkg) = caller; |
181 | *tags = \%{"${pkg}::EXPORT_TAGS"}; |
182 | push(@{"${pkg}::EXPORT"}, |
183 | map {$tags{$_} ? @{$tags{$_}} : $_} @_ ? @_ : keys %tags); |
a0d0e21e |
184 | } |
185 | |
e50aee73 |
186 | sub require_version { |
187 | my($self, $wanted) = @_; |
188 | my $pkg = ref $self || $self; |
189 | my $version = ${"${pkg}::VERSION"} || "(undef)"; |
190 | Carp::croak("$pkg $wanted required--this is only version $version") |
191 | if $version < $wanted; |
192 | $version; |
193 | } |
194 | |
8990e307 |
195 | 1; |