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 | }; |
67 | |
68 | my $pkg = shift; |
69 | my $callpkg = shift; |
8990e307 |
70 | my @imports = @_; |
748a9306 |
71 | my($type, $sym); |
72 | *exports = \@{"${pkg}::EXPORT"}; |
8990e307 |
73 | if (@imports) { |
74 | my $oops; |
748a9306 |
75 | *exports = \%{"${pkg}::EXPORT"}; |
8990e307 |
76 | if (!%exports) { |
77 | grep(s/^&//, @exports); |
78 | @exports{@exports} = (1) x @exports; |
748a9306 |
79 | foreach $extra (@{"${pkg}::EXPORT_OK"}) { |
a0d0e21e |
80 | $exports{$extra} = 1; |
81 | } |
8990e307 |
82 | } |
748a9306 |
83 | |
84 | if ($imports[0] =~ m#^[/!:]#){ |
85 | my(@allexports) = keys %exports; |
86 | my $tagsref = \%{"${pkg}::EXPORT_TAGS"}; |
87 | my $tagdata; |
88 | my %imports; |
89 | # negated first item implies starting with default set: |
90 | unshift(@imports, ':DEFAULT') if $imports[0] =~ m/^!/; |
91 | foreach (@imports){ |
92 | my(@names); |
93 | my($mode,$spec) = m/^(!)?(.*)/; |
94 | $mode = '+' unless defined $mode; |
95 | |
96 | @names = ($spec); # default, maybe overridden below |
97 | |
98 | if ($spec =~ m:^/(.*)/$:){ |
99 | my $patn = $1; |
100 | @names = grep(/$patn/, @allexports); # XXX anchor by default? |
101 | } |
102 | elsif ($spec =~ m#^:(.*)# and $tagsref){ |
103 | if ($1 eq 'DEFAULT'){ |
104 | @names = @exports; |
105 | } |
106 | elsif ($tagsref and $tagdata = $tagsref->{$1}) { |
107 | @names = @$tagdata; |
108 | } |
109 | } |
110 | |
111 | warn "Import Mode $mode, Spec $spec, Names @names\n" if $Verbose; |
112 | if ($mode eq '!') { |
113 | map {delete $imports{$_}} @names; # delete @imports{@names} would be handy :-) |
114 | } |
115 | else { |
116 | @imports{@names} = (1) x @names; |
117 | } |
118 | } |
119 | @imports = keys %imports; |
120 | } |
121 | |
8990e307 |
122 | foreach $sym (@imports) { |
123 | if (!$exports{$sym}) { |
e50aee73 |
124 | if ($sym =~ m/^\d/) { |
125 | $pkg->require_version($sym); |
126 | # If the version number was the only thing specified |
127 | # then we should act as if nothing was specified: |
128 | if (@imports == 1) { |
129 | @imports = @exports; |
130 | last; |
131 | } |
132 | } elsif ($sym !~ s/^&// || !$exports{$sym}) { |
748a9306 |
133 | warn qq["$sym" is not exported by the $pkg module ], |
8990e307 |
134 | "at $callfile line $callline\n"; |
135 | $oops++; |
136 | next; |
137 | } |
138 | } |
139 | } |
f06db76b |
140 | Carp::croak("Can't continue with import errors.\n") if $oops; |
8990e307 |
141 | } |
142 | else { |
143 | @imports = @exports; |
144 | } |
748a9306 |
145 | warn "Importing from $pkg into $callpkg: ", |
146 | join(", ",@imports),"\n" if ($Verbose && @imports); |
8990e307 |
147 | foreach $sym (@imports) { |
148 | $type = '&'; |
149 | $type = $1 if $sym =~ s/^(\W)//; |
748a9306 |
150 | *{"${callpkg}::$sym"} = |
151 | $type eq '&' ? \&{"${pkg}::$sym"} : |
152 | $type eq '$' ? \${"${pkg}::$sym"} : |
153 | $type eq '@' ? \@{"${pkg}::$sym"} : |
154 | $type eq '%' ? \%{"${pkg}::$sym"} : |
155 | $type eq '*' ? *{"${pkg}::$sym"} : |
8990e307 |
156 | warn "Can't export symbol: $type$sym\n"; |
157 | } |
158 | }; |
159 | |
a0d0e21e |
160 | sub import { |
748a9306 |
161 | local ($callpkg, $callfile, $callline) = caller($ExportLevel); |
162 | my $pkg = shift; |
163 | export $pkg, $callpkg, @_; |
164 | } |
165 | |
166 | sub export_tags { |
167 | my ($pkg) = caller; |
168 | *tags = \%{"${pkg}::EXPORT_TAGS"}; |
169 | push(@{"${pkg}::EXPORT"}, |
170 | map {$tags{$_} ? @{$tags{$_}} : $_} @_ ? @_ : keys %tags); |
a0d0e21e |
171 | } |
172 | |
e50aee73 |
173 | sub require_version { |
174 | my($self, $wanted) = @_; |
175 | my $pkg = ref $self || $self; |
176 | my $version = ${"${pkg}::VERSION"} || "(undef)"; |
177 | Carp::croak("$pkg $wanted required--this is only version $version") |
178 | if $version < $wanted; |
179 | $version; |
180 | } |
181 | |
8990e307 |
182 | 1; |