[p5sagit/p5-mst-13.2.git] / lib / Module / Load / Conditional.pm

package Module::Load::Conditional;

use strict;

use Module::Load;
use Params::Check                       qw[check];
use Locale::Maketext::Simple Style  => 'gettext';

use Carp        ();
use File::Spec  ();
use FileHandle  ();
use version     qw[qv];

use constant ON_VMS  => $^O eq 'VMS';

BEGIN {
    use vars        qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK 
                        $FIND_VERSION $ERROR $CHECK_INC_HASH];
    use Exporter;
    @ISA            = qw[Exporter];
    $VERSION        = '0.22';
    $VERBOSE        = 0;
    $FIND_VERSION   = 1;
    $CHECK_INC_HASH = 0;
    @EXPORT_OK      = qw[check_install can_load requires];
}

=pod

=head1 NAME

Module::Load::Conditional - Looking up module information / loading at runtime

=head1 SYNOPSIS

    use Module::Load::Conditional qw[can_load check_install requires];


    my $use_list = {
            CPANPLUS        => 0.05,
            LWP             => 5.60,
            'Test::More'    => undef,
    };

    print can_load( modules => $use_list )
            ? 'all modules loaded successfully'
            : 'failed to load required modules';


    my $rv = check_install( module => 'LWP', version => 5.60 )
                or print 'LWP is not installed!';

    print 'LWP up to date' if $rv->{uptodate};
    print "LWP version is $rv->{version}\n";
    print "LWP is installed as file $rv->{file}\n";


    print "LWP requires the following modules to be installed:\n";
    print join "\n", requires('LWP');

    ### allow M::L::C to peek in your %INC rather than just
    ### scanning @INC
    $Module::Load::Conditional::CHECK_INC_HASH = 1;

    ### reset the 'can_load' cache
    undef $Module::Load::Conditional::CACHE;

    ### don't have Module::Load::Conditional issue warnings --
    ### default is '1'
    $Module::Load::Conditional::VERBOSE = 0;

    ### The last error that happened during a call to 'can_load'
    my $err = $Module::Load::Conditional::ERROR;


=head1 DESCRIPTION

Module::Load::Conditional provides simple ways to query and possibly load any of
the modules you have installed on your system during runtime.

It is able to load multiple modules at once or none at all if one of
them was not able to load. It also takes care of any error checking
and so forth.

=head1 Methods

=head1 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] );

C<check_install> allows you to verify if a certain module is installed
or not. You may call it with the following arguments:

=over 4

=item module

The name of the module you wish to verify -- this is a required key

=item version

The version this module needs to be -- this is optional

=item verbose

Whether or not to be verbose about what it is doing -- it will default
to $Module::Load::Conditional::VERBOSE

=back

It will return undef if it was not able to find where the module was
installed, or a hash reference with the following keys if it was able
to find the file:

=over 4

=item file

Full path to the file that contains the module

=item version

The version number of the installed module - this will be C<undef> if
the module had no (or unparsable) version number, or if the variable
C<$Module::Load::Conditional::FIND_VERSION> was set to true.
(See the C<GLOBAL VARIABLES> section below for details)

=item uptodate

A boolean value indicating whether or not the module was found to be
at least the version you specified. If you did not specify a version,
uptodate will always be true if the module was found.
If no parsable version was found in the module, uptodate will also be
true, since C<check_install> had no way to verify clearly.

=back

=cut

