[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];

BEGIN {
    use vars        qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK 
                        $FIND_VERSION $ERROR $CHECK_INC_HASH];
    use Exporter;
    @ISA            = qw[Exporter];
    $VERSION        = '0.16';
    $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;
                }
            }
    
            $href->{file} = $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 expected fo 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;
        $href->{uptodate} = $args->{version} <= $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
            if (    !$args->{nocache}
                    && defined $CACHE->{$mod}->{usable}
                    && (($CACHE->{$mod}->{version}||0) >= $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 undef;
    } else {
        return 1;
    }
}

=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 AUTHOR

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

=head1 COPYRIGHT

This module is copyright (c) 2002-2007 Jos Boumans 
E<lt>kane@cpan.orgE<gt>. All rights reserved.

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