[p5sagit/p5-mst-13.2.git] / cpan / Module-Load-Conditional / 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;

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

BEGIN {
    use vars        qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $DEPRECATED
                        $FIND_VERSION $ERROR $CHECK_INC_HASH];
    use Exporter;
    @ISA            = qw[Exporter];
    $VERSION        = '0.31_01';
    $VERBOSE        = 0;
    $DEPRECATED     = 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 dir

Directory, or more exact the C<@INC> entry, where the module was
loaded from.

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

See also C<$Module::Load::Conditional::DEPRECATED>, which affects 
the outcome of this value.

=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($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;
                }
            }
    
            ### store the directory we found the file in
            $href->{dir} = $dir;
    
            ### 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 ( my $line = <$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 = $line =~ /^=(?!cut)/  ? 1 : 
                              $line =~ /^=cut/      ? 0 : 
                              $in_pod;
                    next if $in_pod;
                    
                    ### try to find a version declaration in this string.
                    my $ver = __PACKAGE__->_parse_version( $line );

                    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?
        ###
        ### Update from JPeacock: apparently qv() and version->new
        ### are different things, and we *must* use version->new
        ### here, or things like #30056 might start happening
        $href->{uptodate} = 
            version->new( $args->{version} ) <= version->new( $href->{version} )
                ? 1 
                : 0;
    }

    if ( $DEPRECATED and version->new($]) >= version->new('5.011') ) {
        require Module::CoreList;
        require Config;

        $href->{uptodate} = 0 if 
           exists $Module::CoreList::version{ 0+$] }{ $args->{module} } and
           Module::CoreList::is_deprecated( $args->{module} ) and
           $Config::Config{privlibexp} eq $href->{dir};
    }

    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.
    my $taint_safe_str = do { $str =~ /(^.*$)/sm; $1 };
        
    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 {
                $taint_safe_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?
            ###
            ### Update from JPeacock: apparently qv() and version->new
            ### are different things, and we *must* use version->new
            ### here, or things like #30056 might start happening            
            if (    !$args->{nocache}
                    && defined $CACHE->{$mod}->{usable}
                    && (version->new( $CACHE->{$mod}->{version}||0 ) 
                        >= version->new( $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>.

=head2 $Module::Load::Conditional::DEPRECATED

This controls whether C<Module::Load::Conditional> checks if 
a dual-life core module has been deprecated. If this is set to
true C<check_install> will return false to C<uptodate>, if 
a dual-life module is found to be loaded from C<$Config{privlibexp}>

The default is 0;

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