### this checks if a certain module is installed already ###
### if it returns true, the module in question is already installed
### or we found the file, but couldn't open it, OR there was no version
### to be found in the module
### it will return 0 if the version in the module is LOWER then the one
### we are looking for, or if we couldn't find the desired module to begin with
### if the installed version is higher or equal to the one we want, it will return
### a hashref with he module name and version in it.. so 'true' as well.
sub check_install {
    my %hash = @_;

    my $tmpl = {
            version => { default    => '0.0'    },
            module  => { required   => 1        },
            verbose => { default    => $VERBOSE },
    };

    my $args;
    unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
        warn loc( q[A problem occurred checking arguments] ) if $VERBOSE;
        return;
    }

    my $file     = File::Spec->catfile( split /::/, $args->{module} ) . '.pm';
    my $file_inc = File::Spec::Unix->catfile( 
                        split /::/, $args->{module} 
                    ) . '.pm';

    ### where we store the return value ###
    my $href = {
            file        => undef,
            version     => undef,
            uptodate    => undef,
    };
    
    my $filename;

    ### check the inc hash if we're allowed to
    if( $CHECK_INC_HASH ) {
        $filename = $href->{'file'} = 
            $INC{ $file_inc } if defined $INC{ $file_inc };

        ### find the version by inspecting the package
        if( defined $filename && $FIND_VERSION ) {
            no strict 'refs';
            $href->{version} = ${ "$args->{module}"."::VERSION" }; 
        }
    }     

    ### we didnt find the filename yet by looking in %INC,
    ### so scan the dirs
    unless( $filename ) {

        DIR: for my $dir ( @INC ) {
    
            my $fh;
    
            if ( ref $dir ) {
                ### @INC hook -- we invoke it and get the filehandle back
                ### this is actually documented behaviour as of 5.8 ;)
    
                if (UNIVERSAL::isa($dir, 'CODE')) {
                    ($fh) = $dir->($dir, $file);
    
                } elsif (UNIVERSAL::isa($dir, 'ARRAY')) {
                    ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}})
    
                } elsif (UNIVERSAL::can($dir, 'INC')) {
                    ($fh) = $dir->INC->($dir, $file);
                }
    
                if (!UNIVERSAL::isa($fh, 'GLOB')) {
                    warn loc(q[Cannot open file '%1': %2], $file, $!)
                            if $args->{verbose};
                    next;
                }
    
                $filename = $INC{$file_inc} || $file;
    
            } else {
                $filename = File::Spec->catfile($dir, $file);
                next unless -e $filename;
    
                $fh = new FileHandle;
                if (!$fh->open($filename)) {
                    warn loc(q[Cannot open file '%1': %2], $file, $!)
                            if $args->{verbose};
                    next;
                }
            }
    
            ### files need to be in unix format under vms,
            ### or they might be loaded twice
            $href->{file} = ON_VMS
                ? VMS::Filespec::unixify( $filename )
                : $filename;
    
            ### user wants us to find the version from files
            if( $FIND_VERSION ) {
                
                my $in_pod = 0;
                while (local $_ = <$fh> ) {
    
                    ### stolen from EU::MM_Unix->parse_version to address
                    ### #24062: "Problem with CPANPLUS 0.076 misidentifying
                    ### versions after installing Text::NSP 1.03" where a 
                    ### VERSION mentioned in the POD was found before
                    ### the real $VERSION declaration.
                    $in_pod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $in_pod;
                    next if $in_pod;
                    
                    ### try to find a version declaration in this string.
                    my $ver = __PACKAGE__->_parse_version( $_ );

                    if( defined $ver ) {
                        $href->{version} = $ver;
        
                        last DIR;
                    }
                }
            }
        }
    }
    
    ### if we couldn't find the file, return undef ###
    return unless defined $href->{file};

    ### only complain if we're expected to find a version higher than 0.0 anyway
    if( $FIND_VERSION and not defined $href->{version} ) {
        {   ### don't warn about the 'not numeric' stuff ###
            local $^W;

            ### if we got here, we didn't find the version
            warn loc(q[Could not check version on '%1'], $args->{module} )
                    if $args->{verbose} and $args->{version} > 0;
        }
        $href->{uptodate} = 1;

    } else {
        ### don't warn about the 'not numeric' stuff ###
        local $^W;
        
        ### use qv(), as it will deal with developer release number
        ### ie ones containing _ as well. This addresses bug report
        ### #29348: Version compare logic doesn't handle alphas?
        $href->{uptodate} = 
            qv( $args->{version} ) <= qv( $href->{version} ) ? 1 : 0;
    }

    return $href;
}

