This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Continue what #4494 started; introduce uid and gid formats.
[perl5.git] / lib / autouse.pm
CommitLineData
68dc0745 1package autouse;
2
3#use strict; # debugging only
4use 5.003_90; # ->can, for my $var
5
4fd80133 6$autouse::VERSION = '1.02';
68dc0745 7
6363f07a 8$autouse::DEBUG ||= 0;
68dc0745 9
10sub vet_import ($);
11
12sub croak {
13 require Carp;
14 Carp::croak(@_);
15}
16
17sub 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
72sub 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
811;
82
83__END__
84
85=head1 NAME
86
87autouse - 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
96If the module C<Module> is already loaded, then the declaration
97
98 use autouse 'Module' => qw(func1 func2($;$) Module::func3);
99
100is equivalent to
101
102 use Module qw(func1 func2);
103
104if C<Module> defines func2() with prototype C<($;$)>, and func1() and
105func3() have no prototypes. (At least if C<Module> uses C<Exporter>'s
106C<import>, otherwise it is a fatal error.)
107
108If the module C<Module> is not loaded yet, then the above declaration
109declares functions func1() and func2() in the current package, and
110declares a function Module::func3(). When these functions are called,
111they load the package C<Module> if needed, and substitute themselves
112with the correct definitions.
113
114=head1 WARNING
115
116Using C<autouse> will move important steps of your program's execution
117from compile time to runtime. This can
118
119=over
120
121=item *
122
123Break the execution of your program if the module you C<autouse>d has
124some initialization which it expects to be done early.
125
126=item *
127
128hide bugs in your code since important checks (like correctness of
129prototypes) is moved from compile time to runtime. In particular, if
130the prototype you specified on C<autouse> line is wrong, you will not
131find it out until the corresponding function is executed. This will be
132very unfortunate for functions which are not always called (note that
133for such functions C<autouse>ing gives biggest win, for a workaround
134see below).
135
136=back
137
138To alleviate the second problem (partially) it is advised to write
139your scripts like this:
140
141 use Module;
142 use autouse Module => qw(carp($) croak(&$));
143 carp "this carp was predeclared and autoused ";
144
145The first line ensures that the errors in your argument specification
146are found early. When you ship your application you should comment
147out the first line, since it makes the second one useless.
148
68dc0745 149=head1 AUTHOR
150
151Ilya Zakharevich (ilya@math.ohio-state.edu)
152
153=head1 SEE ALSO
154
155perl(1).
156
157=cut