[perl5.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 Module::Metadata ();

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.54';
    $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

=head2 $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 ;)

                my $existed_in_inc = $INC{$file_inc};

                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;

                delete $INC{$file_inc} if not $existed_in_inc;

            } 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;

            ### if we don't need the version, we're done
            last DIR unless $FIND_VERSION;

            ### otherwise, the user wants us to find the version from files
            my $mod_info = Module::Metadata->new_from_handle( $fh, $filename );
            my $ver      = $mod_info->version( $args->{module} );

            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

        ### We have to wrap this in an eval as version-0.82 raises
        ### exceptions and not warnings now *sigh*

        eval {

          $href->{uptodate} =
            version->new( $args->{version} ) <= version->new( $href->{version} )
                ? 1
                : 0;

        };
    }

    if ( $DEPRECATED and "$]" >= 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;
}

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