sub _parse_version {
    my $self    = shift;
    my $str     = shift or return;
    my $verbose = shift or 0;

    ### skip commented out lines, they won't eval to anything.
    return if $str =~ /^\s*#/;
        
    ### the following regexp & eval statement comes from the 
    ### ExtUtils::MakeMaker source (EU::MM_Unix->parse_version) 
    ### Following #18892, which tells us the original
    ### regex breaks under -T, we must modifiy it so
    ### it captures the entire expression, and eval /that/
    ### rather than $_, which is insecure.

    if( $str =~ /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
        
        print "Evaluating: $str\n" if $verbose;
        
        ### this creates a string to be eval'd, like:
        # package Module::Load::Conditional::_version;
        # no strict;
        # 
        # local $VERSION;
        # $VERSION=undef; do {
        #     use version; $VERSION = qv('0.0.3');
        # }; $VERSION        
        
        my $eval = qq{
            package Module::Load::Conditional::_version;
            no strict;

            local $1$2;
            \$$2=undef; do {
                $str
            }; \$$2
        };
        
        print "Evaltext: $eval\n" if $verbose;
        
        my $result = do {
            local $^W = 0;
            eval($eval); 
        };
        
        
        my $rv = defined $result ? $result : '0.0';

        print( $@ ? "Error: $@\n" : "Result: $rv\n" ) if $verbose;

        return $rv;
    }
    
    ### unable to find a version in this string
    return;
}

=head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] )

C<can_load> will take a list of modules, optionally with version
numbers and determine if it is able to load them. If it can load *ALL*
of them, it will. If one or more are unloadable, none will be loaded.

This is particularly useful if you have More Than One Way (tm) to
solve a problem in a program, and only wish to continue down a path
if all modules could be loaded, and not load them if they couldn't.

This function uses the C<load> function from Module::Load under the
hood.

C<can_load> takes the following arguments:

=over 4

=item modules

This is a hashref of module/version pairs. The version indicates the
minimum version to load. If no version is provided, any version is
assumed to be good enough.

=item verbose

This controls whether warnings should be printed if a module failed
to load.
The default is to use the value of $Module::Load::Conditional::VERBOSE.

=item nocache

C<can_load> keeps its results in a cache, so it will not load the
same module twice, nor will it attempt to load a module that has
already failed to load before. By default, C<can_load> will check its
cache, but you can override that by setting C<nocache> to true.

=cut

