?? conditional.pm
字號:
package Module::Load::Conditional;use strict;use Module::Load;use Params::Check qw[check];use Locale::Maketext::Simple Style => 'gettext';use Carp ();use File::Spec ();use FileHandle ();use version qw[qv];use constant ON_VMS => $^O eq 'VMS';BEGIN { use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $FIND_VERSION $ERROR $CHECK_INC_HASH]; use Exporter; @ISA = qw[Exporter]; $VERSION = '0.22'; $VERBOSE = 0; $FIND_VERSION = 1; $CHECK_INC_HASH = 0; @EXPORT_OK = qw[check_install can_load requires];}=pod=head1 NAMEModule::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 DESCRIPTIONModule::Load::Conditional provides simple ways to query and possibly load any ofthe modules you have installed on your system during runtime.It is able to load multiple modules at once or none at all if one ofthem was not able to load. It also takes care of any error checkingand 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 installedor not. You may call it with the following arguments:=over 4=item moduleThe name of the module you wish to verify -- this is a required key=item versionThe version this module needs to be -- this is optional=item verboseWhether or not to be verbose about what it is doing -- it will defaultto $Module::Load::Conditional::VERBOSE=backIt will return undef if it was not able to find where the module wasinstalled, or a hash reference with the following keys if it was ableto find the file:=over 4=item fileFull path to the file that contains the module=item versionThe version number of the installed module - this will be C<undef> ifthe module had no (or unparsable) version number, or if the variableC<$Module::Load::Conditional::FIND_VERSION> was set to true.(See the C<GLOBAL VARIABLES> section below for details)=item uptodateA boolean value indicating whether or not the module was found to beat 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 betrue, since C<check_install> had no way to verify clearly.=back=cut### this checks if a certain module is installed already ###### if it returns true, the module in question is already installed### or we found the file, but couldn't open it, OR there was no version### to be found in the module### it will return 0 if the version in the module is LOWER then the one### we are looking for, or if we couldn't find the desired module to begin with### if the installed version is higher or equal to the one we want, it will return### a hashref with he module name and version in it.. so 'true' as well.sub check_install { my %hash = @_; my $tmpl = { version => { default => '0.0' }, module => { required => 1 }, verbose => { default => $VERBOSE }, }; my $args; unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) { warn loc( q[A problem occurred checking arguments] ) if $VERBOSE; return; } my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm'; my $file_inc = File::Spec::Unix->catfile( split /::/, $args->{module} ) . '.pm'; ### where we store the return value ### my $href = { file => undef, version => undef, uptodate => undef, }; my $filename; ### check the inc hash if we're allowed to if( $CHECK_INC_HASH ) { $filename = $href->{'file'} = $INC{ $file_inc } if defined $INC{ $file_inc }; ### find the version by inspecting the package if( defined $filename && $FIND_VERSION ) { no strict 'refs'; $href->{version} = ${ "$args->{module}"."::VERSION" }; } } ### we didnt find the filename yet by looking in %INC, ### so scan the dirs unless( $filename ) { DIR: for my $dir ( @INC ) { my $fh; if ( ref $dir ) { ### @INC hook -- we invoke it and get the filehandle back ### this is actually documented behaviour as of 5.8 ;) if (UNIVERSAL::isa($dir, 'CODE')) { ($fh) = $dir->($dir, $file); } elsif (UNIVERSAL::isa($dir, 'ARRAY')) { ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}}) } elsif (UNIVERSAL::can($dir, 'INC')) { ($fh) = $dir->INC->($dir, $file); } if (!UNIVERSAL::isa($fh, 'GLOB')) { warn loc(q[Cannot open file '%1': %2], $file, $!) if $args->{verbose}; next; } $filename = $INC{$file_inc} || $file; } else { $filename = File::Spec->catfile($dir, $file); next unless -e $filename; $fh = new FileHandle; if (!$fh->open($filename)) { warn loc(q[Cannot open file '%1': %2], $file, $!) if $args->{verbose}; next; } } ### files need to be in unix format under vms, ### or they might be loaded twice $href->{file} = ON_VMS ? VMS::Filespec::unixify( $filename ) : $filename; ### user wants us to find the version from files if( $FIND_VERSION ) { my $in_pod = 0; while (local $_ = <$fh> ) { ### stolen from EU::MM_Unix->parse_version to address ### #24062: "Problem with CPANPLUS 0.076 misidentifying ### versions after installing Text::NSP 1.03" where a ### VERSION mentioned in the POD was found before ### the real $VERSION declaration. $in_pod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $in_pod; next if $in_pod; ### try to find a version declaration in this string. my $ver = __PACKAGE__->_parse_version( $_ ); if( defined $ver ) { $href->{version} = $ver; last DIR; } } } } } ### if we couldn't find the file, return undef ### return unless defined $href->{file}; ### only complain if we're expected to find a version higher than 0.0 anyway if( $FIND_VERSION and not defined $href->{version} ) { { ### don't warn about the 'not numeric' stuff ### local $^W; ### if we got here, we didn't find the version warn loc(q[Could not check version on '%1'], $args->{module} ) if $args->{verbose} and $args->{version} > 0; } $href->{uptodate} = 1; } else { ### don't warn about the 'not numeric' stuff ### local $^W; ### use qv(), as it will deal with developer release number ### ie ones containing _ as well. This addresses bug report ### #29348: Version compare logic doesn't handle alphas? $href->{uptodate} = qv( $args->{version} ) <= qv( $href->{version} ) ? 1 : 0; } return $href;}sub _parse_version { my $self = shift; my $str = shift or return; my $verbose = shift or 0; ### skip commented out lines, they won't eval to anything. return if $str =~ /^\s*#/; ### the following regexp & eval statement comes from the ### ExtUtils::MakeMaker source (EU::MM_Unix->parse_version) ### Following #18892, which tells us the original
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -