File Coverage

blib/lib/Module/Lazy.pm
Criterion Covered Total %
statement 86 86 100.0
branch 22 30 73.3
condition n/a
subroutine 17 17 100.0
pod n/a
total 125 133 93.9


line stmt bran cond sub pod time code
1             package Module::Lazy;
2              
3 15     15   789406 use 5.008;
  15         165  
4 15     15   76 use strict;
  15         26  
  15         318  
5 15     15   71 use warnings;
  15         25  
  15         752  
6             our $VERSION = '0.04';
7              
8             =head1 NAME
9              
10             Module::Lazy - postpone loading a module until it's actually used
11              
12             =head1 SYNOPSIS
13              
14             use Module::Lazy "My::Module";
15             # My::Module has not been loaded
16              
17             my $var = My::Module->new;
18             # My::Module is loaded now, and new() method is called
19              
20             no Module::Lazy;
21             # Force loading of all postponed modules
22              
23             =head1 DESCRIPTION
24              
25             In large projects loading all the dependencies may take a lot of time.
26             This module attempts to reduce the startup time by postponing initialization.
27             The improvement be significant for unit test scripts
28             and small command-line tools
29             which do not utilize all the functionality at once.
30              
31             This comes at a cost of reduced stability,
32             as load-time errors are also postponed.
33             The C directive is provided to mitigate the risk
34             by forcing the pending modules to load.
35              
36             =head1 EXPORTED FUNCTIONS
37              
38             None.
39              
40             =head1 METHODS
41              
42             =cut
43              
44 15     15   95 use Carp;
  15         40  
  15         1189  
45 15     15   140 use constant DEBUG => !!$ENV{PERL_LAZYLOAD_DEBUG};
  15         33  
  15         14166  
