lib/Exporter.pm

   1 package Exporter;
   2
   3 require 5.000;
   4
   5 $ExportLevel = 0;
   6
   7 sub export {
   8     my $pack = shift;
   9     my $callpack = shift;
  10     my @imports = @_;
  11     *exports = \@{"${pack}::EXPORT"};
  12     if (@imports) {
  13         my $oops;
  14         my $type;
  15         *exports = \%{"${pack}::EXPORT"};
  16         if (!%exports) {
  17             grep(s/^&//, @exports);
  18             @exports{@exports} = (1) x  @exports;
  19             foreach $extra (@{"${pack}::EXPORT_OK"}) {
  20                 $exports{$extra} = 1;
  21             }
  22         }
  23         foreach $sym (@imports) {
  24             if (!$exports{$sym}) {
  25                 if ($sym !~ s/^&// || !$exports{$sym}) {
  26                     warn qq["$sym" is not exported by the $pack module ],
  27                             "at $callfile line $callline\n";
  28                     $oops++;
  29                     next;
  30                 }
  31             }
  32         }
  33         die "Can't continue with import errors.\n" if $oops;
  34     }
  35     else {
  36         @imports = @exports;
  37     }
  38     foreach $sym (@imports) {
  39         $type = '&';
  40         $type = $1 if $sym =~ s/^(\W)//;
  41         *{"${callpack}::$sym"} =
  42             $type eq '&' ? \&{"${pack}::$sym"} :
  43             $type eq '$' ? \${"${pack}::$sym"} :
  44             $type eq '@' ? \@{"${pack}::$sym"} :
  45             $type eq '%' ? \%{"${pack}::$sym"} :
  46             $type eq '*' ?  *{"${pack}::$sym"} :
  47                     warn "Can't export symbol: $type$sym\n";
  48     }
  49 };
  50
  51 sub import {
  52     local ($callpack, $callfile, $callline) = caller($ExportLevel);
  53     my $pack = shift;
  54     export $pack, $callpack, @_;
  55 }
  56
  57 1;