Commit | Line | Data |
---|---|---|
68dc0745 | 1 | package autouse; |
2 | ||
3 | #use strict; # debugging only | |
4 | use 5.003_90; # ->can, for my $var | |
5 | ||
bc6dddac | 6 | $autouse::VERSION = '1.05'; |
68dc0745 | 7 | |
6363f07a | 8 | $autouse::DEBUG ||= 0; |
68dc0745 | 9 | |
10 | sub vet_import ($); | |
11 | ||
12 | sub croak { | |
13 | require Carp; | |
14 | Carp::croak(@_); | |
15 | } | |
16 | ||
17 | sub import { | |
6363f07a CS |
18 | my $class = @_ ? shift : 'autouse'; |
19 | croak "usage: use $class MODULE [,SUBS...]" unless @_; | |
68dc0745 | 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; | |
4fd80133 | 28 | return $module->import(map { (my $f = $_) =~ s/\(.*?\)$//; $f } @_); |
68dc0745 | 29 | } |
30 | ||
31 | # It is not loaded: need to do real work. | |
32 | my $callpkg = caller(0); | |
6363f07a | 33 | print "autouse called from $callpkg\n" if $autouse::DEBUG; |
68dc0745 | 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 | |
5a02ccb1 | 42 | my $index = rindex($func, '::'); |
68dc0745 | 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 { | |
fb73857a | 52 | unless ($INC{$pm}) { |
bc6dddac | 53 | require $pm; |
68dc0745 | 54 | vet_import $module; |
55 | } | |
f1c689a8 | 56 | no warnings 'redefine'; |
68dc0745 | 57 | *$closure_import_func = \&{"${module}::$closure_func"}; |
58 | print "autousing $module; " | |
59 | ."imported $closure_func as $closure_import_func\n" | |
6363f07a | 60 | if $autouse::DEBUG; |
68dc0745 | 61 | goto &$closure_import_func; |
62 | }; | |
63 | ||
64 | if (defined $proto) { | |
bc6dddac AT |
65 | *$closure_import_func = eval "sub ($proto) { goto &\$load_sub }" |
66 | || die; | |
68dc0745 | 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')) { | |
03699e8e | 76 | croak "autoused module $module has unique import() method" |
fb73857a | 77 | unless defined(&Exporter::import) |
03699e8e MS |
78 | && ($import == \&Exporter::import || |
79 | $import == \&UNIVERSAL::import) | |
68dc0745 | 80 | } |
81 | } | |
82 | ||
83 | 1; | |
84 | ||
85 | __END__ | |
86 | ||
87 | =head1 NAME | |
88 | ||
89 | autouse - postpone load of modules until a function is used | |
90 | ||
91 | =head1 SYNOPSIS | |
92 | ||
93 | use autouse 'Carp' => qw(carp croak); | |
94 | carp "this carp was predeclared and autoused "; | |
95 | ||
96 | =head1 DESCRIPTION | |
97 | ||
98 | If the module C<Module> is already loaded, then the declaration | |
99 | ||
5a02ccb1 | 100 | use autouse 'Module' => qw(func1 func2($;$)); |
68dc0745 | 101 | |
102 | is equivalent to | |
103 | ||
104 | use Module qw(func1 func2); | |
105 | ||
5a02ccb1 MS |
106 | if C<Module> defines func2() with prototype C<($;$)>, and func1() has |
107 | no prototypes. (At least if C<Module> uses C<Exporter>'s C<import>, | |
108 | otherwise it is a fatal error.) | |
68dc0745 | 109 | |
110 | If the module C<Module> is not loaded yet, then the above declaration | |
5a02ccb1 MS |
111 | declares functions func1() and func2() in the current package. When |
112 | these functions are called, they load the package C<Module> if needed, | |
113 | and substitute themselves with the correct definitions. | |
114 | ||
115 | =begin _deprecated | |
116 | ||
117 | use Module qw(Module::func3); | |
118 | ||
119 | will work and is the equivalent to: | |
120 | ||
121 | use Module qw(func3); | |
122 | ||
08e0cdb5 | 123 | It is not a very useful feature and has been deprecated. |
5a02ccb1 MS |
124 | |
125 | =end _deprecated | |
126 | ||
68dc0745 | 127 | |
128 | =head1 WARNING | |
129 | ||
130 | Using C<autouse> will move important steps of your program's execution | |
131 | from compile time to runtime. This can | |
132 | ||
bbc7dcd2 | 133 | =over 4 |
68dc0745 | 134 | |
135 | =item * | |
136 | ||
137 | Break the execution of your program if the module you C<autouse>d has | |
138 | some initialization which it expects to be done early. | |
139 | ||
140 | =item * | |
141 | ||
142 | hide bugs in your code since important checks (like correctness of | |
143 | prototypes) is moved from compile time to runtime. In particular, if | |
144 | the prototype you specified on C<autouse> line is wrong, you will not | |
145 | find it out until the corresponding function is executed. This will be | |
146 | very unfortunate for functions which are not always called (note that | |
147 | for such functions C<autouse>ing gives biggest win, for a workaround | |
148 | see below). | |
149 | ||
150 | =back | |
151 | ||
152 | To alleviate the second problem (partially) it is advised to write | |
153 | your scripts like this: | |
154 | ||
155 | use Module; | |
156 | use autouse Module => qw(carp($) croak(&$)); | |
157 | carp "this carp was predeclared and autoused "; | |
158 | ||
159 | The first line ensures that the errors in your argument specification | |
160 | are found early. When you ship your application you should comment | |
161 | out the first line, since it makes the second one useless. | |
162 | ||
68dc0745 | 163 | =head1 AUTHOR |
164 | ||
165 | Ilya Zakharevich (ilya@math.ohio-state.edu) | |
166 | ||
167 | =head1 SEE ALSO | |
168 | ||
169 | perl(1). | |
170 | ||
171 | =cut |