Initial VMS patches
[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}) {
3bb63ce6 111 require Carp;
112 Carp::carp(qq["$sym" is not exported by the $pkg module]);
8990e307 113 $oops++;
8990e307 114 }
115 }
116 }
68dc0745 117 if ($oops) {
118 require Carp;
119 Carp::croak("Can't continue after import errors");
120 }
8990e307 121 }
122 else {
123 @imports = @exports;
124 }
2b5b2650 125
126 *fail = *{"${pkg}::EXPORT_FAIL"};
127 if (@fail) {
128 if (!%fail) {
129 # Build cache of symbols. Optimise the lookup by adding
130 # barewords twice... both with and without a leading &.
131 # (Technique could be applied to %exports cache at cost of memory)
132 my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @fail;
133 warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Verbose;
134 @fail{@expanded} = (1) x @expanded;
135 }
136 my @failed;
137 foreach $sym (@imports) { push(@failed, $sym) if $fail{$sym} }
138 if (@failed) {
139 @failed = $pkg->export_fail(@failed);
140 foreach $sym (@failed) {
3bb63ce6 141 require Carp;
142 Carp::carp(qq["$sym" is not implemented by the $pkg module ],
143 "on this architecture");
2b5b2650 144 }
68dc0745 145 if (@failed) {
146 require Carp;
147 Carp::croak("Can't continue after import errors");
148 }
2b5b2650 149 }
150 }
151
c07a80fd 152 warn "Importing into $callpkg from $pkg: ",
2b5b2650 153 join(", ",sort @imports) if $Verbose;
154
8990e307 155 foreach $sym (@imports) {
2b5b2650 156 # shortcut for the common case of no type character
157 (*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
158 unless $sym =~ s/^(\W)//;
159 $type = $1;
748a9306 160 *{"${callpkg}::$sym"} =
161 $type eq '&' ? \&{"${pkg}::$sym"} :
162 $type eq '$' ? \${"${pkg}::$sym"} :
163 $type eq '@' ? \@{"${pkg}::$sym"} :
164 $type eq '%' ? \%{"${pkg}::$sym"} :
165 $type eq '*' ? *{"${pkg}::$sym"} :
68dc0745 166 do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
8990e307 167 }
2b5b2650 168}
8990e307 169
84902520 170sub export_to_level
171{
172 my $pkg = shift;
e49da4e7 173 my $level = shift;
84902520 174 my $callpkg = caller($level);
175 $pkg->export($callpkg, @_);
176}
177
a0d0e21e 178sub import {
748a9306 179 my $pkg = shift;
2b5b2650 180 my $callpkg = caller($ExportLevel);
748a9306 181 export $pkg, $callpkg, @_;
182}
183
2b5b2650 184
84902520 185
2b5b2650 186# Utility functions
187
188sub _push_tags {
189 my($pkg, $var, $syms) = @_;
190 my $nontag;
c07a80fd 191 *export_tags = \%{"${pkg}::EXPORT_TAGS"};
2b5b2650 192 push(@{"${pkg}::$var"},
193 map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
194 (@$syms) ? @$syms : keys %export_tags);
68dc0745 195 if ($nontag and $^W) {
196 # This may change to a die one day
197 require Carp;
198 Carp::carp("Some names are not tags");
199 }
2b5b2650 200}
201
202sub export_tags { _push_tags((caller)[0], "EXPORT", \@_) }
203sub export_ok_tags { _push_tags((caller)[0], "EXPORT_OK", \@_) }
204
205
206# Default methods
207
208sub export_fail {
a45ab7f6 209 my $self = shift;
2b5b2650 210 @_;
a0d0e21e 211}
212
e50aee73 213sub require_version {
214 my($self, $wanted) = @_;
215 my $pkg = ref $self || $self;
3221d3b0 216 my $version = ${"${pkg}::VERSION"};
217 if (!$version or $version < $wanted) {
218 $version ||= "(undef)";
219 my $file = $INC{"$pkg.pm"};
220 $file &&= " ($file)";
68dc0745 221 require Carp;
3221d3b0 222 Carp::croak("$pkg $wanted required--this is only version $version$file")
223 }
e50aee73 224 $version;
225}
226
8990e307 2271;
2b5b2650 228
229# A simple self test harness. Change 'require Carp' to 'use Carp ()' for testing.
230# package main; eval(join('',<DATA>)) or die $@ unless caller;
231__END__
232package Test;
233$INC{'Exporter.pm'} = 1;
234@ISA = qw(Exporter);
235@EXPORT = qw(A1 A2 A3 A4 A5);
236@EXPORT_OK = qw(B1 B2 B3 B4 B5);
237%EXPORT_TAGS = (T1=>[qw(A1 A2 B1 B2)], T2=>[qw(A1 A2 B3 B4)], T3=>[qw(X3)]);
238@EXPORT_FAIL = qw(B4);
239Exporter::export_ok_tags('T3', 'unknown_tag');
240sub export_fail {
241 map { "Test::$_" } @_ # edit symbols just as an example
242}
243
244package main;
245$Exporter::Verbose = 1;
246#import Test;
247#import Test qw(X3); # export ok via export_ok_tags()
248#import Test qw(:T1 !A2 /5/ !/3/ B5);
249import Test qw(:T2 !B4);
250import Test qw(:T2); # should fail
2511;
252
253=head1 NAME
254
255Exporter - Implements default import method for modules
256
257=head1 SYNOPSIS
258
259In module ModuleName.pm:
260
261 package ModuleName;
262 require Exporter;
263 @ISA = qw(Exporter);
264
265 @EXPORT = qw(...); # symbols to export by default
266 @EXPORT_OK = qw(...); # symbols to export on request
267 %EXPORT_TAGS = tag => [...]; # define names for sets of symbols
268
269In other files which wish to use ModuleName:
270
271 use ModuleName; # import default symbols into my package
272
273 use ModuleName qw(...); # import listed symbols into my package
274
275 use ModuleName (); # do not import any symbols
276
277=head1 DESCRIPTION
278
279The Exporter module implements a default C<import> method which
68dc0745 280many modules choose to inherit rather than implement their own.
2b5b2650 281
282Perl automatically calls the C<import> method when processing a
283C<use> statement for a module. Modules and C<use> are documented
284in L<perlfunc> and L<perlmod>. Understanding the concept of
285modules and how the C<use> statement operates is important to
286understanding the Exporter.
287
288=head2 Selecting What To Export
289
290Do B<not> export method names!
291
292Do B<not> export anything else by default without a good reason!
293
294Exports pollute the namespace of the module user. If you must export
295try to use @EXPORT_OK in preference to @EXPORT and avoid short or
296common symbol names to reduce the risk of name clashes.
297
298Generally anything not exported is still accessible from outside the
1fef88e7 299module using the ModuleName::item_name (or $blessed_ref-E<gt>method)
2b5b2650 300syntax. By convention you can use a leading underscore on names to
301informally indicate that they are 'internal' and not for public use.
302
303(It is actually possible to get private functions by saying:
304
305 my $subref = sub { ... };
306 &$subref;
307
308But there's no way to call that directly as a method, since a method
309must have a name in the symbol table.)
310
311As a general rule, if the module is trying to be object oriented
312then export nothing. If it's just a collection of functions then
313@EXPORT_OK anything but use @EXPORT with caution.
314
315Other module design guidelines can be found in L<perlmod>.
316
317=head2 Specialised Import Lists
318
319If the first entry in an import list begins with !, : or / then the
320list is treated as a series of specifications which either add to or
321delete from the list of names to import. They are processed left to
322right. Specifications are in the form:
323
324 [!]name This name only
325 [!]:DEFAULT All names in @EXPORT
326 [!]:tag All names in $EXPORT_TAGS{tag} anonymous list
327 [!]/pattern/ All names in @EXPORT and @EXPORT_OK which match
328
329A leading ! indicates that matching names should be deleted from the
330list of names to import. If the first specification is a deletion it
331is treated as though preceded by :DEFAULT. If you just want to import
332extra names in addition to the default set you will still need to
333include :DEFAULT explicitly.
334
335e.g., Module.pm defines:
336
337 @EXPORT = qw(A1 A2 A3 A4 A5);
338 @EXPORT_OK = qw(B1 B2 B3 B4 B5);
339 %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
340
341 Note that you cannot use tags in @EXPORT or @EXPORT_OK.
342 Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK.
343
344An application using Module can say something like:
345
346 use Module qw(:DEFAULT :T2 !B3 A3);
347
348Other examples include:
349
350 use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
351 use POSIX qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/);
352
353Remember that most patterns (using //) will need to be anchored
354with a leading ^, e.g., C</^EXIT/> rather than C</EXIT/>.
355
356You can say C<BEGIN { $Exporter::Verbose=1 }> to see how the
357specifications are being processed and what is actually being imported
358into modules.
359
84902520 360=head2 Exporting without using Export's import method
361
362Exporter has a special method, 'export_to_level' which is used in situations
363where you can't directly call Export's import method. The export_to_level
364method looks like:
365
366MyPackage->export_to_level($where_to_export, @what_to_export);
367
368where $where_to_export is an integer telling how far up the calling stack
369to export your symbols, and @what_to_export is an array telling what
370symbols *to* export (usually this is @_).
371
372For example, suppose that you have a module, A, which already has an
373import function:
374
375package A;
376
377@ISA = qw(Exporter);
378@EXPORT_OK = qw ($b);
379
380sub import
381{
382 $A::b = 1; # not a very useful import method
383}
384
385and you want to Export symbol $A::b back to the module that called
386package A. Since Exporter relies on the import method to work, via
387inheritance, as it stands Exporter::import() will never get called.
388Instead, say the following:
389
390package A;
391@ISA = qw(Exporter);
392@EXPORT_OK = qw ($b);
393
394sub import
395{
396 $A::b = 1;
397 A->export_to_level(1, @_);
398}
399
400This will export the symbols one level 'above' the current package - ie: to
401the program or module that used package A.
402
403Note: Be careful not to modify '@_' at all before you call export_to_level
404- or people using your package will get very unexplained results!
405
406
2b5b2650 407=head2 Module Version Checking
408
409The Exporter module will convert an attempt to import a number from a
1fef88e7 410module into a call to $module_name-E<gt>require_version($value). This can
2b5b2650 411be used to validate that the version of the module being used is
412greater than or equal to the required version.
413
414The Exporter module supplies a default require_version method which
415checks the value of $VERSION in the exporting module.
416
417Since the default require_version method treats the $VERSION number as
d5e40bcc 418a simple numeric value it will regard version 1.10 as lower than
4191.9. For this reason it is strongly recommended that you use numbers
420with at least two decimal places, e.g., 1.09.
2b5b2650 421
422=head2 Managing Unknown Symbols
423
424In some situations you may want to prevent certain symbols from being
425exported. Typically this applies to extensions which have functions
426or constants that may not exist on some systems.
427
428The names of any symbols that cannot be exported should be listed
429in the C<@EXPORT_FAIL> array.
430
7a2e2cd6 431If a module attempts to import any of these symbols the Exporter
2b5b2650 432will give the module an opportunity to handle the situation before
433generating an error. The Exporter will call an export_fail method
434with a list of the failed symbols:
435
436 @failed_symbols = $module_name->export_fail(@failed_symbols);
437
438If the export_fail method returns an empty list then no error is
439recorded and all the requested symbols are exported. If the returned
440list is not empty then an error is generated for each symbol and the
441export fails. The Exporter provides a default export_fail method which
442simply returns the list unchanged.
443
444Uses for the export_fail method include giving better error messages
445for some symbols and performing lazy architectural checks (put more
446symbols into @EXPORT_FAIL by default and then take them out if someone
447actually tries to use them and an expensive check shows that they are
448usable on that platform).
449
450=head2 Tag Handling Utility Functions
451
452Since the symbols listed within %EXPORT_TAGS must also appear in either
453@EXPORT or @EXPORT_OK, two utility functions are provided which allow
454you to easily add tagged sets of symbols to @EXPORT or @EXPORT_OK:
455
456 %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
457
458 Exporter::export_tags('foo'); # add aa, bb and cc to @EXPORT
459 Exporter::export_ok_tags('bar'); # add aa, cc and dd to @EXPORT_OK
460
461Any names which are not tags are added to @EXPORT or @EXPORT_OK
d5e40bcc 462unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags
2b5b2650 463names being silently added to @EXPORT or @EXPORT_OK. Future versions
464may make this a fatal error.
465
466=cut