46              
47             =head2 import
48              
49             When C is called,
50             the module in question is not loaded.
51             A stub package with the same name is created instead.
52              
53             Should any method call be performed on the stub package,
54             it loads the original one and jumps to respective method.
55              
56             In particular, C and C are overloaded
57             and will trigger module loading.
58              
59             Upon loading, C is not called on the target package.
60             This MAY change in the future.
61              
62             No extra options (except from target module name) are allowed.
63              
64             =cut
65              
66             my $dont = !!$ENV{PERL_LAZYLOAD_DISABLE};
67             my %seen;
68             my $inc_stub = "pending load by ".__PACKAGE__;
69              
70             sub import {
71 24     24   1897 my ($class, $target, @rest) = @_;
72              
73             # bare use statement is ok
74 24 100       1337 return unless defined $target;
75              
76 22 100       106 croak "Usage: use Module::Lazy 'Module::Name'; extra options not supported"
77             unless @rest == 0;
78              
79             # return ASAP if already loaded by us or Perl itself
80 21 100       71 return if $seen{$target};
81 20         37 my $mod = $target;
82 20         113 $mod =~ s,::,/,g;
83 20         53 $mod .= ".pm";
84              
85 20 50       109 return if $INC{$mod};
86              
87             carp __PACKAGE__.": request to load $target "
88 20         34 .($seen{$target} ? '(seen)' : '(first time)')
89             if DEBUG;
90 20 100       51 return _load( $target, $mod )
91             if $dont;
92              
93 19 50       135 croak "Bad module name '$target'"
94             unless $target =~ /^[A-Za-z_][A-Za-z_0-9]*(?:::[A-Za-z_0-9]+)*$/;
95              
96 19         67 $seen{$target} = $mod;
97              
98             # If $target is later require'd directly,
99             # autoload and destroy will be overwritten and will cause a warning.
100             # Preventing them from being loaded seems like a lesser evil.
101 19         44 $INC{$mod} = $inc_stub;
102              
103             _set_symbol( $target, AUTOLOAD => sub {
104 7     7   3385 our $AUTOLOAD;
105 7         52 $AUTOLOAD =~ s/.*:://;
106 7         30 my $jump = _jump( $target, $AUTOLOAD );
107 7         29 goto $jump;
108 19         165 } );
109              
110             # Provide DESTROY just in case someone blesses an object directly
111             # without ever loading a module
112 19         52 _set_symbol( $target, DESTROY => _jump( $target, DESTROY => "no_die" ) );
113              
114             # If somebody calls Module->can("foo"), we can't really tell
115             # without loading, so override it
116 19         49 foreach (qw( can isa )) {
117 38         80 _set_symbol( $target, $_ => _jump( $target, $_ ) );
118             };
119              
120             # Provide a fake version for `use My::Module 100.500`
121 19         55 _set_symbol( $target, VERSION => 10**9 );
122             };
123              
124             =head2 unimport
125              
126             Calling C or, alternatively, Cunimport;>
127             will cause all postponed modules to be loaded immediately,
128             in alphabetical order.
129              
130             This may be useful to avoid deferred errors and/or side effects
131             of module loading.
132              
133             No extra options to unimport are supported.
134              
135             =cut
136              
137             sub unimport {
138 3     3   817 my $class = shift;
139              
140 3 50       16 croak "usage: no Module::Lazy;"
141             if @_;
142              
143 3         5 carp __PACKAGE__.": unimport called"
144             if DEBUG;
145              
146 3         6 $dont++;
147             # sort keys to ensure load order stability in case of bugs
148 3         38 foreach (sort keys %seen) {
149             # some modules may have been already loaded, skip if so
150 3 100       33 _inflate($_) if $seen{$_};
151             };
152             };
153              
154             my %cleanup_symbol;
155             sub _inflate {
156 18     18   37 my $target = shift;
157              
158             # TODO distinguish between "not seen" and "already loaded"
159 18         56 my $mod = delete $seen{$target};
160 18 50       74 croak "Module '$target' is unknown Module::Lazy, or already loaded. Please file a bug"
161             unless $mod;
162              
163             carp "Module '$target' wasn't preloaded by Module::Lazy. Please file a bug"
164 18 50       61 unless $INC{$mod};
165              
166             return carp "Module '$target' already loaded elsewhere from '$INC{$mod}'"
167 18 50       61 unless $INC{$mod} eq $inc_stub;
168              
169             # reset stub methods prior to loading
170 18 50       32 foreach (keys %{ $cleanup_symbol{$target} || {} }) {
  18         99  
171 72         148 _unset_symbol( $target, $_ );
172             };
173              
174             # reset fake $VERSION
175 18         72 _set_symbol( $target, VERSION => undef );
176              
177             # make the module loadable again
178 18         42 delete $INC{$mod};
179 18         55 _load( $target, $mod );
180             };
181              
182             sub _load {
183 19     19   42 my ($target, $mod) = @_;
184              
185 19         29 carp __PACKAGE__.": loading $target from $mod"
186             if DEBUG;
187              
188             package
189             Module::Lazy::_::quarantine;
190              
191 19         59 local $Carp::Internal{ __PACKAGE__ } = 1;
192 19         7044 require $mod;
193             # TODO maybe $target->import()
194             };
195              
196             sub _jump {
197 64     64   137 my ($target, $todo, $nodie) = @_;
198              
199             return sub {
200 16     16   1101 _inflate( $target );
201              
202 16         1950 my $jump = $target->can($todo);
203 16 100       116 goto $jump
204             if $jump; # TODO should also check it's a CODEREF
205              
206 1 50       8 croak qq{Can't locate object method "$todo" via package "$target"}
207             unless $nodie;
208 64         355 };
209             };
210              
211             sub _set_symbol {
212 113     113   248 my ($target, $name, $ref) = @_;
213              
214 113 100       246 if (ref $ref) {
215             # really update symbol table
216 76         157 $cleanup_symbol{$target}{$name}++;
217 15     15   120 no strict 'refs'; ## no critic
  15         29  
  15         775  
218 76         95 *{ $target."::".$name } = $ref;
  76         405  
219             } else {
220             # just set scalar
221 15     15   101 no strict 'refs'; ## no critic
  15         40  
  15         1463  
222 37         54 ${ $target.'::'.$name } = $ref;
  37         9191  
223             };
224             };
225              
226             sub _unset_symbol {
227 72     72   138 my ($target, $name) = @_;
228              
229 15     15   109 no strict 'refs'; ## no critic
  15         28  
  15         1750  
230             # because package scalars are _special_,
231             # move SCALAR ref around the destruction
232             # just in case someone referenced it before module was loaded
233 72         89 my $save = \${ $target."::".$name };
  72         261  
234 72         101 delete ${ $target."::" }{ $name };
  72         297  
235 72         111 *{ $target.'::'.$name } = $save;
  72         292  
236             };
237              
238             =head1 ENVIRONMENT
239              
240             If C is set and true,
241             warns about module loading via Carp.
242              
243             If C is set and true,
244             don't try to lazyload anything - just go straight to C.
245              
246             (That's roughly equivalent to C on command line).
247              
248             =head1 CAVEATS
249              
250             =over
251              
252             =item * The following symbols are currently replaced by stubs
253             in the module to be loaded: C, C, C, C.
254              
255             =item * If a module was ever lazyloaded, a normal C would do nothing.
256             A method must be called to inflate the module.
257              
258             This is done so because a normal require would partially overwrite
259             stub methods and potentially wreak havoc.
260              
261             =item * A fake $VERSION = 10**9 is generated so that C
262             doesn't die. This value is erased before actually loading the module.
263              
264             =back
265              
266              
267              
268             =head1 BUGS
269              
270             =over
271              
272             =item * C does not work with lazy-loaded parent classes.
273              
274             =item * C is not called on the modules being loaded.
275             The decision is yet to be made whether it's good or bad.
276              
277             =item * no way to preload prototyped exported functions
278             (that's what L does),
279             but maybe there should be?
280              
281             =item * certainly not enough interoperability tests.
282              
283             =back
284              
285             Please report bugs via github or RT:
286              
287             =over
288              
289             =item * L
290              
291             =item * C
292              
293             =item * L
294              
295             =back
296              
297             =head1 SUPPORT
298              
299             You can find documentation for this module with the C command.
300              
301             perldoc Module::Lazy
302              
303             You can also look for information at:
304              
305             =over 4
306              
307             =item * github: L
308              
309             =item * RT: CPAN's request tracker (report bugs here)
310              
311             L
312              
313             =item * AnnoCPAN: Annotated CPAN documentation
314              
315             L
316              
317             =item * CPAN Ratings
318              
319             L
320              
321             =item * Search CPAN
322              
323             L
324              
325             =back
326              
327             =head1 SEE ALSO
328              
329             L is another module with similar idea, however,
330             it does it for imported functions rather than methods.
331              
332             =head1 ACKNOWLEDGEMENTS
333              
334             =head1 LICENSE AND COPYRIGHT
335              
336             Copyright 2019 Konstantin S. Uvarin, C<< >>
337              
338             This program is free software; you can redistribute it and/or modify it
339             under the terms of the the Artistic License (2.0). You may obtain a
340             copy of the full license at:
341              
342             L
343              
344             Any use, modification, and distribution of the Standard or Modified
345             Versions is governed by this Artistic License. By using, modifying or
346             distributing the Package, you accept this license. Do not use, modify,
347             or distribute the Package, if you do not accept this license.
348              
349             If your Modified Version has been derived from a Modified Version made
350             by someone other than you, you are nevertheless required to ensure that
351             your Modified Version complies with the requirements of this license.
352              
353             This license does not grant you the right to use any trademark, service
354             mark, tradename, or logo of the Copyright Holder.
355              
356             This license includes the non-exclusive, worldwide, free-of-charge
357             patent license to make, have made, use, offer to sell, sell, import and
358             otherwise transfer the Package with respect to any patent claims
359             licensable by the Copyright Holder that are necessarily infringed by the
360             Package. If you institute patent litigation (including a cross-claim or
361             counterclaim) against any party alleging that the Package constitutes
362             direct or contributory patent infringement, then this Artistic License
363             to you shall terminate on the date that such litigation is filed.
364              
365             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
366             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
367             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
368             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
369             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
370             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
371             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
372             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
373              
374             =cut
375              
376             1; # End of Module::Lazy