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