Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | package autouse; |
2 | ||
3 | #use strict; # debugging only | |
4 | use 5.003_90; # ->can, for my $var | |
5 | ||
6 | $autouse::VERSION = '1.05'; | |
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 | require $pm; | |
54 | vet_import $module; | |
55 | } | |
56 | no warnings 'redefine'; | |
57 | *$closure_import_func = \&{"${module}::$closure_func"}; | |
58 | print "autousing $module; " | |
59 | ."imported $closure_func as $closure_import_func\n" | |
60 | if $autouse::DEBUG; | |
61 | goto &$closure_import_func; | |
62 | }; | |
63 | ||
64 | if (defined $proto) { | |
65 | *$closure_import_func = eval "sub ($proto) { goto &\$load_sub }" | |
66 | || die; | |
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 |