lib/perl5/5.6.1/autouse.pm

   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