sub can_load {
    my %hash = @_;

    my $tmpl = {
        modules     => { default => {}, strict_type => 1 },
        verbose     => { default => $VERBOSE },
        nocache     => { default => 0 },
    };

    my $args;

    unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
        $ERROR = loc(q[Problem validating arguments!]);
        warn $ERROR if $VERBOSE;
        return;
    }

    ### layout of $CACHE:
    ### $CACHE = {
    ###     $ module => {
    ###             usable  => BOOL,
    ###             version => \d,
    ###             file    => /path/to/file,
    ###     },
    ### };

    $CACHE ||= {}; # in case it was undef'd

    my $error;
    BLOCK: {
        my $href = $args->{modules};

        my @load;
        for my $mod ( keys %$href ) {

            next if $CACHE->{$mod}->{usable} && !$args->{nocache};

            ### else, check if the hash key is defined already,
            ### meaning $mod => 0,
            ### indicating UNSUCCESSFUL prior attempt of usage

            ### use qv(), as it will deal with developer release number
            ### ie ones containing _ as well. This addresses bug report
            ### #29348: Version compare logic doesn't handle alphas?
            if (    !$args->{nocache}
                    && defined $CACHE->{$mod}->{usable}
                    && (qv($CACHE->{$mod}->{version}||0) >= qv($href->{$mod}))
            ) {
                $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod);
                last BLOCK;
            }

            my $mod_data = check_install(
                                    module  => $mod,
                                    version => $href->{$mod}
                                );

            if( !$mod_data or !defined $mod_data->{file} ) {
                $error = loc(q[Could not find or check module '%1'], $mod);
                $CACHE->{$mod}->{usable} = 0;
                last BLOCK;
            }

            map {
                $CACHE->{$mod}->{$_} = $mod_data->{$_}
            } qw[version file uptodate];

            push @load, $mod;
        }

        for my $mod ( @load ) {

            if ( $CACHE->{$mod}->{uptodate} ) {

                eval { load $mod };

                ### in case anything goes wrong, log the error, the fact
                ### we tried to use this module and return 0;
                if( $@ ) {
                    $error = $@;
                    $CACHE->{$mod}->{usable} = 0;
                    last BLOCK;
                } else {
                    $CACHE->{$mod}->{usable} = 1;
                }

            ### module not found in @INC, store the result in
            ### $CACHE and return 0
            } else {

                $error = loc(q[Module '%1' is not uptodate!], $mod);
                $CACHE->{$mod}->{usable} = 0;
                last BLOCK;
            }
        }

    } # BLOCK

    if( defined $error ) {
        $ERROR = $error;
        Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose};
        return;
    } else {
        return 1;
    }
}

=back

=head2 @list = requires( MODULE );

C<requires> can tell you what other modules a particular module
requires. This is particularly useful when you're intending to write
a module for public release and are listing its prerequisites.

C<requires> takes but one argument: the name of a module.
It will then first check if it can actually load this module, and
return undef if it can't.
Otherwise, it will return a list of modules and pragmas that would
have been loaded on the module's behalf.

Note: The list C<require> returns has originated from your current
perl and your current install.

=cut

sub requires {
    my $who = shift;

    unless( check_install( module => $who ) ) {
        warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE;
        return undef;
    }

    my $lib = join " ", map { qq["-I$_"] } @INC;
    my $cmd = qq[$^X $lib -M$who -e"print(join(qq[\\n],keys(%INC)))"];

    return  sort
                grep { !/^$who$/  }
                map  { chomp; s|/|::|g; $_ }
                grep { s|\.pm$||i; }
            `$cmd`;
}

1;

__END__

=head1 Global Variables

The behaviour of Module::Load::Conditional can be altered by changing the
following global variables:

=head2 $Module::Load::Conditional::VERBOSE

This controls whether Module::Load::Conditional will issue warnings and
explanations as to why certain things may have failed. If you set it
to 0, Module::Load::Conditional will not output any warnings.
The default is 0;

=head2 $Module::Load::Conditional::FIND_VERSION

This controls whether Module::Load::Conditional will try to parse
(and eval) the version from the module you're trying to load. 

If you don't wish to do this, set this variable to C<false>. Understand
then that version comparisons are not possible, and Module::Load::Conditional
can not tell you what module version you have installed.
This may be desirable from a security or performance point of view. 
Note that C<$FIND_VERSION> code runs safely under C<taint mode>.

The default is 1;

=head2 $Module::Load::Conditional::CHECK_INC_HASH

This controls whether C<Module::Load::Conditional> checks your
C<%INC> hash to see if a module is available. By default, only
C<@INC> is scanned to see if a module is physically on your
filesystem, or avialable via an C<@INC-hook>. Setting this variable
to C<true> will trust any entries in C<%INC> and return them for
you.

The default is 0;

=head2 $Module::Load::Conditional::CACHE

This holds the cache of the C<can_load> function. If you explicitly
want to remove the current cache, you can set this variable to
C<undef>

=head2 $Module::Load::Conditional::ERROR

This holds a string of the last error that happened during a call to
C<can_load>. It is useful to inspect this when C<can_load> returns
C<undef>.

=head1 See Also

C<Module::Load>

