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 ([email protected])
|
---|
165 |
|
---|
166 | =head1 SEE ALSO
|
---|
167 |
|
---|
168 | perl(1).
|
---|
169 |
|
---|
170 | =cut
|
---|