This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
VMS patches.
[perl5.git] / lib / Exporter.pm
CommitLineData
8990e307
LW
1package Exporter;
2
cb1a09d0
AD
3=head1 NAME
4
5Exporter - provide inport/export controls for Perl modules
6
7=head1 SYNOPSIS
8
9use Module;
10use Module qw(name1 name2 :tag /pattern/ !name);
11
12=head1 DESCRIPTION
748a9306 13
f06db76b
AD
14If the first entry in an import list begins with !, : or / then the
15list is treated as a series of specifications which either add to or
16delete from the list of names to import. They are processed left to
17right. Specifications are in the form:
748a9306 18
748a9306 19 [!]name This name only
748a9306 20 [!]:DEFAULT All names in @EXPORT
f06db76b
AD
21 [!]:tag All names in $EXPORT_TAGS{tag} anonymous list
22 [!]/pattern/ All names in @EXPORT and @EXPORT_OK which match
748a9306 23
f06db76b
AD
24A leading ! indicates that matching names should be deleted from the
25list of names to import. If the first specification is a deletion it
26is treated as though preceded by :DEFAULT. If you just want to import
27extra names in addition to the default set you will still need to
28include :DEFAULT explicitly.
29
30e.g., Module.pm defines:
748a9306
LW
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
LW
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
39Application says:
40
f06db76b 41 use Module qw(:DEFAULT :T2 !B3 A3);
748a9306
LW
42 use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
43 use POSIX qw(/^S_/ acos asin atan /^E/ !/^EXIT/);
44
f06db76b
AD
45You can set C<$Exporter::Verbose=1;> to see how the specifications are
46being processed and what is actually being imported into modules.
47
e50aee73
AD
48=head2 Module Version Checking
49
50The Exporter module will convert an attempt to import a number from a
51module into a call to $module_name->require_version($value). This can
52be used to validate that the version of the module being used is
53greater than or equal to the required version.
54
55The Exporter module supplies a default require_version method which
56checks the value of $VERSION in the exporting module.
57
748a9306
LW
58=cut
59
60require 5.001;
8990e307 61
a0d0e21e 62$ExportLevel = 0;
748a9306
LW
63$Verbose = 0;
64
65require Carp;
a0d0e21e
LW
66
67sub export {
748a9306
LW
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
LW
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
LW
80
81 my $pkg = shift;
82 my $callpkg = shift;
8990e307 83 my @imports = @_;
748a9306
LW
84 my($type, $sym);
85 *exports = \@{"${pkg}::EXPORT"};
8990e307
LW
86 if (@imports) {
87 my $oops;
748a9306 88 *exports = \%{"${pkg}::EXPORT"};
8990e307
LW
89 if (!%exports) {
90 grep(s/^&//, @exports);
91 @exports{@exports} = (1) x @exports;
748a9306 92 foreach $extra (@{"${pkg}::EXPORT_OK"}) {
a0d0e21e
LW
93 $exports{$extra} = 1;
94 }
8990e307 95 }
748a9306
LW
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
LW
135 foreach $sym (@imports) {
136 if (!$exports{$sym}) {
e50aee73
AD
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
LW
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
LW
154 }
155 else {
156 @imports = @exports;
157 }
748a9306
LW
158 warn "Importing from $pkg into $callpkg: ",
159 join(", ",@imports),"\n" if ($Verbose && @imports);
8990e307
LW
160 foreach $sym (@imports) {
161 $type = '&';
162 $type = $1 if $sym =~ s/^(\W)//;
748a9306
LW
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
LW
169 warn "Can't export symbol: $type$sym\n";
170 }
171};
172
a0d0e21e 173sub import {
748a9306
LW
174 local ($callpkg, $callfile, $callline) = caller($ExportLevel);
175 my $pkg = shift;
176 export $pkg, $callpkg, @_;
177}
178
179sub export_tags {
180 my ($pkg) = caller;
181 *tags = \%{"${pkg}::EXPORT_TAGS"};
182 push(@{"${pkg}::EXPORT"},
183 map {$tags{$_} ? @{$tags{$_}} : $_} @_ ? @_ : keys %tags);
a0d0e21e
LW
184}
185
e50aee73
AD
186sub 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 1951;