=head1 BUG REPORTS

Please report bugs or other issues to E<lt>bug-module-load-conditional@rt.cpan.orgE<gt>.

=head1 AUTHOR

This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.

=head1 COPYRIGHT

This library is free software; you may redistribute and/or modify it 
under the same terms as Perl itself.

=cut
Commit	Line	Data
0dc418cb	1	package Module::Load::Conditional;
	2
	3	use strict;
	4
	5	use Module::Load;
3fa779ab	6	use Params::Check qw[check];
3fa779ab	7	use Locale::Maketext::Simple Style => 'gettext';
0dc418cb	8
	9	use Carp ();
	10	use File::Spec ();
	11	use FileHandle ();
91e53322	12	use version qw[qv];
0dc418cb	13
3fa779ab	14	use constant ON_VMS => $^O eq 'VMS';
3fa779ab	15
0dc418cb	16	BEGIN {
	17	use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK
	18	$FIND_VERSION $ERROR $CHECK_INC_HASH];
	19	use Exporter;
	20	@ISA = qw[Exporter];
c259ebfb	21	$VERSION = '0.22';
0dc418cb	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
	32	Module::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
	78	Module::Load::Conditional provides simple ways to query and possibly load any of
	79	the modules you have installed on your system during runtime.
	80
	81	It is able to load multiple modules at once or none at all if one of
	82	them was not able to load. It also takes care of any error checking
	83	and so forth.
	84
	85	=head1 Methods
86
87	=head1 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] );
88
89	C<check_install> allows you to verify if a certain module is installed
90	or not. You may call it with the following arguments:
91
92	=over 4
93
94	=item module
95
96	The name of the module you wish to verify -- this is a required key
97
98	=item version
99
100	The version this module needs to be -- this is optional
101
102	=item verbose
103
104	Whether or not to be verbose about what it is doing -- it will default
105	to $Module::Load::Conditional::VERBOSE
106
107	=back
108
109	It will return undef if it was not able to find where the module was
110	installed, or a hash reference with the following keys if it was able
111	to find the file:
112
113	=over 4
114
115	=item file
116
117	Full path to the file that contains the module
118
119	=item version
120
121	The version number of the installed module - this will be C<undef> if
122	the module had no (or unparsable) version number, or if the variable
123	C<$Module::Load::Conditional::FIND_VERSION> was set to true.
124	(See the C<GLOBAL VARIABLES> section below for details)
125
126	=item uptodate
127
128	A boolean value indicating whether or not the module was found to be
129	at least the version you specified. If you did not specify a version,
130	uptodate will always be true if the module was found.
131	If no parsable version was found in the module, uptodate will also be
132	true, 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.
146	sub 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	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	234
	235	### user wants us to find the version from files
	236	if( $FIND_VERSION ) {
	237
e163f9a0	238	my $in_pod = 0;
0dc418cb	239	while (local $_ = <$fh> ) {
0dc418cb	240
e163f9a0	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	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	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	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	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	285	}
	286
	287	return $href;
	288	}
	289
91e53322	290	sub _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	347	=head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] )
	348
	349	C<can_load> will take a list of modules, optionally with version
	350	numbers and determine if it is able to load them. If it can load ALL
	351	of them, it will. If one or more are unloadable, none will be loaded.
	352
	353	This is particularly useful if you have More Than One Way (tm) to
	354	solve a problem in a program, and only wish to continue down a path
	355	if all modules could be loaded, and not load them if they couldn't.
	356
	357	This function uses the C<load> function from Module::Load under the
	358	hood.
	359
	360	C<can_load> takes the following arguments:
	361
	362	=over 4
	363
	364	=item modules
	365
	366	This is a hashref of module/version pairs. The version indicates the
	367	minimum version to load. If no version is provided, any version is
	368	assumed to be good enough.
	369
	370	=item verbose
	371
	372	This controls whether warnings should be printed if a module failed
	373	to load.
	374	The default is to use the value of $Module::Load::Conditional::VERBOSE.
	375
	376	=item nocache
	377
	378	C<can_load> keeps its results in a cache, so it will not load the
	379	same module twice, nor will it attempt to load a module that has
	380	already failed to load before. By default, C<can_load> will check its
	381	cache, but you can override that by setting C<nocache> to true.
	382
	383	=cut
	384
	385	sub 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	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	429	if ( !$args->{nocache}
0dc418cb	430	&& defined $CACHE->{$mod}->{usable}
3fa779ab	431	&& (qv($CACHE->{$mod}->{version}\|\|0) >= qv($href->{$mod}))
0dc418cb	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	487	} else {
	488	return 1;
	489	}
	490	}
	491
