1package autouse; 2 3#use strict; # debugging only 4use 5.003_90; # ->can, for my $var 5 6$autouse::VERSION = '1.03'; 7 8$autouse::DEBUG ||= 0; 9 10sub vet_import ($); 11 12sub croak { 13 require Carp; 14 Carp::croak(@_); 15} 16 17sub 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 = rindex($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 73sub 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 821; 83 84__END__ 85 86=head1 NAME 87 88autouse - 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 97If the module C<Module> is already loaded, then the declaration 98 99 use autouse 'Module' => qw(func1 func2($;$)); 100 101is equivalent to 102 103 use Module qw(func1 func2); 104 105if C<Module> defines func2() with prototype C<($;$)>, and func1() has 106no prototypes. (At least if C<Module> uses C<Exporter>'s C<import>, 107otherwise it is a fatal error.) 108 109If the module C<Module> is not loaded yet, then the above declaration 110declares functions func1() and func2() in the current package. When 111these functions are called, they load the package C<Module> if needed, 112and substitute themselves with the correct definitions. 113 114=begin _deprecated 115 116 use Module qw(Module::func3); 117 118will work and is the equivalent to: 119 120 use Module qw(func3); 121 122It is not a very useful feature and has been deprecated. 123 124=end _deprecated 125 126 127=head1 WARNING 128 129Using C<autouse> will move important steps of your program's execution 130from compile time to runtime. This can 131 132=over 4 133 134=item * 135 136Break the execution of your program if the module you C<autouse>d has 137some initialization which it expects to be done early. 138 139=item * 140 141hide bugs in your code since important checks (like correctness of 142prototypes) is moved from compile time to runtime. In particular, if 143the prototype you specified on C<autouse> line is wrong, you will not 144find it out until the corresponding function is executed. This will be 145very unfortunate for functions which are not always called (note that 146for such functions C<autouse>ing gives biggest win, for a workaround 147see below). 148 149=back 150 151To alleviate the second problem (partially) it is advised to write 152your scripts like this: 153 154 use Module; 155 use autouse Module => qw(carp($) croak(&$)); 156 carp "this carp was predeclared and autoused "; 157 158The first line ensures that the errors in your argument specification 159are found early. When you ship your application you should comment 160out the first line, since it makes the second one useless. 161 162=head1 AUTHOR 163 164Ilya Zakharevich (ilya@math.ohio-state.edu) 165 166=head1 SEE ALSO 167 168perl(1). 169 170=cut 171