Commit | Line | Data |
---|---|---|
68dc0745 | 1 | package autouse; |
2 | ||
3 | #use strict; # debugging only | |
4 | use 5.003_90; # ->can, for my $var | |
5 | ||
4fd80133 | 6 | $autouse::VERSION = '1.02'; |
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 | |
42 | my $index = index($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 { | |
fb73857a | 52 | unless ($INC{$pm}) { |
53 | eval {require $pm}; | |
54 | die if $@; | |
68dc0745 | 55 | vet_import $module; |
56 | } | |
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) { | |
65 | *$closure_import_func = eval "sub ($proto) { &\$load_sub }"; | |
66 | } else { | |
67 | *$closure_import_func = $load_sub; | |
68 | } | |
69 | } | |
70 | } | |
71 | ||
72 | sub vet_import ($) { | |
73 | my $module = shift; | |
74 | if (my $import = $module->can('import')) { | |
75 | croak "autoused module has unique import() method" | |
fb73857a | 76 | unless defined(&Exporter::import) |
68dc0745 | 77 | && $import == \&Exporter::import; |
78 | } | |
79 | } | |
80 | ||
81 | 1; | |
82 | ||
83 | __END__ | |
84 | ||
85 | =head1 NAME | |
86 | ||
87 | autouse - postpone load of modules until a function is used | |
88 | ||
89 | =head1 SYNOPSIS | |
90 | ||
91 | use autouse 'Carp' => qw(carp croak); | |
92 | carp "this carp was predeclared and autoused "; | |
93 | ||
94 | =head1 DESCRIPTION | |
95 | ||
96 | If the module C<Module> is already loaded, then the declaration | |
97 | ||
98 | use autouse 'Module' => qw(func1 func2($;$) Module::func3); | |
99 | ||
100 | is equivalent to | |
101 | ||
102 | use Module qw(func1 func2); | |
103 | ||
104 | if C<Module> defines func2() with prototype C<($;$)>, and func1() and | |
105 | func3() have no prototypes. (At least if C<Module> uses C<Exporter>'s | |
106 | C<import>, otherwise it is a fatal error.) | |
107 | ||
108 | If the module C<Module> is not loaded yet, then the above declaration | |
109 | declares functions func1() and func2() in the current package, and | |
110 | declares a function Module::func3(). When these functions are called, | |
111 | they load the package C<Module> if needed, and substitute themselves | |
112 | with the correct definitions. | |
113 | ||
114 | =head1 WARNING | |
115 | ||
116 | Using C<autouse> will move important steps of your program's execution | |
117 | from compile time to runtime. This can | |
118 | ||
119 | =over | |
120 | ||
121 | =item * | |
122 | ||
123 | Break the execution of your program if the module you C<autouse>d has | |
124 | some initialization which it expects to be done early. | |
125 | ||
126 | =item * | |
127 | ||
128 | hide bugs in your code since important checks (like correctness of | |
129 | prototypes) is moved from compile time to runtime. In particular, if | |
130 | the prototype you specified on C<autouse> line is wrong, you will not | |
131 | find it out until the corresponding function is executed. This will be | |
132 | very unfortunate for functions which are not always called (note that | |
133 | for such functions C<autouse>ing gives biggest win, for a workaround | |
134 | see below). | |
135 | ||
136 | =back | |
137 | ||
138 | To alleviate the second problem (partially) it is advised to write | |
139 | your scripts like this: | |
140 | ||
141 | use Module; | |
142 | use autouse Module => qw(carp($) croak(&$)); | |
143 | carp "this carp was predeclared and autoused "; | |
144 | ||
145 | The first line ensures that the errors in your argument specification | |
146 | are found early. When you ship your application you should comment | |
147 | out the first line, since it makes the second one useless. | |
148 | ||
68dc0745 | 149 | =head1 AUTHOR |
150 | ||
151 | Ilya Zakharevich (ilya@math.ohio-state.edu) | |
152 | ||
153 | =head1 SEE ALSO | |
154 | ||
155 | perl(1). | |
156 | ||
157 | =cut |