This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
This is my patch patch.1l for perl5.001.
[perl5.git] / lib / Exporter.pm
CommitLineData
8990e307
LW
1package Exporter;
2
748a9306
LW
3=head1 Comments
4
f06db76b
AD
5If the first entry in an import list begins with !, : or / then the
6list is treated as a series of specifications which either add to or
7delete from the list of names to import. They are processed left to
8right. Specifications are in the form:
748a9306 9
748a9306 10 [!]name This name only
748a9306 11 [!]:DEFAULT All names in @EXPORT
f06db76b
AD
12 [!]:tag All names in $EXPORT_TAGS{tag} anonymous list
13 [!]/pattern/ All names in @EXPORT and @EXPORT_OK which match
748a9306 14
f06db76b
AD
15A leading ! indicates that matching names should be deleted from the
16list of names to import. If the first specification is a deletion it
17is treated as though preceded by :DEFAULT. If you just want to import
18extra names in addition to the default set you will still need to
19include :DEFAULT explicitly.
20
21e.g., Module.pm defines:
748a9306
LW
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
LW
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
30Application says:
31
f06db76b 32 use Module qw(:DEFAULT :T2 !B3 A3);
748a9306
LW
33 use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
34 use POSIX qw(/^S_/ acos asin atan /^E/ !/^EXIT/);
35
f06db76b
AD
36You can set C<$Exporter::Verbose=1;> to see how the specifications are
37being processed and what is actually being imported into modules.
38
748a9306
LW
39=cut
40
41require 5.001;
8990e307 42
a0d0e21e 43$ExportLevel = 0;
748a9306
LW
44$Verbose = 0;
45
46require Carp;
a0d0e21e
LW
47
48sub export {
748a9306
LW
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
LW
61 my($type, $sym);
62 *exports = \@{"${pkg}::EXPORT"};
8990e307
LW
63 if (@imports) {
64 my $oops;
748a9306 65 *exports = \%{"${pkg}::EXPORT"};
8990e307
LW
66 if (!%exports) {
67 grep(s/^&//, @exports);
68 @exports{@exports} = (1) x @exports;
748a9306 69 foreach $extra (@{"${pkg}::EXPORT_OK"}) {
a0d0e21e
LW
70 $exports{$extra} = 1;
71 }
8990e307 72 }
748a9306
LW
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
LW
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
LW
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
LW
123 }
124 else {
125 @imports = @exports;
126 }
748a9306
LW
127 warn "Importing from $pkg into $callpkg: ",
128 join(", ",@imports),"\n" if ($Verbose && @imports);
8990e307
LW
129 foreach $sym (@imports) {
130 $type = '&';
131 $type = $1 if $sym =~ s/^(\W)//;
748a9306
LW
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
LW
138 warn "Can't export symbol: $type$sym\n";
139 }
140};
141
a0d0e21e 142sub import {
748a9306
LW
143 local ($callpkg, $callfile, $callline) = caller($ExportLevel);
144 my $pkg = shift;
145 export $pkg, $callpkg, @_;
146}
147
148sub export_tags {
149 my ($pkg) = caller;
150 *tags = \%{"${pkg}::EXPORT_TAGS"};
151 push(@{"${pkg}::EXPORT"},
152 map {$tags{$_} ? @{$tags{$_}} : $_} @_ ? @_ : keys %tags);
a0d0e21e
LW
153}
154
8990e307 1551;