3fa779ab	492	=back
3fa779ab	493
0dc418cb	494	=head2 @list = requires( MODULE );
	495
	496	C<requires> can tell you what other modules a particular module
	497	requires. This is particularly useful when you're intending to write
	498	a module for public release and are listing its prerequisites.
	499
	500	C<requires> takes but one argument: the name of a module.
	501	It will then first check if it can actually load this module, and
	502	return undef if it can't.
	503	Otherwise, it will return a list of modules and pragmas that would
	504	have been loaded on the module's behalf.
	505
	506	Note: The list C<require> returns has originated from your current
	507	perl and your current install.
	508
	509	=cut
	510
	511	sub 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
	529	1;
	530
	531	__END__
	532
	533	=head1 Global Variables
	534
	535	The behaviour of Module::Load::Conditional can be altered by changing the
	536	following global variables:
	537
	538	=head2 $Module::Load::Conditional::VERBOSE
	539
	540	This controls whether Module::Load::Conditional will issue warnings and
	541	explanations as to why certain things may have failed. If you set it
	542	to 0, Module::Load::Conditional will not output any warnings.
	543	The default is 0;
	544
	545	=head2 $Module::Load::Conditional::FIND_VERSION
	546
	547	This controls whether Module::Load::Conditional will try to parse
	548	(and eval) the version from the module you're trying to load.
	549
	550	If you don't wish to do this, set this variable to C<false>. Understand
	551	then that version comparisons are not possible, and Module::Load::Conditional
	552	can not tell you what module version you have installed.
	553	This may be desirable from a security or performance point of view.
	554	Note that C<$FIND_VERSION> code runs safely under C<taint mode>.
	555
	556	The default is 1;
	557
558	=head2 $Module::Load::Conditional::CHECK_INC_HASH
559
560	This controls whether C<Module::Load::Conditional> checks your
561	C<%INC> hash to see if a module is available. By default, only
562	C<@INC> is scanned to see if a module is physically on your
563	filesystem, or avialable via an C<@INC-hook>. Setting this variable
564	to C<true> will trust any entries in C<%INC> and return them for
565	you.
566
567	The default is 0;
568
569	=head2 $Module::Load::Conditional::CACHE
570
571	This holds the cache of the C<can_load> function. If you explicitly
572	want to remove the current cache, you can set this variable to
573	C<undef>
574
575	=head2 $Module::Load::Conditional::ERROR
576
577	This holds a string of the last error that happened during a call to
578	C<can_load>. It is useful to inspect this when C<can_load> returns
579	C<undef>.
580
581	=head1 See Also
582
583	C<Module::Load>
584
3fa779ab	585	=head1 BUG REPORTS
	586
	587	Please report bugs or other issues to E<lt>bug-module-load-conditional@rt.cpan.orgE<gt>.
	588
0dc418cb	589	=head1 AUTHOR
0dc418cb	590
3fa779ab	591	This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
0dc418cb	592
	593	=head1 COPYRIGHT
	594
3fa779ab	595	This library is free software; you may redistribute and/or modify it
3fa779ab	596	under the same terms as Perl itself.
0dc418cb	597
3fa779ab	598	=cut