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 | |
748a9306 |
39 | =cut |
40 | |
41 | require 5.001; |
8990e307 |
42 | |
a0d0e21e |
43 | $ExportLevel = 0; |
748a9306 |
44 | $Verbose = 0; |
45 | |
46 | require Carp; |
a0d0e21e |
47 | |
48 | sub export { |
748a9306 |
49 | |
50 | # First make import warnings look like they're coming from the "use". |
51 | local $SIG{__WARN__} = sub { |
52 | my $text = shift; |
53 | $text =~ s/ at \S*Exporter.pm line \d+.\n//; |
54 | local $Carp::CarpLevel = 1; # ignore package calling us too. |
55 | Carp::carp($text); |
56 | }; |
57 | |
58 | my $pkg = shift; |
59 | my $callpkg = shift; |
8990e307 |
60 | my @imports = @_; |
748a9306 |
61 | my($type, $sym); |
62 | *exports = \@{"${pkg}::EXPORT"}; |
8990e307 |
63 | if (@imports) { |
64 | my $oops; |
748a9306 |
65 | *exports = \%{"${pkg}::EXPORT"}; |
8990e307 |
66 | if (!%exports) { |
67 | grep(s/^&//, @exports); |
68 | @exports{@exports} = (1) x @exports; |
748a9306 |
69 | foreach $extra (@{"${pkg}::EXPORT_OK"}) { |
a0d0e21e |
70 | $exports{$extra} = 1; |
71 | } |
8990e307 |
72 | } |
748a9306 |
73 | |
74 | if ($imports[0] =~ m#^[/!:]#){ |
75 | my(@allexports) = keys %exports; |
76 | my $tagsref = \%{"${pkg}::EXPORT_TAGS"}; |
77 | my $tagdata; |
78 | my %imports; |
79 | # negated first item implies starting with default set: |
80 | unshift(@imports, ':DEFAULT') if $imports[0] =~ m/^!/; |
81 | foreach (@imports){ |
82 | my(@names); |
83 | my($mode,$spec) = m/^(!)?(.*)/; |
84 | $mode = '+' unless defined $mode; |
85 | |
86 | @names = ($spec); # default, maybe overridden below |
87 | |
88 | if ($spec =~ m:^/(.*)/$:){ |
89 | my $patn = $1; |
90 | @names = grep(/$patn/, @allexports); # XXX anchor by default? |
91 | } |
92 | elsif ($spec =~ m#^:(.*)# and $tagsref){ |
93 | if ($1 eq 'DEFAULT'){ |
94 | @names = @exports; |
95 | } |
96 | elsif ($tagsref and $tagdata = $tagsref->{$1}) { |
97 | @names = @$tagdata; |
98 | } |
99 | } |
100 | |
101 | warn "Import Mode $mode, Spec $spec, Names @names\n" if $Verbose; |
102 | if ($mode eq '!') { |
103 | map {delete $imports{$_}} @names; # delete @imports{@names} would be handy :-) |
104 | } |
105 | else { |
106 | @imports{@names} = (1) x @names; |
107 | } |
108 | } |
109 | @imports = keys %imports; |
110 | } |
111 | |
8990e307 |
112 | foreach $sym (@imports) { |
113 | if (!$exports{$sym}) { |
114 | if ($sym !~ s/^&// || !$exports{$sym}) { |
748a9306 |
115 | warn qq["$sym" is not exported by the $pkg module ], |
8990e307 |
116 | "at $callfile line $callline\n"; |
117 | $oops++; |
118 | next; |
119 | } |
120 | } |
121 | } |
f06db76b |
122 | Carp::croak("Can't continue with import errors.\n") if $oops; |
8990e307 |
123 | } |
124 | else { |
125 | @imports = @exports; |
126 | } |
748a9306 |
127 | warn "Importing from $pkg into $callpkg: ", |
128 | join(", ",@imports),"\n" if ($Verbose && @imports); |
8990e307 |
129 | foreach $sym (@imports) { |
130 | $type = '&'; |
131 | $type = $1 if $sym =~ s/^(\W)//; |
748a9306 |
132 | *{"${callpkg}::$sym"} = |
133 | $type eq '&' ? \&{"${pkg}::$sym"} : |
134 | $type eq '$' ? \${"${pkg}::$sym"} : |
135 | $type eq '@' ? \@{"${pkg}::$sym"} : |
136 | $type eq '%' ? \%{"${pkg}::$sym"} : |
137 | $type eq '*' ? *{"${pkg}::$sym"} : |
8990e307 |
138 | warn "Can't export symbol: $type$sym\n"; |
139 | } |
140 | }; |
141 | |
a0d0e21e |
142 | sub import { |
748a9306 |
143 | local ($callpkg, $callfile, $callline) = caller($ExportLevel); |
144 | my $pkg = shift; |
145 | export $pkg, $callpkg, @_; |
146 | } |
147 | |
148 | sub export_tags { |
149 | my ($pkg) = caller; |
150 | *tags = \%{"${pkg}::EXPORT_TAGS"}; |
151 | push(@{"${pkg}::EXPORT"}, |
152 | map {$tags{$_} ? @{$tags{$_}} : $_} @_ ? @_ : keys %tags); |
a0d0e21e |
153 | } |
154 | |
8990e307 |
155 | 1; |