X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExporter.pm;h=d9c22049776f5ff7f7f69eacd20bd6f81b1b2e32;hb=c6dfe06b011d5e45b77ada4c240cf5565f0b354a;hp=382ee859f4f6ef0be4d05114c930840225352f7c;hpb=cb1a09d0194fed9b905df7b04a4bc031d354609d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Exporter.pm b/lib/Exporter.pm index 382ee85..d9c2204 100644 --- a/lib/Exporter.pm +++ b/lib/Exporter.pm @@ -1,19 +1,220 @@ package Exporter; +require 5.006; + +# Be lean. +#use strict; +#no strict 'refs'; + +our $Debug = 0; +our $ExportLevel = 0; +our $Verbose ||= 0; +our $VERSION = '5.58'; +our (%Cache); +$Carp::Internal{Exporter} = 1; + +sub as_heavy { + require Exporter::Heavy; + # Unfortunately, this does not work if the caller is aliased as *name = \&foo + # Thus the need to create a lot of identical subroutines + my $c = (caller(1))[3]; + $c =~ s/.*:://; + \&{"Exporter::Heavy::heavy_$c"}; +} + +sub export { + goto &{as_heavy()}; +} + +sub import { + my $pkg = shift; + my $callpkg = caller($ExportLevel); + + if ($pkg eq "Exporter" and @_ and $_[0] eq "import") { + *{$callpkg."::import"} = \&import; + return; + } + + # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-( + my($exports, $fail) = (\@{"$pkg\::EXPORT"}, \@{"$pkg\::EXPORT_FAIL"}); + return export $pkg, $callpkg, @_ + if $Verbose or $Debug or @$fail > 1; + my $export_cache = ($Cache{$pkg} ||= {}); + my $args = @_ or @_ = @$exports; + + local $_; + if ($args and not %$export_cache) { + s/^&//, $export_cache->{$_} = 1 + foreach (@$exports, @{"$pkg\::EXPORT_OK"}); + } + my $heavy; + # Try very hard not to use {} and hence have to enter scope on the foreach + # We bomb out of the loop with last as soon as heavy is set. + if ($args or $fail) { + ($heavy = (/\W/ or $args and not exists $export_cache->{$_} + or @$fail and $_ eq $fail->[0])) and last + foreach (@_); + } else { + ($heavy = /\W/) and last + foreach (@_); + } + return export $pkg, $callpkg, ($args ? @_ : ()) if $heavy; + local $SIG{__WARN__} = + sub {require Carp; &Carp::carp}; + # shortcut for the common case of no type character + *{"$callpkg\::$_"} = \&{"$pkg\::$_"} foreach @_; +} + +# Default methods + +sub export_fail { + my $self = shift; + @_; +} + +# Unfortunately, caller(1)[3] "does not work" if the caller is aliased as +# *name = \&foo. Thus the need to create a lot of identical subroutines +# Otherwise we could have aliased them to export(). + +sub export_to_level { + goto &{as_heavy()}; +} + +sub export_tags { + goto &{as_heavy()}; +} + +sub export_ok_tags { + goto &{as_heavy()}; +} + +sub require_version { + goto &{as_heavy()}; +} + +1; +__END__ + =head1 NAME -Exporter - provide inport/export controls for Perl modules +Exporter - Implements default import method for modules =head1 SYNOPSIS -use Module; -use Module qw(name1 name2 :tag /pattern/ !name); +In module YourModule.pm: + + package YourModule; + require Exporter; + @ISA = qw(Exporter); + @EXPORT_OK = qw(munge frobnicate); # symbols to export on request + +or + + package YourModule; + use Exporter 'import'; # gives you Exporter's import() method directly + @EXPORT_OK = qw(munge frobnicate); # symbols to export on request + +In other files which wish to use YourModule: + + use ModuleName qw(frobnicate); # import listed symbols + frobnicate ($left, $right) # calls YourModule::frobnicate =head1 DESCRIPTION -If the first entry in an import list begins with !, : or / then the -list is treated as a series of specifications which either add to or -delete from the list of names to import. They are processed left to +The Exporter module implements an C method which allows a module +to export functions and variables to its users' namespaces. Many modules +use Exporter rather than implementing their own C method because +Exporter provides a highly flexible interface, with an implementation optimised +for the common case. + +Perl automatically calls the C method when processing a +C statement for a module. Modules and C are documented +in L and L. Understanding the concept of +modules and how the C statement operates is important to +understanding the Exporter. + +=head2 How to Export + +The arrays C<@EXPORT> and C<@EXPORT_OK> in a module hold lists of +symbols that are going to be exported into the users name space by +default, or which they can request to be exported, respectively. The +symbols can represent functions, scalars, arrays, hashes, or typeglobs. +The symbols must be given by full name with the exception that the +ampersand in front of a function is optional, e.g. + + @EXPORT = qw(afunc $scalar @array); # afunc is a function + @EXPORT_OK = qw(&bfunc %hash *typeglob); # explicit prefix on &bfunc + +If you are only exporting function names it is recommended to omit the +ampersand, as the implementation is faster this way. + +=head2 Selecting What To Export + +Do B export method names! + +Do B export anything else by default without a good reason! + +Exports pollute the namespace of the module user. If you must export +try to use @EXPORT_OK in preference to @EXPORT and avoid short or +common symbol names to reduce the risk of name clashes. + +Generally anything not exported is still accessible from outside the +module using the ModuleName::item_name (or $blessed_ref-Emethod) +syntax. By convention you can use a leading underscore on names to +informally indicate that they are 'internal' and not for public use. + +(It is actually possible to get private functions by saying: + + my $subref = sub { ... }; + $subref->(@args); # Call it as a function + $obj->$subref(@args); # Use it as a method + +However if you use them for methods it is up to you to figure out +how to make inheritance work.) + +As a general rule, if the module is trying to be object oriented +then export nothing. If it's just a collection of functions then +@EXPORT_OK anything but use @EXPORT with caution. For function and +method names use barewords in preference to names prefixed with +ampersands for the export lists. + +Other module design guidelines can be found in L. + +=head2 How to Import + +In other files which wish to use your module there are three basic ways for +them to load your module and import its symbols: + +=over 4 + +=item C + +This imports all the symbols from ModuleName's @EXPORT into the namespace +of the C statement. + +=item C + +This causes perl to load your module but does not import any symbols. + +=item C + +This imports only the symbols listed by the caller into their namespace. +All listed symbols must be in your @EXPORT or @EXPORT_OK, else an error +occurs. The advanced export features of Exporter are accessed like this, +but with list entries that are syntactically distinct from symbol names. + +=back + +Unless you want to use its advanced features, this is probably all you +need to know to use Exporter. + +=head1 Advanced features + +=head2 Specialised Import Lists + +If any of the entries in an import list begins with !, : or / then +the list is treated as a series of specifications which either add to +or delete from the list of names to import. They are processed left to right. Specifications are in the form: [!]name This name only @@ -36,160 +237,204 @@ e.g., Module.pm defines: Note that you cannot use tags in @EXPORT or @EXPORT_OK. Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK. -Application says: +An application using Module can say something like: use Module qw(:DEFAULT :T2 !B3 A3); + +Other examples include: + use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET); - use POSIX qw(/^S_/ acos asin atan /^E/ !/^EXIT/); + use POSIX qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/); + +Remember that most patterns (using //) will need to be anchored +with a leading ^, e.g., C rather than C. + +You can say C to see how the +specifications are being processed and what is actually being imported +into modules. + +=head2 Exporting without using Exporter's import method + +Exporter has a special method, 'export_to_level' which is used in situations +where you can't directly call Exporter's import method. The export_to_level +method looks like: + + MyPackage->export_to_level($where_to_export, $package, @what_to_export); + +where $where_to_export is an integer telling how far up the calling stack +to export your symbols, and @what_to_export is an array telling what +symbols *to* export (usually this is @_). The $package argument is +currently unused. -You can set C<$Exporter::Verbose=1;> to see how the specifications are -being processed and what is actually being imported into modules. +For example, suppose that you have a module, A, which already has an +import function: + + package A; + + @ISA = qw(Exporter); + @EXPORT_OK = qw ($b); + + sub import + { + $A::b = 1; # not a very useful import method + } + +and you want to Export symbol $A::b back to the module that called +package A. Since Exporter relies on the import method to work, via +inheritance, as it stands Exporter::import() will never get called. +Instead, say the following: + + package A; + @ISA = qw(Exporter); + @EXPORT_OK = qw ($b); + + sub import + { + $A::b = 1; + A->export_to_level(1, @_); + } + +This will export the symbols one level 'above' the current package - ie: to +the program or module that used package A. + +Note: Be careful not to modify C<@_> at all before you call export_to_level +- or people using your package will get very unexplained results! + +=head2 Exporting without inheriting from Exporter + +By including Exporter in your @ISA you inherit an Exporter's import() method +but you also inherit several other helper methods which you probably don't +want. To avoid this you can do + + package YourModule; + use Exporter qw( import ); + +which will export Exporter's own import() method into YourModule. +Everything will work as before but you won't need to include Exporter in +@YourModule::ISA. =head2 Module Version Checking The Exporter module will convert an attempt to import a number from a -module into a call to $module_name->require_version($value). This can +module into a call to $module_name-Erequire_version($value). This can be used to validate that the version of the module being used is greater than or equal to the required version. The Exporter module supplies a default require_version method which checks the value of $VERSION in the exporting module. -=cut +Since the default require_version method treats the $VERSION number as +a simple numeric value it will regard version 1.10 as lower than +1.9. For this reason it is strongly recommended that you use numbers +with at least two decimal places, e.g., 1.09. -require 5.001; +=head2 Managing Unknown Symbols -$ExportLevel = 0; -$Verbose = 0; +In some situations you may want to prevent certain symbols from being +exported. Typically this applies to extensions which have functions +or constants that may not exist on some systems. -require Carp; +The names of any symbols that cannot be exported should be listed +in the C<@EXPORT_FAIL> array. -sub export { +If a module attempts to import any of these symbols the Exporter +will give the module an opportunity to handle the situation before +generating an error. The Exporter will call an export_fail method +with a list of the failed symbols: - # First make import warnings look like they're coming from the "use". - local $SIG{__WARN__} = sub { - my $text = shift; - $text =~ s/ at \S*Exporter.pm line \d+.\n//; - local $Carp::CarpLevel = 1; # ignore package calling us too. - Carp::carp($text); - }; - local $SIG{__DIE__} = sub { - Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT") - if $_[0] =~ /^Unable to create sub named "(.*?)::"/; - }; - - my $pkg = shift; - my $callpkg = shift; - my @imports = @_; - my($type, $sym); - *exports = \@{"${pkg}::EXPORT"}; - if (@imports) { - my $oops; - *exports = \%{"${pkg}::EXPORT"}; - if (!%exports) { - grep(s/^&//, @exports); - @exports{@exports} = (1) x @exports; - foreach $extra (@{"${pkg}::EXPORT_OK"}) { - $exports{$extra} = 1; - } - } - - if ($imports[0] =~ m#^[/!:]#){ - my(@allexports) = keys %exports; - my $tagsref = \%{"${pkg}::EXPORT_TAGS"}; - my $tagdata; - my %imports; - # negated first item implies starting with default set: - unshift(@imports, ':DEFAULT') if $imports[0] =~ m/^!/; - foreach (@imports){ - my(@names); - my($mode,$spec) = m/^(!)?(.*)/; - $mode = '+' unless defined $mode; - - @names = ($spec); # default, maybe overridden below - - if ($spec =~ m:^/(.*)/$:){ - my $patn = $1; - @names = grep(/$patn/, @allexports); # XXX anchor by default? - } - elsif ($spec =~ m#^:(.*)# and $tagsref){ - if ($1 eq 'DEFAULT'){ - @names = @exports; - } - elsif ($tagsref and $tagdata = $tagsref->{$1}) { - @names = @$tagdata; - } - } - - warn "Import Mode $mode, Spec $spec, Names @names\n" if $Verbose; - if ($mode eq '!') { - map {delete $imports{$_}} @names; # delete @imports{@names} would be handy :-) - } - else { - @imports{@names} = (1) x @names; - } - } - @imports = keys %imports; - } - - foreach $sym (@imports) { - if (!$exports{$sym}) { - if ($sym =~ m/^\d/) { - $pkg->require_version($sym); - # If the version number was the only thing specified - # then we should act as if nothing was specified: - if (@imports == 1) { - @imports = @exports; - last; - } - } elsif ($sym !~ s/^&// || !$exports{$sym}) { - warn qq["$sym" is not exported by the $pkg module ], - "at $callfile line $callline\n"; - $oops++; - next; - } - } - } - Carp::croak("Can't continue with import errors.\n") if $oops; - } - else { - @imports = @exports; - } - warn "Importing from $pkg into $callpkg: ", - join(", ",@imports),"\n" if ($Verbose && @imports); - foreach $sym (@imports) { - $type = '&'; - $type = $1 if $sym =~ s/^(\W)//; - *{"${callpkg}::$sym"} = - $type eq '&' ? \&{"${pkg}::$sym"} : - $type eq '$' ? \${"${pkg}::$sym"} : - $type eq '@' ? \@{"${pkg}::$sym"} : - $type eq '%' ? \%{"${pkg}::$sym"} : - $type eq '*' ? *{"${pkg}::$sym"} : - warn "Can't export symbol: $type$sym\n"; - } -}; + @failed_symbols = $module_name->export_fail(@failed_symbols); -sub import { - local ($callpkg, $callfile, $callline) = caller($ExportLevel); - my $pkg = shift; - export $pkg, $callpkg, @_; -} +If the export_fail method returns an empty list then no error is +recorded and all the requested symbols are exported. If the returned +list is not empty then an error is generated for each symbol and the +export fails. The Exporter provides a default export_fail method which +simply returns the list unchanged. -sub export_tags { - my ($pkg) = caller; - *tags = \%{"${pkg}::EXPORT_TAGS"}; - push(@{"${pkg}::EXPORT"}, - map {$tags{$_} ? @{$tags{$_}} : $_} @_ ? @_ : keys %tags); -} +Uses for the export_fail method include giving better error messages +for some symbols and performing lazy architectural checks (put more +symbols into @EXPORT_FAIL by default and then take them out if someone +actually tries to use them and an expensive check shows that they are +usable on that platform). -sub require_version { - my($self, $wanted) = @_; - my $pkg = ref $self || $self; - my $version = ${"${pkg}::VERSION"} || "(undef)"; - Carp::croak("$pkg $wanted required--this is only version $version") - if $version < $wanted; - $version; -} +=head2 Tag Handling Utility Functions -1; +Since the symbols listed within %EXPORT_TAGS must also appear in either +@EXPORT or @EXPORT_OK, two utility functions are provided which allow +you to easily add tagged sets of symbols to @EXPORT or @EXPORT_OK: + + %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]); + + Exporter::export_tags('foo'); # add aa, bb and cc to @EXPORT + Exporter::export_ok_tags('bar'); # add aa, cc and dd to @EXPORT_OK + +Any names which are not tags are added to @EXPORT or @EXPORT_OK +unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags +names being silently added to @EXPORT or @EXPORT_OK. Future versions +may make this a fatal error. + +=head2 Generating combined tags + +If several symbol categories exist in %EXPORT_TAGS, it's usually +useful to create the utility ":all" to simplify "use" statements. + +The simplest way to do this is: + + %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]); + + # add all the other ":class" tags to the ":all" class, + # deleting duplicates + { + my %seen; + + push @{$EXPORT_TAGS{all}}, + grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS; + } + +CGI.pm creates an ":all" tag which contains some (but not really +all) of its categories. That could be done with one small +change: + + # add some of the other ":class" tags to the ":all" class, + # deleting duplicates + { + my %seen; + + push @{$EXPORT_TAGS{all}}, + grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} + foreach qw/html2 html3 netscape form cgi internal/; + } + +Note that the tag names in %EXPORT_TAGS don't have the leading ':'. + +=head2 Ced Constants + +Many modules make use of Cing for constant subroutines to +avoid having to compile and waste memory on rarely used values (see +L for details on constant subroutines). Calls to such +constant subroutines are not optimized away at compile time because +they can't be checked at compile time for constancy. + +Even if a prototype is available at compile time, the body of the +subroutine is not (it hasn't been Ced yet). perl needs to +examine both the C<()> prototype and the body of a subroutine at +compile time to detect that it can safely replace calls to that +subroutine with the constant value. + +A workaround for this is to call the constants once in a C block: + + package My ; + + use Socket ; + + foo( SO_LINGER ); ## SO_LINGER NOT optimized away; called at runtime + BEGIN { SO_LINGER } + foo( SO_LINGER ); ## SO_LINGER optimized away at compile time. + +This forces the C for C to take place before +SO_LINGER is encountered later in C package. + +If you are writing a package that Cs, consider forcing +an C for any constants explicitly imported by other packages +or which are usually used when your package is Cd. + +=cut