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