[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  ();

BEGIN {
    use vars        qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK 
                        $FIND_VERSION $ERROR $CHECK_INC_HASH];
    use Exporter;
    @ISA            = qw[Exporter];
    $VERSION        = '0.14';
    $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;
                    
                    ### skip commented out lines, they won't eval to anything.
                    next if /^\s*#/;
        
                    ### the following regexp comes from the ExtUtils::MakeMaker
                    ### documentation.
                    ### 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 ( /([\$*][\w\:\']*\bVERSION\b.*\=.*)/ ) {
         
                        ### this will eval the version in to $VERSION if it
                        ### was declared as $VERSION in the module.
                        ### else the result will be in $res.
                        ### this is a fix on skud's Module::InstalledVersion
         
                        local $VERSION;
                        my $res = eval $1;
         
                        ### default to '0.0' if there REALLY is no version
                        ### all to satisfy warnings
                        $href->{version} = $VERSION || $res || '0.0';
        
                        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;
}

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