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