lib/autouse.pm

   1 package autouse;
   2 #use strict;                    # debugging only
   3 use 5.003_90;                   # ->can
   4
   5 $autouse::VERSION = '0.02';
   6
   7 my $debug = 0;
   8
   9 my %disable_w;
  10
  11 sub croak {
  12   require Carp;
  13   Carp::croak(@_);
  14 }
  15
  16 sub import {
  17   shift;
  18   my $module = shift;
  19   if (exists $INC{"$module.pm"}) {
  20     unless (exists $INC{"Exporter.pm"}) {
  21       croak("use autouse with a module which has its own import()")
  22         if $module->can('import');
  23       return;                   # Ignore import
  24     }
  25     croak("use autouse with a module which has its own import()")
  26       unless $module->can('import') == \&Exporter::import;
  27     local $Exporter::ExportLevel = $Exporter::ExportLevel;
  28     $Exporter::ExportLevel++;
  29     # $Exporter::Verbose = 1;
  30     my @args = @_;
  31     my $f;
  32     foreach $f (@args) {
  33       next unless $f =~ s/\((.*)\)$//;
  34       my $proto = $1;
  35       my $sub = index($f, "::") != -1 ? $f : "$module" . "::$f";
  36       croak("Prototype mismatch on `$sub' when autousing `$module':\n",
  37             "\t`$proto' specified, the real one `",
  38             prototype($sub), "'")
  39         unless prototype($sub) eq $proto;
  40     }
  41     return $module->import(@args);
  42   }
  43   # It is not loaded: need to do real work.
  44   my $callpkg = caller(0);
  45   print "called from `$callpkg'.\n" if $debug;
  46
  47   my ($func, $index);
  48   foreach $func (@_) {
  49     my $proto;
  50     $proto = $1 if $func =~ s/\((.*)\)$//;
  51     my $closure_import_func = $func; # Full name
  52     my $closure_func = $func;   # Name inside package
  53     $index = index($func, '::');
  54
  55     if ($index == -1) {
  56       $closure_import_func = $callpkg . "::$func";
  57     } else {
  58       $closure_func = substr $func, $index + 2;
  59       croak("Trying to autouse into a different package")
  60         unless substr($func, 0, $index) eq $module;
  61       $disable_w{$module} = 1;
  62     }
  63     my $load_sub = sub {
  64       {
  65         local $^W = exists $disable_w{$module};         # Redefinition
  66         eval "require $module";
  67         die $@ if $@;
  68         croak("Prototype mismatch on `$closure_import_func' ",
  69               "after loading `$module':\n",
  70               "\t`$proto' specified when autousing, the real one `",
  71               prototype($closure_import_func), "'")
  72           if defined $proto
  73             and prototype($closure_import_func) ne $proto;
  74         local $^W = 0;          # Redefinition
  75         *$closure_import_func = \&{$module . "::$closure_func"}
  76           unless \&$closure_import_func == \&{$module . "::$closure_func"};
  77       }
  78       print "In loader for `$module: $closure_import_func => $closure_func'.\n"
  79         if $debug;
  80       goto &$closure_import_func;
  81     };
  82     if (defined $proto) {
  83       *$closure_import_func = eval "sub ($proto) {&\$load_sub}";
  84     } else {
  85       *$closure_import_func = $load_sub;
  86     }
  87   }
  88 }
  89
  90 1;
  91
  92 __END__
  93
  94 =head1 NAME
  95
  96 autouse - postpone load of modules until a function is used
  97
  98 =head1 SYNOPSIS
  99
 100   use autouse 'Carp' => qw(carp croak);
 101   carp "this carp was predeclared and autoused ";
 102
 103
 104 =head1 DESCRIPTION
 105
 106 If the module C<Module> is already loaded, then the declaration
 107
 108   use autouse 'Module' => qw(func1 func2($;$) Module::func3);
 109
 110 is equivalent to
 111
 112   use Module qw(func1 func2);
 113
 114 if C<Module> defines func2() with prototype C<($;$)>, and func1() and
 115 func3() have no prototypes. (At least if C<Module> uses C<Exporter>'s
 116 C<import>, otherwise it is a fatal error.)
 117
 118 If the module C<Module> is not loaded yet, then the above declaration
 119 declares functions func1() and func2() in the current package, and
 120 declares a function Module::func3(). When these functions are called,
 121 they load the package C<Module> if needed, and substitute themselves
 122 with the correct definitions.
 123
 124 =head1 WARNING
 125
 126 Using C<autouse> will move important steps of your program's execution
 127 from compile time to runtime. This can
 128
 129 =over
 130
 131 =item *
 132
 133 Break the execution of your program if the module you C<autouse>d has
 134 some initialization which it expects to be done early.
 135
 136 =item *
 137
 138 hide bugs in your code since important checks (like correctness of
 139 prototypes) is moved from compile time to runtime. In particular, if
 140 the prototype you specified on C<autouse> line is wrong, you will not
 141 find it out until the corresponding function is executed. This will be
 142 very unfortunate for functions which are not always called (note that
 143 for such functions C<autouse>ing gives biggest win, for a workaround
 144 see below).
 145
 146 =back
 147
 148 To alleviate the second problem (partially) it is advised to write
 149 your scripts like this:
 150
 151   use Module;
 152   use autouse Module => qw(carp($) croak(&$));
 153   carp "this carp was predeclared and autoused ";
 154
 155 The first line ensures that the errors in your argument specification
 156 are found early.  When you ship your application you should comment
 157 out the first line, since it makes the second one useless.
 158
 159 =head1 BUGS
 160
 161 If Module::func3() is autoused, and the module is loaded between the
 162 C<autouse> directive and a call to Module::func3(), warnings about
 163 redefinition would appear if warnings are enabled.
 164
 165 If Module::func3() is autoused, warnings are disabled when loading the
 166 module via autoused functions.
 167
 168 =head1 AUTHOR
 169
 170 Ilya Zakharevich (ilya@math.ohio-state.edu)
 171
 172 =head1 SEE ALSO
 173
 174 perl(1).
 175
 176 =cut