Commit | Line | Data |
68dc0745 |
1 | package autouse; |
2 | |
3 | #use strict; # debugging only |
fa3876ca |
4 | use 5.006; # use warnings |
68dc0745 |
5 | |
480f1286 |
6 | $autouse::VERSION = '1.06'; |
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 |
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 | } |
480f1286 |
56 | no warnings qw(redefine prototype); |
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 |
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 |
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 |
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 |
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 |
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 |