Introduce NVef, NVff, and NVgf, use the middle one.
[perl.git] / lib / autouse.pm
1 package autouse;
2
3 #use strict;            # debugging only
4 use 5.003_90;           # ->can, for my $var
5
6 $autouse::VERSION = '1.02';
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 = 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 {
52             unless ($INC{$pm}) {
53                 eval {require $pm};
54                 die if $@;
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"
60                 if $autouse::DEBUG;
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"
76             unless defined(&Exporter::import)
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
149 =head1 AUTHOR
150
151 Ilya Zakharevich (ilya@math.ohio-state.edu)
152
153 =head1 SEE ALSO
154
155 perl(1).
156
157 =cut