This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Module::Load::Conditional to 0.20
[perl5.git] / lib / Module / Load / Conditional.pm
CommitLineData
0dc418cb
JB
1package Module::Load::Conditional;
2
3use strict;
4
5use Module::Load;
3fa779ab
JB
6use Params::Check qw[check];
7use Locale::Maketext::Simple Style => 'gettext';
0dc418cb
JB
8
9use Carp ();
10use File::Spec ();
11use FileHandle ();
91e53322 12use version qw[qv];
0dc418cb 13
3fa779ab
JB
14use constant ON_VMS => $^O eq 'VMS';
15
0dc418cb
JB
16BEGIN {
17 use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK
18 $FIND_VERSION $ERROR $CHECK_INC_HASH];
19 use Exporter;
20 @ISA = qw[Exporter];
fc934b13 21 $VERSION = '0.20';
0dc418cb
JB
22 $VERBOSE = 0;
23 $FIND_VERSION = 1;
24 $CHECK_INC_HASH = 0;
25 @EXPORT_OK = qw[check_install can_load requires];
26}
27
28=pod
29
30=head1 NAME
31
32Module::Load::Conditional - Looking up module information / loading at runtime
33
34=head1 SYNOPSIS
35
36 use Module::Load::Conditional qw[can_load check_install requires];
37
38
39 my $use_list = {
40 CPANPLUS => 0.05,
41 LWP => 5.60,
42 'Test::More' => undef,
43 };
44
45 print can_load( modules => $use_list )
46 ? 'all modules loaded successfully'
47 : 'failed to load required modules';
48
49
50 my $rv = check_install( module => 'LWP', version => 5.60 )
51 or print 'LWP is not installed!';
52
53 print 'LWP up to date' if $rv->{uptodate};
54 print "LWP version is $rv->{version}\n";
55 print "LWP is installed as file $rv->{file}\n";
56
57
58 print "LWP requires the following modules to be installed:\n";
59 print join "\n", requires('LWP');
60
61 ### allow M::L::C to peek in your %INC rather than just
62 ### scanning @INC
63 $Module::Load::Conditional::CHECK_INC_HASH = 1;
64
65 ### reset the 'can_load' cache
66 undef $Module::Load::Conditional::CACHE;
67
68 ### don't have Module::Load::Conditional issue warnings --
69 ### default is '1'
70 $Module::Load::Conditional::VERBOSE = 0;
71
72 ### The last error that happened during a call to 'can_load'
73 my $err = $Module::Load::Conditional::ERROR;
74
75
76=head1 DESCRIPTION
77
78Module::Load::Conditional provides simple ways to query and possibly load any of
79the modules you have installed on your system during runtime.
80
81It is able to load multiple modules at once or none at all if one of
82them was not able to load. It also takes care of any error checking
83and so forth.
84
85=head1 Methods
86
87=head1 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] );
88
89C<check_install> allows you to verify if a certain module is installed
90or not. You may call it with the following arguments:
91
92=over 4
93
94=item module
95
96The name of the module you wish to verify -- this is a required key
97
98=item version
99
100The version this module needs to be -- this is optional
101
102=item verbose
103
104Whether or not to be verbose about what it is doing -- it will default
105to $Module::Load::Conditional::VERBOSE
106
107=back
108
109It will return undef if it was not able to find where the module was
110installed, or a hash reference with the following keys if it was able
111to find the file:
112
113=over 4
114
115=item file
116
117Full path to the file that contains the module
118
119=item version
120
121The version number of the installed module - this will be C<undef> if
122the module had no (or unparsable) version number, or if the variable
123C<$Module::Load::Conditional::FIND_VERSION> was set to true.
124(See the C<GLOBAL VARIABLES> section below for details)
125
126=item uptodate
127
128A boolean value indicating whether or not the module was found to be
129at least the version you specified. If you did not specify a version,
130uptodate will always be true if the module was found.
131If no parsable version was found in the module, uptodate will also be
132true, since C<check_install> had no way to verify clearly.
133
134=back
135
136=cut
137
138### this checks if a certain module is installed already ###
139### if it returns true, the module in question is already installed
140### or we found the file, but couldn't open it, OR there was no version
141### to be found in the module
142### it will return 0 if the version in the module is LOWER then the one
143### we are looking for, or if we couldn't find the desired module to begin with
144### if the installed version is higher or equal to the one we want, it will return
145### a hashref with he module name and version in it.. so 'true' as well.
146sub check_install {
147 my %hash = @_;
148
149 my $tmpl = {
150 version => { default => '0.0' },
151 module => { required => 1 },
152 verbose => { default => $VERBOSE },
153 };
154
155 my $args;
156 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
157 warn loc( q[A problem occurred checking arguments] ) if $VERBOSE;
158 return;
159 }
160
161 my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm';
162 my $file_inc = File::Spec::Unix->catfile(
163 split /::/, $args->{module}
164 ) . '.pm';
165
166 ### where we store the return value ###
167 my $href = {
168 file => undef,
169 version => undef,
170 uptodate => undef,
171 };
172
173 my $filename;
174
175 ### check the inc hash if we're allowed to
176 if( $CHECK_INC_HASH ) {
177 $filename = $href->{'file'} =
178 $INC{ $file_inc } if defined $INC{ $file_inc };
179
180 ### find the version by inspecting the package
181 if( defined $filename && $FIND_VERSION ) {
182 no strict 'refs';
183 $href->{version} = ${ "$args->{module}"."::VERSION" };
184 }
185 }
186
187 ### we didnt find the filename yet by looking in %INC,
188 ### so scan the dirs
189 unless( $filename ) {
190
191 DIR: for my $dir ( @INC ) {
192
193 my $fh;
194
195 if ( ref $dir ) {
196 ### @INC hook -- we invoke it and get the filehandle back
197 ### this is actually documented behaviour as of 5.8 ;)
198
199 if (UNIVERSAL::isa($dir, 'CODE')) {
200 ($fh) = $dir->($dir, $file);
201
202 } elsif (UNIVERSAL::isa($dir, 'ARRAY')) {
203 ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}})
204
205 } elsif (UNIVERSAL::can($dir, 'INC')) {
206 ($fh) = $dir->INC->($dir, $file);
207 }
208
209 if (!UNIVERSAL::isa($fh, 'GLOB')) {
210 warn loc(q[Cannot open file '%1': %2], $file, $!)
211 if $args->{verbose};
212 next;
213 }
214
215 $filename = $INC{$file_inc} || $file;
216
217 } else {
218 $filename = File::Spec->catfile($dir, $file);
219 next unless -e $filename;
220
221 $fh = new FileHandle;
222 if (!$fh->open($filename)) {
223 warn loc(q[Cannot open file '%1': %2], $file, $!)
224 if $args->{verbose};
225 next;
226 }
227 }
228
3fa779ab
JB
229 ### files need to be in unix format under vms,
230 ### or they might be loaded twice
231 $href->{file} = ON_VMS
232 ? VMS::Filespec::unixify( $filename )
233 : $filename;
0dc418cb
JB
234
235 ### user wants us to find the version from files
236 if( $FIND_VERSION ) {
237
e163f9a0 238 my $in_pod = 0;
0dc418cb
JB
239 while (local $_ = <$fh> ) {
240
e163f9a0
RGS
241 ### stolen from EU::MM_Unix->parse_version to address
242 ### #24062: "Problem with CPANPLUS 0.076 misidentifying
243 ### versions after installing Text::NSP 1.03" where a
244 ### VERSION mentioned in the POD was found before
245 ### the real $VERSION declaration.
246 $in_pod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $in_pod;
247 next if $in_pod;
248
91e53322
RGS
249 ### try to find a version declaration in this string.
250 my $ver = __PACKAGE__->_parse_version( $_ );
251
252 if( defined $ver ) {
253 $href->{version} = $ver;
0dc418cb
JB
254
255 last DIR;
256 }
257 }
258 }
259 }
260 }
261
262 ### if we couldn't find the file, return undef ###
263 return unless defined $href->{file};
264
3fa779ab 265 ### only complain if we're expected to find a version higher than 0.0 anyway
0dc418cb
JB
266 if( $FIND_VERSION and not defined $href->{version} ) {
267 { ### don't warn about the 'not numeric' stuff ###
268 local $^W;
269
270 ### if we got here, we didn't find the version
271 warn loc(q[Could not check version on '%1'], $args->{module} )
272 if $args->{verbose} and $args->{version} > 0;
273 }
274 $href->{uptodate} = 1;
275
276 } else {
277 ### don't warn about the 'not numeric' stuff ###
278 local $^W;
3fa779ab
JB
279
280 ### use qv(), as it will deal with developer release number
281 ### ie ones containing _ as well. This addresses bug report
282 ### #29348: Version compare logic doesn't handle alphas?
283 $href->{uptodate} =
284 qv( $args->{version} ) <= qv( $href->{version} ) ? 1 : 0;
0dc418cb
JB
285 }
286
287 return $href;
288}
289
91e53322
RGS
290sub _parse_version {
291 my $self = shift;
292 my $str = shift or return;
293 my $verbose = shift or 0;
294
295 ### skip commented out lines, they won't eval to anything.
296 return if $str =~ /^\s*#/;
297
298 ### the following regexp & eval statement comes from the
299 ### ExtUtils::MakeMaker source (EU::MM_Unix->parse_version)
300 ### Following #18892, which tells us the original
301 ### regex breaks under -T, we must modifiy it so
302 ### it captures the entire expression, and eval /that/
303 ### rather than $_, which is insecure.
304
305 if( $str =~ /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
306
307 print "Evaluating: $str\n" if $verbose;
308
309 ### this creates a string to be eval'd, like:
310 # package Module::Load::Conditional::_version;
311 # no strict;
312 #
313 # local $VERSION;
314 # $VERSION=undef; do {
315 # use version; $VERSION = qv('0.0.3');
316 # }; $VERSION
317
318 my $eval = qq{
319 package Module::Load::Conditional::_version;
320 no strict;
321
322 local $1$2;
323 \$$2=undef; do {
324 $str
325 }; \$$2
326 };
327
328 print "Evaltext: $eval\n" if $verbose;
329
330 my $result = do {
331 local $^W = 0;
332 eval($eval);
333 };
334
335
336 my $rv = defined $result ? $result : '0.0';
337
338 print( $@ ? "Error: $@\n" : "Result: $rv\n" ) if $verbose;
339
340 return $rv;
341 }
342
343 ### unable to find a version in this string
344 return;
345}
346
0dc418cb
JB
347=head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] )
348
349C<can_load> will take a list of modules, optionally with version
350numbers and determine if it is able to load them. If it can load *ALL*
351of them, it will. If one or more are unloadable, none will be loaded.
352
353This is particularly useful if you have More Than One Way (tm) to
354solve a problem in a program, and only wish to continue down a path
355if all modules could be loaded, and not load them if they couldn't.
356
357This function uses the C<load> function from Module::Load under the
358hood.
359
360C<can_load> takes the following arguments:
361
362=over 4
363
364=item modules
365
366This is a hashref of module/version pairs. The version indicates the
367minimum version to load. If no version is provided, any version is
368assumed to be good enough.
369
370=item verbose
371
372This controls whether warnings should be printed if a module failed
373to load.
374The default is to use the value of $Module::Load::Conditional::VERBOSE.
375
376=item nocache
377
378C<can_load> keeps its results in a cache, so it will not load the
379same module twice, nor will it attempt to load a module that has
380already failed to load before. By default, C<can_load> will check its
381cache, but you can override that by setting C<nocache> to true.
382
383=cut
384
385sub can_load {
386 my %hash = @_;
387
388 my $tmpl = {
389 modules => { default => {}, strict_type => 1 },
390 verbose => { default => $VERBOSE },
391 nocache => { default => 0 },
392 };
393
394 my $args;
395
396 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
397 $ERROR = loc(q[Problem validating arguments!]);
398 warn $ERROR if $VERBOSE;
399 return;
400 }
401
402 ### layout of $CACHE:
403 ### $CACHE = {
404 ### $ module => {
405 ### usable => BOOL,
406 ### version => \d,
407 ### file => /path/to/file,
408 ### },
409 ### };
410
411 $CACHE ||= {}; # in case it was undef'd
412
413 my $error;
414 BLOCK: {
415 my $href = $args->{modules};
416
417 my @load;
418 for my $mod ( keys %$href ) {
419
420 next if $CACHE->{$mod}->{usable} && !$args->{nocache};
421
422 ### else, check if the hash key is defined already,
423 ### meaning $mod => 0,
424 ### indicating UNSUCCESSFUL prior attempt of usage
3fa779ab
JB
425
426 ### use qv(), as it will deal with developer release number
427 ### ie ones containing _ as well. This addresses bug report
428 ### #29348: Version compare logic doesn't handle alphas?
0dc418cb
JB
429 if ( !$args->{nocache}
430 && defined $CACHE->{$mod}->{usable}
3fa779ab 431 && (qv($CACHE->{$mod}->{version}||0) >= qv($href->{$mod}))
0dc418cb
JB
432 ) {
433 $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod);
434 last BLOCK;
435 }
436
437 my $mod_data = check_install(
438 module => $mod,
439 version => $href->{$mod}
440 );
441
442 if( !$mod_data or !defined $mod_data->{file} ) {
443 $error = loc(q[Could not find or check module '%1'], $mod);
444 $CACHE->{$mod}->{usable} = 0;
445 last BLOCK;
446 }
447
448 map {
449 $CACHE->{$mod}->{$_} = $mod_data->{$_}
450 } qw[version file uptodate];
451
452 push @load, $mod;
453 }
454
455 for my $mod ( @load ) {
456
457 if ( $CACHE->{$mod}->{uptodate} ) {
458
459 eval { load $mod };
460
461 ### in case anything goes wrong, log the error, the fact
462 ### we tried to use this module and return 0;
463 if( $@ ) {
464 $error = $@;
465 $CACHE->{$mod}->{usable} = 0;
466 last BLOCK;
467 } else {
468 $CACHE->{$mod}->{usable} = 1;
469 }
470
471 ### module not found in @INC, store the result in
472 ### $CACHE and return 0
473 } else {
474
475 $error = loc(q[Module '%1' is not uptodate!], $mod);
476 $CACHE->{$mod}->{usable} = 0;
477 last BLOCK;
478 }
479 }
480
481 } # BLOCK
482
483 if( defined $error ) {
484 $ERROR = $error;
485 Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose};
3fa779ab 486 return;
0dc418cb
JB
487 } else {
488 return 1;
489 }
490}
491
3fa779ab
JB
492=back
493
0dc418cb
JB
494=head2 @list = requires( MODULE );
495
496C<requires> can tell you what other modules a particular module
497requires. This is particularly useful when you're intending to write
498a module for public release and are listing its prerequisites.
499
500C<requires> takes but one argument: the name of a module.
501It will then first check if it can actually load this module, and
502return undef if it can't.
503Otherwise, it will return a list of modules and pragmas that would
504have been loaded on the module's behalf.
505
506Note: The list C<require> returns has originated from your current
507perl and your current install.
508
509=cut
510
511sub requires {
512 my $who = shift;
513
514 unless( check_install( module => $who ) ) {
515 warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE;
516 return undef;
517 }
518
519 my $lib = join " ", map { qq["-I$_"] } @INC;
520 my $cmd = qq[$^X $lib -M$who -e"print(join(qq[\\n],keys(%INC)))"];
521
522 return sort
523 grep { !/^$who$/ }
524 map { chomp; s|/|::|g; $_ }
525 grep { s|\.pm$||i; }
526 `$cmd`;
527}
528
5291;
530
531__END__
532
533=head1 Global Variables
534
535The behaviour of Module::Load::Conditional can be altered by changing the
536following global variables:
537
538=head2 $Module::Load::Conditional::VERBOSE
539
540This controls whether Module::Load::Conditional will issue warnings and
541explanations as to why certain things may have failed. If you set it
542to 0, Module::Load::Conditional will not output any warnings.
543The default is 0;
544
545=head2 $Module::Load::Conditional::FIND_VERSION
546
547This controls whether Module::Load::Conditional will try to parse
548(and eval) the version from the module you're trying to load.
549
550If you don't wish to do this, set this variable to C<false>. Understand
551then that version comparisons are not possible, and Module::Load::Conditional
552can not tell you what module version you have installed.
553This may be desirable from a security or performance point of view.
554Note that C<$FIND_VERSION> code runs safely under C<taint mode>.
555
556The default is 1;
557
558=head2 $Module::Load::Conditional::CHECK_INC_HASH
559
560This controls whether C<Module::Load::Conditional> checks your
561C<%INC> hash to see if a module is available. By default, only
562C<@INC> is scanned to see if a module is physically on your
563filesystem, or avialable via an C<@INC-hook>. Setting this variable
564to C<true> will trust any entries in C<%INC> and return them for
565you.
566
567The default is 0;
568
569=head2 $Module::Load::Conditional::CACHE
570
571This holds the cache of the C<can_load> function. If you explicitly
572want to remove the current cache, you can set this variable to
573C<undef>
574
575=head2 $Module::Load::Conditional::ERROR
576
577This holds a string of the last error that happened during a call to
578C<can_load>. It is useful to inspect this when C<can_load> returns
579C<undef>.
580
581=head1 See Also
582
583C<Module::Load>
584
3fa779ab
JB
585=head1 BUG REPORTS
586
587Please report bugs or other issues to E<lt>bug-module-load-conditional@rt.cpan.orgE<gt>.
588
0dc418cb
JB
589=head1 AUTHOR
590
3fa779ab 591This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
0dc418cb
JB
592
593=head1 COPYRIGHT
594
3fa779ab
JB
595This library is free software; you may redistribute and/or modify it
596under the same terms as Perl itself.
0dc418cb 597
3fa779ab 598=cut