home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Exporter.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  2.2 KB  |  99 lines
  1. package Exporter;
  2.  
  3. require 5.006;
  4.  
  5. # Be lean.
  6. #use strict;
  7. #no strict 'refs';
  8.  
  9. our $Debug = 0;
  10. our $ExportLevel = 0;
  11. our $Verbose ||= 0;
  12. our $VERSION = '5.62';
  13. our (%Cache);
  14. # Carp does this now for us, so we can finally live w/o Carp
  15. #$Carp::Internal{Exporter} = 1;
  16.  
  17. sub as_heavy {
  18.   require Exporter::Heavy;
  19.   # Unfortunately, this does not work if the caller is aliased as *name = \&foo
  20.   # Thus the need to create a lot of identical subroutines
  21.   my $c = (caller(1))[3];
  22.   $c =~ s/.*:://;
  23.   \&{"Exporter::Heavy::heavy_$c"};
  24. }
  25.  
  26. sub export {
  27.   goto &{as_heavy()};
  28. }
  29.  
  30. sub import {
  31.   my $pkg = shift;
  32.   my $callpkg = caller($ExportLevel);
  33.  
  34.   if ($pkg eq "Exporter" and @_ and $_[0] eq "import") {
  35.     *{$callpkg."::import"} = \&import;
  36.     return;
  37.   }
  38.  
  39.   # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-(
  40.   my($exports, $fail) = (\@{"$pkg\::EXPORT"}, \@{"$pkg\::EXPORT_FAIL"});
  41.   return export $pkg, $callpkg, @_
  42.     if $Verbose or $Debug or @$fail > 1;
  43.   my $export_cache = ($Cache{$pkg} ||= {});
  44.   my $args = @_ or @_ = @$exports;
  45.  
  46.   local $_;
  47.   if ($args and not %$export_cache) {
  48.     s/^&//, $export_cache->{$_} = 1
  49.       foreach (@$exports, @{"$pkg\::EXPORT_OK"});
  50.   }
  51.   my $heavy;
  52.   # Try very hard not to use {} and hence have to  enter scope on the foreach
  53.   # We bomb out of the loop with last as soon as heavy is set.
  54.   if ($args or $fail) {
  55.     ($heavy = (/\W/ or $args and not exists $export_cache->{$_}
  56.                or @$fail and $_ eq $fail->[0])) and last
  57.                  foreach (@_);
  58.   } else {
  59.     ($heavy = /\W/) and last
  60.       foreach (@_);
  61.   }
  62.   return export $pkg, $callpkg, ($args ? @_ : ()) if $heavy;
  63.   local $SIG{__WARN__} = 
  64.     sub {require Carp; &Carp::carp};
  65.   # shortcut for the common case of no type character
  66.   *{"$callpkg\::$_"} = \&{"$pkg\::$_"} foreach @_;
  67. }
  68.  
  69. # Default methods
  70.  
  71. sub export_fail {
  72.     my $self = shift;
  73.     @_;
  74. }
  75.  
  76. # Unfortunately, caller(1)[3] "does not work" if the caller is aliased as
  77. # *name = \&foo.  Thus the need to create a lot of identical subroutines
  78. # Otherwise we could have aliased them to export().
  79.  
  80. sub export_to_level {
  81.   goto &{as_heavy()};
  82. }
  83.  
  84. sub export_tags {
  85.   goto &{as_heavy()};
  86. }
  87.  
  88. sub export_ok_tags {
  89.   goto &{as_heavy()};
  90. }
  91.  
  92. sub require_version {
  93.   goto &{as_heavy()};
  94. }
  95.  
  96. 1;
  97. __END__
  98.  
  99.