Repost of fork() debugger patch
[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
a0d0e21e 170sub import {
748a9306 171 my $pkg = shift;
2b5b2650 172 my $callpkg = caller($ExportLevel);
748a9306 173 export $pkg, $callpkg, @_;
174}
175
2b5b2650 176
177# Utility functions
178
179sub _push_tags {
180 my($pkg, $var, $syms) = @_;
181 my $nontag;
c07a80fd 182 *export_tags = \%{"${pkg}::EXPORT_TAGS"};
2b5b2650 183 push(@{"${pkg}::$var"},
184 map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
185 (@$syms) ? @$syms : keys %export_tags);
68dc0745 186 if ($nontag and $^W) {
187 # This may change to a die one day
188 require Carp;
189 Carp::carp("Some names are not tags");
190 }
2b5b2650 191}
192
193sub export_tags { _push_tags((caller)[0], "EXPORT", \@_) }
194sub export_ok_tags { _push_tags((caller)[0], "EXPORT_OK", \@_) }
195
196
197# Default methods
198
199sub export_fail {
a45ab7f6 200 my $self = shift;
2b5b2650 201 @_;
a0d0e21e 202}
203
e50aee73 204sub require_version {
205 my($self, $wanted) = @_;
206 my $pkg = ref $self || $self;
3221d3b0 207 my $version = ${"${pkg}::VERSION"};
208 if (!$version or $version < $wanted) {
209 $version ||= "(undef)";
210 my $file = $INC{"$pkg.pm"};
211 $file &&= " ($file)";
68dc0745 212 require Carp;
3221d3b0 213 Carp::croak("$pkg $wanted required--this is only version $version$file")
214 }
e50aee73 215 $version;
216}
217
8990e307 2181;
2b5b2650 219
220# A simple self test harness. Change 'require Carp' to 'use Carp ()' for testing.
221# package main; eval(join('',<DATA>)) or die $@ unless caller;
222__END__
223package Test;
224$INC{'Exporter.pm'} = 1;
225@ISA = qw(Exporter);
226@EXPORT = qw(A1 A2 A3 A4 A5);
227@EXPORT_OK = qw(B1 B2 B3 B4 B5);
228%EXPORT_TAGS = (T1=>[qw(A1 A2 B1 B2)], T2=>[qw(A1 A2 B3 B4)], T3=>[qw(X3)]);
229@EXPORT_FAIL = qw(B4);
230Exporter::export_ok_tags('T3', 'unknown_tag');
231sub export_fail {
232 map { "Test::$_" } @_ # edit symbols just as an example
233}
234
235package main;
236$Exporter::Verbose = 1;
237#import Test;
238#import Test qw(X3); # export ok via export_ok_tags()
239#import Test qw(:T1 !A2 /5/ !/3/ B5);
240import Test qw(:T2 !B4);
241import Test qw(:T2); # should fail
2421;
243
244=head1 NAME
245
246Exporter - Implements default import method for modules
247
248=head1 SYNOPSIS
249
250In module ModuleName.pm:
251
252 package ModuleName;
253 require Exporter;
254 @ISA = qw(Exporter);
255
256 @EXPORT = qw(...); # symbols to export by default
257 @EXPORT_OK = qw(...); # symbols to export on request
258 %EXPORT_TAGS = tag => [...]; # define names for sets of symbols
259
260In other files which wish to use ModuleName:
261
262 use ModuleName; # import default symbols into my package
263
264 use ModuleName qw(...); # import listed symbols into my package
265
266 use ModuleName (); # do not import any symbols
267
268=head1 DESCRIPTION
269
270The Exporter module implements a default C<import> method which
68dc0745 271many modules choose to inherit rather than implement their own.
2b5b2650 272
273Perl automatically calls the C<import> method when processing a
274C<use> statement for a module. Modules and C<use> are documented
275in L<perlfunc> and L<perlmod>. Understanding the concept of
276modules and how the C<use> statement operates is important to
277understanding the Exporter.
278
279=head2 Selecting What To Export
280
281Do B<not> export method names!
282
283Do B<not> export anything else by default without a good reason!
284
285Exports pollute the namespace of the module user. If you must export
286try to use @EXPORT_OK in preference to @EXPORT and avoid short or
287common symbol names to reduce the risk of name clashes.
288
289Generally anything not exported is still accessible from outside the
1fef88e7 290module using the ModuleName::item_name (or $blessed_ref-E<gt>method)
2b5b2650 291syntax. By convention you can use a leading underscore on names to
292informally indicate that they are 'internal' and not for public use.
293
294(It is actually possible to get private functions by saying:
295
296 my $subref = sub { ... };
297 &$subref;
298
299But there's no way to call that directly as a method, since a method
300must have a name in the symbol table.)
301
302As a general rule, if the module is trying to be object oriented
303then export nothing. If it's just a collection of functions then
304@EXPORT_OK anything but use @EXPORT with caution.
305
306Other module design guidelines can be found in L<perlmod>.
307
308=head2 Specialised Import Lists
309
310If the first entry in an import list begins with !, : or / then the
311list is treated as a series of specifications which either add to or
312delete from the list of names to import. They are processed left to
313right. Specifications are in the form:
314
315 [!]name This name only
316 [!]:DEFAULT All names in @EXPORT
317 [!]:tag All names in $EXPORT_TAGS{tag} anonymous list
318 [!]/pattern/ All names in @EXPORT and @EXPORT_OK which match
319
320A leading ! indicates that matching names should be deleted from the
321list of names to import. If the first specification is a deletion it
322is treated as though preceded by :DEFAULT. If you just want to import
323extra names in addition to the default set you will still need to
324include :DEFAULT explicitly.
325
326e.g., Module.pm defines:
327
328 @EXPORT = qw(A1 A2 A3 A4 A5);
329 @EXPORT_OK = qw(B1 B2 B3 B4 B5);
330 %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
331
332 Note that you cannot use tags in @EXPORT or @EXPORT_OK.
333 Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK.
334
335An application using Module can say something like:
336
337 use Module qw(:DEFAULT :T2 !B3 A3);
338
339Other examples include:
340
341 use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
342 use POSIX qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/);
343
344Remember that most patterns (using //) will need to be anchored
345with a leading ^, e.g., C</^EXIT/> rather than C</EXIT/>.
346
347You can say C<BEGIN { $Exporter::Verbose=1 }> to see how the
348specifications are being processed and what is actually being imported
349into modules.
350
351=head2 Module Version Checking
352
353The Exporter module will convert an attempt to import a number from a
1fef88e7 354module into a call to $module_name-E<gt>require_version($value). This can
2b5b2650 355be used to validate that the version of the module being used is
356greater than or equal to the required version.
357
358The Exporter module supplies a default require_version method which
359checks the value of $VERSION in the exporting module.
360
361Since the default require_version method treats the $VERSION number as
d5e40bcc 362a simple numeric value it will regard version 1.10 as lower than
3631.9. For this reason it is strongly recommended that you use numbers
364with at least two decimal places, e.g., 1.09.
2b5b2650 365
366=head2 Managing Unknown Symbols
367
368In some situations you may want to prevent certain symbols from being
369exported. Typically this applies to extensions which have functions
370or constants that may not exist on some systems.
371
372The names of any symbols that cannot be exported should be listed
373in the C<@EXPORT_FAIL> array.
374
7a2e2cd6 375If a module attempts to import any of these symbols the Exporter
2b5b2650 376will give the module an opportunity to handle the situation before
377generating an error. The Exporter will call an export_fail method
378with a list of the failed symbols:
379
380 @failed_symbols = $module_name->export_fail(@failed_symbols);
381
382If the export_fail method returns an empty list then no error is
383recorded and all the requested symbols are exported. If the returned
384list is not empty then an error is generated for each symbol and the
385export fails. The Exporter provides a default export_fail method which
386simply returns the list unchanged.
387
388Uses for the export_fail method include giving better error messages
389for some symbols and performing lazy architectural checks (put more
390symbols into @EXPORT_FAIL by default and then take them out if someone
391actually tries to use them and an expensive check shows that they are
392usable on that platform).
393
394=head2 Tag Handling Utility Functions
395
396Since the symbols listed within %EXPORT_TAGS must also appear in either
397@EXPORT or @EXPORT_OK, two utility functions are provided which allow
398you to easily add tagged sets of symbols to @EXPORT or @EXPORT_OK:
399
400 %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
401
402 Exporter::export_tags('foo'); # add aa, bb and cc to @EXPORT
403 Exporter::export_ok_tags('bar'); # add aa, cc and dd to @EXPORT_OK
404
405Any names which are not tags are added to @EXPORT or @EXPORT_OK
d5e40bcc 406unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags
2b5b2650 407names being silently added to @EXPORT or @EXPORT_OK. Future versions
408may make this a fatal error.
409
410=cut