lib/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             no warnings 'redefine';
  58             *$closure_import_func = \&{"${module}::$closure_func"};
  59             print "autousing $module; "
  60                   ."imported $closure_func as $closure_import_func\n"
  61                 if $autouse::DEBUG;
  62             goto &$closure_import_func;
  63         };
  64
  65         if (defined $proto) {
  66             *$closure_import_func = eval "sub ($proto) { &\$load_sub }";
  67         } else {
  68             *$closure_import_func = $load_sub;
  69         }
  70     }
  71 }
  72
  73 sub vet_import ($) {
  74     my $module = shift;
  75     if (my $import = $module->can('import')) {
  76         croak "autoused module has unique import() method"
  77             unless defined(&Exporter::import)
  78                    && $import == \&Exporter::import;
  79     }
  80 }
  81
  82 1;
  83
  84 __END__
  85
  86 =head1 NAME
  87
  88 autouse - postpone load of modules until a function is used
  89
  90 =head1 SYNOPSIS
  91
  92   use autouse 'Carp' => qw(carp croak);
  93   carp "this carp was predeclared and autoused ";
  94
  95 =head1 DESCRIPTION
  96
  97 If the module C<Module> is already loaded, then the declaration
  98
  99   use autouse 'Module' => qw(func1 func2($;$) Module::func3);
 100
 101 is equivalent to
 102
 103   use Module qw(func1 func2);
 104
 105 if C<Module> defines func2() with prototype C<($;$)>, and func1() and
 106 func3() have no prototypes.  (At least if C<Module> uses C<Exporter>'s
 107 C<import>, otherwise it is a fatal error.)
 108
 109 If the module C<Module> is not loaded yet, then the above declaration
 110 declares functions func1() and func2() in the current package, and
 111 declares a function Module::func3().  When these functions are called,
 112 they load the package C<Module> if needed, and substitute themselves
 113 with the correct definitions.
 114
 115 =head1 WARNING
 116
 117 Using C<autouse> will move important steps of your program's execution
 118 from compile time to runtime.  This can
 119
 120 =over 4
 121
 122 =item *
 123
 124 Break the execution of your program if the module you C<autouse>d has
 125 some initialization which it expects to be done early.
 126
 127 =item *
 128
 129 hide bugs in your code since important checks (like correctness of
 130 prototypes) is moved from compile time to runtime.  In particular, if
 131 the prototype you specified on C<autouse> line is wrong, you will not
 132 find it out until the corresponding function is executed.  This will be
 133 very unfortunate for functions which are not always called (note that
 134 for such functions C<autouse>ing gives biggest win, for a workaround
 135 see below).
 136
 137 =back
 138
 139 To alleviate the second problem (partially) it is advised to write
 140 your scripts like this:
 141
 142   use Module;
 143   use autouse Module => qw(carp($) croak(&$));
 144   carp "this carp was predeclared and autoused ";
 145
 146 The first line ensures that the errors in your argument specification
 147 are found early.  When you ship your application you should comment
 148 out the first line, since it makes the second one useless.
 149
 150 =head1 AUTHOR
 151
 152 Ilya Zakharevich (ilya@math.ohio-state.edu)
 153
 154 =head1 SEE ALSO
 155
 156 perl(1).
 157
 158 =cut