home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _7a99bf2200ff475c76d4569f730a9537 < prev    next >
Encoding:
Text File  |  2000-03-15  |  4.1 KB  |  158 lines
  1. package autouse;
  2.  
  3. #use strict;        # debugging only
  4. use 5.003_90;        # ->can, for my $var
  5.  
  6. $autouse::VERSION = '1.02';
  7.  
  8. $autouse::DEBUG ||= 0;
  9.  
  10. sub vet_import ($);
  11.  
  12. sub croak {
  13.     require Carp;
  14.     Carp::croak(@_);
  15. }
  16.  
  17. sub import {
  18.     my $class = @_ ? shift : 'autouse';
  19.     croak "usage: use $class MODULE [,SUBS...]" unless @_;
  20.     my $module = shift;
  21.  
  22.     (my $pm = $module) =~ s{::}{/}g;
  23.     $pm .= '.pm';
  24.     if (exists $INC{$pm}) {
  25.     vet_import $module;
  26.     local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
  27.     # $Exporter::Verbose = 1;
  28.     return $module->import(map { (my $f = $_) =~ s/\(.*?\)$//; $f } @_);
  29.     }
  30.  
  31.     # It is not loaded: need to do real work.
  32.     my $callpkg = caller(0);
  33.     print "autouse called from $callpkg\n" if $autouse::DEBUG;
  34.  
  35.     my $index;
  36.     for my $f (@_) {
  37.     my $proto;
  38.     $proto = $1 if (my $func = $f) =~ s/\((.*)\)$//;
  39.  
  40.     my $closure_import_func = $func;    # Full name
  41.     my $closure_func = $func;        # Name inside package
  42.     my $index = index($func, '::');
  43.     if ($index == -1) {
  44.         $closure_import_func = "${callpkg}::$func";
  45.     } else {
  46.         $closure_func = substr $func, $index + 2;
  47.         croak "autouse into different package attempted"
  48.         unless substr($func, 0, $index) eq $module;
  49.     }
  50.  
  51.     my $load_sub = sub {
  52.         unless ($INC{$pm}) {
  53.         eval {require $pm};
  54.         die if $@;
  55.         vet_import $module;
  56.         }
  57.         *$closure_import_func = \&{"${module}::$closure_func"};
  58.         print "autousing $module; "
  59.           ."imported $closure_func as $closure_import_func\n"
  60.         if $autouse::DEBUG;
  61.         goto &$closure_import_func;
  62.     };
  63.  
  64.     if (defined $proto) {
  65.         *$closure_import_func = eval "sub ($proto) { &\$load_sub }";
  66.     } else {
  67.         *$closure_import_func = $load_sub;
  68.     }
  69.     }
  70. }
  71.  
  72. sub vet_import ($) {
  73.     my $module = shift;
  74.     if (my $import = $module->can('import')) {
  75.     croak "autoused module has unique import() method"
  76.         unless defined(&Exporter::import)
  77.            && $import == \&Exporter::import;
  78.     }
  79. }
  80.  
  81. 1;
  82.  
  83. __END__
  84.  
  85. =head1 NAME
  86.  
  87. autouse - postpone load of modules until a function is used
  88.  
  89. =head1 SYNOPSIS
  90.  
  91.   use autouse 'Carp' => qw(carp croak);
  92.   carp "this carp was predeclared and autoused ";
  93.  
  94. =head1 DESCRIPTION
  95.  
  96. If the module C<Module> is already loaded, then the declaration
  97.  
  98.   use autouse 'Module' => qw(func1 func2($;$) Module::func3);
  99.  
  100. is equivalent to
  101.  
  102.   use Module qw(func1 func2);
  103.  
  104. if C<Module> defines func2() with prototype C<($;$)>, and func1() and
  105. func3() have no prototypes.  (At least if C<Module> uses C<Exporter>'s
  106. C<import>, otherwise it is a fatal error.)
  107.  
  108. If the module C<Module> is not loaded yet, then the above declaration
  109. declares functions func1() and func2() in the current package, and
  110. declares a function Module::func3().  When these functions are called,
  111. they load the package C<Module> if needed, and substitute themselves
  112. with the correct definitions.
  113.  
  114. =head1 WARNING
  115.  
  116. Using C<autouse> will move important steps of your program's execution
  117. from compile time to runtime.  This can
  118.  
  119. =over
  120.  
  121. =item *
  122.  
  123. Break the execution of your program if the module you C<autouse>d has
  124. some initialization which it expects to be done early.
  125.  
  126. =item *
  127.  
  128. hide bugs in your code since important checks (like correctness of
  129. prototypes) is moved from compile time to runtime.  In particular, if
  130. the prototype you specified on C<autouse> line is wrong, you will not
  131. find it out until the corresponding function is executed.  This will be
  132. very unfortunate for functions which are not always called (note that
  133. for such functions C<autouse>ing gives biggest win, for a workaround
  134. see below).
  135.  
  136. =back
  137.  
  138. To alleviate the second problem (partially) it is advised to write
  139. your scripts like this:
  140.  
  141.   use Module;
  142.   use autouse Module => qw(carp($) croak(&$));
  143.   carp "this carp was predeclared and autoused ";
  144.  
  145. The first line ensures that the errors in your argument specification
  146. are found early.  When you ship your application you should comment
  147. out the first line, since it makes the second one useless.
  148.  
  149. =head1 AUTHOR
  150.  
  151. Ilya Zakharevich (ilya@math.ohio-state.edu)
  152.  
  153. =head1 SEE ALSO
  154.  
  155. perl(1).
  156.  
  157. =cut
  158.