Refresh CGI to 2.34
[p5sagit/p5-mst-13.2.git] / lib / Exporter.pm
CommitLineData
8990e307 1package Exporter;
2
748a9306 3require 5.001;
8990e307 4
68dc0745 5#
6# We go to a lot of trouble not to 'require Carp' at file scope,
7# because Carp requires Exporter, and something has to give.
8#
9
a0d0e21e 10$ExportLevel = 0;
c07a80fd 11$Verbose = 0 unless $Verbose;
748a9306 12
a0d0e21e 13sub export {
748a9306 14
15 # First make import warnings look like they're coming from the "use".
16 local $SIG{__WARN__} = sub {
17 my $text = shift;
68dc0745 18 if ($text =~ s/ at \S*Exporter.pm line \d+.*\n//) {
19 require Carp;
20 local $Carp::CarpLevel = 1; # ignore package calling us too.
21 Carp::carp($text);
22 }
23 else {
24 warn $text;
25 }
748a9306 26 };
4633a7c4 27 local $SIG{__DIE__} = sub {
68dc0745 28 require Carp;
29 local $Carp::CarpLevel = 1; # ignore package calling us too.
4633a7c4 30 Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
31 if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
32 };
748a9306 33
2b5b2650 34 my($pkg, $callpkg, @imports) = @_;
35 my($type, $sym, $oops);
36 *exports = *{"${pkg}::EXPORT"};
37
8990e307 38 if (@imports) {
8990e307 39 if (!%exports) {
40 grep(s/^&//, @exports);
2b5b2650 41 @exports{@exports} = (1) x @exports;
42 my $ok = \@{"${pkg}::EXPORT_OK"};
43 if (@$ok) {
44 grep(s/^&//, @$ok);
45 @exports{@$ok} = (1) x @$ok;
a0d0e21e 46 }
8990e307 47 }
748a9306 48
49 if ($imports[0] =~ m#^[/!:]#){
748a9306 50 my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
51 my $tagdata;
52 my %imports;
2b5b2650 53 my($remove, $spec, @names, @allexports);
748a9306 54 # negated first item implies starting with default set:
2b5b2650 55 unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
56 foreach $spec (@imports){
57 $remove = $spec =~ s/^!//;
748a9306 58
2b5b2650 59 if ($spec =~ s/^://){
60 if ($spec eq 'DEFAULT'){
748a9306 61 @names = @exports;
62 }
2b5b2650 63 elsif ($tagdata = $tagsref->{$spec}) {
748a9306 64 @names = @$tagdata;
65 }
2b5b2650 66 else {
67 warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];
68 ++$oops;
69 next;
70 }
71 }
72 elsif ($spec =~ m:^/(.*)/$:){
73 my $patn = $1;
74 @allexports = keys %exports unless @allexports; # only do keys once
75 @names = grep(/$patn/, @allexports); # not anchored by default
748a9306 76 }
2b5b2650 77 else {
78 @names = ($spec); # is a normal symbol name
79 }
80
81 warn "Import ".($remove ? "del":"add").": @names "
82 if $Verbose;
748a9306 83
2b5b2650 84 if ($remove) {
85 foreach $sym (@names) { delete $imports{$sym} }
748a9306 86 }
87 else {
2b5b2650 88 @imports{@names} = (1) x @names;
748a9306 89 }
90 }
91 @imports = keys %imports;
92 }
93
8990e307 94 foreach $sym (@imports) {
95 if (!$exports{$sym}) {
e50aee73 96 if ($sym =~ m/^\d/) {
97 $pkg->require_version($sym);
98 # If the version number was the only thing specified
99 # then we should act as if nothing was specified:
100 if (@imports == 1) {
101 @imports = @exports;
102 last;
103 }
3221d3b0 104 # We need a way to emulate 'use Foo ()' but still
105 # allow an easy version check: "use Foo 1.23, ''";
106 if (@imports == 2 and !$imports[1]) {
107 @imports = ();
108 last;
109 }
e50aee73 110 } elsif ($sym !~ s/^&// || !$exports{$sym}) {
2b5b2650 111 warn qq["$sym" is not exported by the $pkg module];
8990e307 112 $oops++;
8990e307 113 }
114 }
115 }
68dc0745 116 if ($oops) {
117 require Carp;
118 Carp::croak("Can't continue after import errors");
119 }
8990e307 120 }
121 else {
122 @imports = @exports;
123 }
2b5b2650 124
125 *fail = *{"${pkg}::EXPORT_FAIL"};
126 if (@fail) {
127 if (!%fail) {
128 # Build cache of symbols. Optimise the lookup by adding
129 # barewords twice... both with and without a leading &.
130 # (Technique could be applied to %exports cache at cost of memory)
131 my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @fail;
132 warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Verbose;
133 @fail{@expanded} = (1) x @expanded;
134 }
135 my @failed;
136 foreach $sym (@imports) { push(@failed, $sym) if $fail{$sym} }
137 if (@failed) {
138 @failed = $pkg->export_fail(@failed);
139 foreach $sym (@failed) {
140 warn qq["$sym" is not implemented by the $pkg module ],
141 "on this architecture";
142 }
68dc0745 143 if (@failed) {
144 require Carp;
145 Carp::croak("Can't continue after import errors");
146 }
2b5b2650 147 }
148 }
149
c07a80fd 150 warn "Importing into $callpkg from $pkg: ",
2b5b2650 151 join(", ",sort @imports) if $Verbose;
152
8990e307 153 foreach $sym (@imports) {
2b5b2650 154 # shortcut for the common case of no type character
155 (*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
156 unless $sym =~ s/^(\W)//;
157 $type = $1;
748a9306 158 *{"${callpkg}::$sym"} =
159 $type eq '&' ? \&{"${pkg}::$sym"} :
160 $type eq '$' ? \${"${pkg}::$sym"} :
161 $type eq '@' ? \@{"${pkg}::$sym"} :
162 $type eq '%' ? \%{"${pkg}::$sym"} :
163 $type eq '*' ? *{"${pkg}::$sym"} :
68dc0745 164 do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
8990e307 165 }
2b5b2650 166}
8990e307 167
a0d0e21e 168sub import {
748a9306 169 my $pkg = shift;
2b5b2650 170 my $callpkg = caller($ExportLevel);
748a9306 171 export $pkg, $callpkg, @_;
172}
173
2b5b2650 174
175# Utility functions
176
177sub _push_tags {
178 my($pkg, $var, $syms) = @_;
179 my $nontag;
c07a80fd 180 *export_tags = \%{"${pkg}::EXPORT_TAGS"};
2b5b2650 181 push(@{"${pkg}::$var"},
182 map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
183 (@$syms) ? @$syms : keys %export_tags);
68dc0745 184 if ($nontag and $^W) {
185 # This may change to a die one day
186 require Carp;
187 Carp::carp("Some names are not tags");
188 }
2b5b2650 189}
190
191sub export_tags { _push_tags((caller)[0], "EXPORT", \@_) }
192sub export_ok_tags { _push_tags((caller)[0], "EXPORT_OK", \@_) }
193
194
195# Default methods
196
197sub export_fail {
a45ab7f6 198 my $self = shift;
2b5b2650 199 @_;
a0d0e21e 200}
201
e50aee73 202sub require_version {
203 my($self, $wanted) = @_;
204 my $pkg = ref $self || $self;
3221d3b0 205 my $version = ${"${pkg}::VERSION"};
206 if (!$version or $version < $wanted) {
207 $version ||= "(undef)";
208 my $file = $INC{"$pkg.pm"};
209 $file &&= " ($file)";
68dc0745 210 require Carp;
3221d3b0 211 Carp::croak("$pkg $wanted required--this is only version $version$file")
212 }
e50aee73 213 $version;
214}
215
8990e307 2161;
2b5b2650 217
218# A simple self test harness. Change 'require Carp' to 'use Carp ()' for testing.
219# package main; eval(join('',<DATA>)) or die $@ unless caller;
220__END__
221package Test;
222$INC{'Exporter.pm'} = 1;
223@ISA = qw(Exporter);
224@EXPORT = qw(A1 A2 A3 A4 A5);
225@EXPORT_OK = qw(B1 B2 B3 B4 B5);
226%EXPORT_TAGS = (T1=>[qw(A1 A2 B1 B2)], T2=>[qw(A1 A2 B3 B4)], T3=>[qw(X3)]);
227@EXPORT_FAIL = qw(B4);
228Exporter::export_ok_tags('T3', 'unknown_tag');
229sub export_fail {
230 map { "Test::$_" } @_ # edit symbols just as an example
231}
232
233package main;
234$Exporter::Verbose = 1;
235#import Test;
236#import Test qw(X3); # export ok via export_ok_tags()
237#import Test qw(:T1 !A2 /5/ !/3/ B5);
238import Test qw(:T2 !B4);
239import Test qw(:T2); # should fail
2401;
241
242=head1 NAME
243
244Exporter - Implements default import method for modules
245
246=head1 SYNOPSIS
247
248In module ModuleName.pm:
249
250 package ModuleName;
251 require Exporter;
252 @ISA = qw(Exporter);
253
254 @EXPORT = qw(...); # symbols to export by default
255 @EXPORT_OK = qw(...); # symbols to export on request
256 %EXPORT_TAGS = tag => [...]; # define names for sets of symbols
257
258In other files which wish to use ModuleName:
259
260 use ModuleName; # import default symbols into my package
261
262 use ModuleName qw(...); # import listed symbols into my package
263
264 use ModuleName (); # do not import any symbols
265
266=head1 DESCRIPTION
267
268The Exporter module implements a default C<import> method which
68dc0745 269many modules choose to inherit rather than implement their own.
2b5b2650 270
271Perl automatically calls the C<import> method when processing a
272C<use> statement for a module. Modules and C<use> are documented
273in L<perlfunc> and L<perlmod>. Understanding the concept of
274modules and how the C<use> statement operates is important to
275understanding the Exporter.
276
277=head2 Selecting What To Export
278
279Do B<not> export method names!
280
281Do B<not> export anything else by default without a good reason!
282
283Exports pollute the namespace of the module user. If you must export
284try to use @EXPORT_OK in preference to @EXPORT and avoid short or
285common symbol names to reduce the risk of name clashes.
286
287Generally anything not exported is still accessible from outside the
1fef88e7 288module using the ModuleName::item_name (or $blessed_ref-E<gt>method)
2b5b2650 289syntax. By convention you can use a leading underscore on names to
290informally indicate that they are 'internal' and not for public use.
291
292(It is actually possible to get private functions by saying:
293
294 my $subref = sub { ... };
295 &$subref;
296
297But there's no way to call that directly as a method, since a method
298must have a name in the symbol table.)
299
300As a general rule, if the module is trying to be object oriented
301then export nothing. If it's just a collection of functions then
302@EXPORT_OK anything but use @EXPORT with caution.
303
304Other module design guidelines can be found in L<perlmod>.
305
306=head2 Specialised Import Lists
307
308If the first entry in an import list begins with !, : or / then the
309list is treated as a series of specifications which either add to or
310delete from the list of names to import. They are processed left to
311right. Specifications are in the form:
312
313 [!]name This name only
314 [!]:DEFAULT All names in @EXPORT
315 [!]:tag All names in $EXPORT_TAGS{tag} anonymous list
316 [!]/pattern/ All names in @EXPORT and @EXPORT_OK which match
317
318A leading ! indicates that matching names should be deleted from the
319list of names to import. If the first specification is a deletion it
320is treated as though preceded by :DEFAULT. If you just want to import
321extra names in addition to the default set you will still need to
322include :DEFAULT explicitly.
323
324e.g., Module.pm defines:
325
326 @EXPORT = qw(A1 A2 A3 A4 A5);
327 @EXPORT_OK = qw(B1 B2 B3 B4 B5);
328 %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
329
330 Note that you cannot use tags in @EXPORT or @EXPORT_OK.
331 Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK.
332
333An application using Module can say something like:
334
335 use Module qw(:DEFAULT :T2 !B3 A3);
336
337Other examples include:
338
339 use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
340 use POSIX qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/);
341
342Remember that most patterns (using //) will need to be anchored
343with a leading ^, e.g., C</^EXIT/> rather than C</EXIT/>.
344
345You can say C<BEGIN { $Exporter::Verbose=1 }> to see how the
346specifications are being processed and what is actually being imported
347into modules.
348
349=head2 Module Version Checking
350
351The Exporter module will convert an attempt to import a number from a
1fef88e7 352module into a call to $module_name-E<gt>require_version($value). This can
2b5b2650 353be used to validate that the version of the module being used is
354greater than or equal to the required version.
355
356The Exporter module supplies a default require_version method which
357checks the value of $VERSION in the exporting module.
358
359Since the default require_version method treats the $VERSION number as
d5e40bcc 360a simple numeric value it will regard version 1.10 as lower than
3611.9. For this reason it is strongly recommended that you use numbers
362with at least two decimal places, e.g., 1.09.
2b5b2650 363
364=head2 Managing Unknown Symbols
365
366In some situations you may want to prevent certain symbols from being
367exported. Typically this applies to extensions which have functions
368or constants that may not exist on some systems.
369
370The names of any symbols that cannot be exported should be listed
371in the C<@EXPORT_FAIL> array.
372
7a2e2cd6 373If a module attempts to import any of these symbols the Exporter
2b5b2650 374will give the module an opportunity to handle the situation before
375generating an error. The Exporter will call an export_fail method
376with a list of the failed symbols:
377
378 @failed_symbols = $module_name->export_fail(@failed_symbols);
379
380If the export_fail method returns an empty list then no error is
381recorded and all the requested symbols are exported. If the returned
382list is not empty then an error is generated for each symbol and the
383export fails. The Exporter provides a default export_fail method which
384simply returns the list unchanged.
385
386Uses for the export_fail method include giving better error messages
387for some symbols and performing lazy architectural checks (put more
388symbols into @EXPORT_FAIL by default and then take them out if someone
389actually tries to use them and an expensive check shows that they are
390usable on that platform).
391
392=head2 Tag Handling Utility Functions
393
394Since the symbols listed within %EXPORT_TAGS must also appear in either
395@EXPORT or @EXPORT_OK, two utility functions are provided which allow
396you to easily add tagged sets of symbols to @EXPORT or @EXPORT_OK:
397
398 %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
399
400 Exporter::export_tags('foo'); # add aa, bb and cc to @EXPORT
401 Exporter::export_ok_tags('bar'); # add aa, cc and dd to @EXPORT_OK
402
403Any names which are not tags are added to @EXPORT or @EXPORT_OK
d5e40bcc 404unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags
2b5b2650 405names being silently added to @EXPORT or @EXPORT_OK. Future versions
406may make this a fatal error.
407
408=cut