view release on metacpan or  search on metacpan

inc/inc_Module-Load-Conditional/Module/Load/Conditional.pm  view on Meta::CPAN

=item verbose

Whether or not to be verbose about what it is doing -- it will default
to $Module::Load::Conditional::VERBOSE

=back

It will return undef if it was not able to find where the module was
installed, or a hash reference with the following keys if it was able
to find the file:

=over 4

=item file

Full path to the file that contains the module

=item version

The version number of the installed module - this will be C<undef> if
the module had no (or unparsable) version number, or if the variable
C<$Module::Load::Conditional::FIND_VERSION> was set to true.
(See the C<GLOBAL VARIABLES> section below for details)

=item uptodate

A boolean value indicating whether or not the module was found to be
at least the version you specified. If you did not specify a version,
uptodate will always be true if the module was found.
If no parsable version was found in the module, uptodate will also be
true, since C<check_install> had no way to verify clearly.

=back

=cut

### this checks if a certain module is installed already ###
### if it returns true, the module in question is already installed
### or we found the file, but couldn't open it, OR there was no version
### to be found in the module
### it will return 0 if the version in the module is LOWER then the one
### we are looking for, or if we couldn't find the desired module to begin with
### if the installed version is higher or equal to the one we want, it will return
### a hashref with he module name and version in it.. so 'true' as well.
sub check_install {
    my %hash = @_;

    my $tmpl = {
            version => { default    => '0.0'    },
            module  => { required   => 1        },
            verbose => { default    => $VERBOSE },
    };

    my $args;
    unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
        warn loc( q[A problem occurred checking arguments] ) if $VERBOSE;
        return;
    }

    my $file     = File::Spec->catfile( split /::/, $args->{module} ) . '.pm';
    my $file_inc = File::Spec::Unix->catfile( 
                        split /::/, $args->{module} 
                    ) . '.pm';

    ### where we store the return value ###
    my $href = {
            file        => undef,
            version     => undef,
            uptodate    => undef,
    };
    
    my $filename;

    ### check the inc hash if we're allowed to
    if( $CHECK_INC_HASH ) {
        $filename = $href->{'file'} = 
            $INC{ $file_inc } if defined $INC{ $file_inc };

        ### find the version by inspecting the package
        if( defined $filename && $FIND_VERSION ) {
            no strict 'refs';
            $href->{version} = ${ "$args->{module}"."::VERSION" }; 
        }
    }     

    ### we didnt find the filename yet by looking in %INC,
    ### so scan the dirs
    unless( $filename ) {

        DIR: for my $dir ( @INC ) {
    
            my $fh;
    
            if ( ref $dir ) {
                ### @INC hook -- we invoke it and get the filehandle back
                ### this is actually documented behaviour as of 5.8 ;)
    
                if (UNIVERSAL::isa($dir, 'CODE')) {
                    ($fh) = $dir->($dir, $file);
    
                } elsif (UNIVERSAL::isa($dir, 'ARRAY')) {
                    ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}})
    
                } elsif (UNIVERSAL::can($dir, 'INC')) {
                    ($fh) = $dir->INC->($dir, $file);
                }
    
                if (!UNIVERSAL::isa($fh, 'GLOB')) {
                    warn loc(q[Cannot open file '%1': %2], $file, $!)
                            if $args->{verbose};
                    next;
                }
    
                $filename = $INC{$file_inc} || $file;
    
            } else {
                $filename = File::Spec->catfile($dir, $file);
                next unless -e $filename;
    
                $fh = new FileHandle;
                if (!$fh->open($filename)) {
                    warn loc(q[Cannot open file '%1': %2], $file, $!)
                            if $args->{verbose};
                    next;
                }
            }
    
            $href->{file} = $filename;
    
            ### user wants us to find the version from files
            if( $FIND_VERSION ) {
                
                my $in_pod = 0;
                while (local $_ = <$fh> ) {
    
                    ### stolen from EU::MM_Unix->parse_version to address
                    ### #24062: "Problem with CPANPLUS 0.076 misidentifying
                    ### versions after installing Text::NSP 1.03" where a 
                    ### VERSION mentioned in the POD was found before
                    ### the real $VERSION declaration.
                    $in_pod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $in_pod;
                    next if $in_pod;
                    
                    ### try to find a version declaration in this string.
                    my $ver = __PACKAGE__->_parse_version( $_ );

                    if( defined $ver ) {
                        $href->{version} = $ver;
        
                        last DIR;
                    }
                }
            }
        }
    }
    
    ### if we couldn't find the file, return undef ###
    return unless defined $href->{file};

    ### only complain if we expected fo find a version higher than 0.0 anyway
    if( $FIND_VERSION and not defined $href->{version} ) {
        {   ### don't warn about the 'not numeric' stuff ###
            local $^W;

            ### if we got here, we didn't find the version
            warn loc(q[Could not check version on '%1'], $args->{module} )
                    if $args->{verbose} and $args->{version} > 0;
        }
        $href->{uptodate} = 1;

    } else {
        ### don't warn about the 'not numeric' stuff ###
        local $^W;
        $href->{uptodate} = $args->{version} <= $href->{version} ? 1 : 0;
    }

    return $href;
}

sub _parse_version {
    my $self    = shift;
    my $str     = shift or return;
    my $verbose = shift or 0;

    ### skip commented out lines, they won't eval to anything.
    return if $str =~ /^\s*#/;
        
    ### the following regexp & eval statement comes from the 
    ### ExtUtils::MakeMaker source (EU::MM_Unix->parse_version) 
    ### Following #18892, which tells us the original
    ### regex breaks under -T, we must modifiy it so
    ### it captures the entire expression, and eval /that/
    ### rather than $_, which is insecure.

    if( $str =~ /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
        
        print "Evaluating: $str\n" if $verbose;
        
        ### this creates a string to be eval'd, like:
        # package Module::Load::Conditional::_version;
        # no strict;
        # 
        # local $VERSION;
        # $VERSION=undef; do {
        #     use version; $VERSION = qv('0.0.3');
        # }; $VERSION        
        
        my $eval = qq{
            package Module::Load::Conditional::_version;
            no strict;

            local $1$2;
            \$$2=undef; do {
                $str
            }; \$$2
        };
        
        print "Evaltext: $eval\n" if $verbose;
        
        my $result = do {
            local $^W = 0;
            eval($eval); 
        };
        
        
        my $rv = defined $result ? $result : '0.0';

        print( $@ ? "Error: $@\n" : "Result: $rv\n" ) if $verbose;

        return $rv;
    }
    
    ### unable to find a version in this string
    return;
}

=head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] )

C<can_load> will take a list of modules, optionally with version
numbers and determine if it is able to load them. If it can load *ALL*
of them, it will. If one or more are unloadable, none will be loaded.

This is particularly useful if you have More Than One Way (tm) to
solve a problem in a program, and only wish to continue down a path
if all modules could be loaded, and not load them if they couldn't.

This function uses the C<load> function from Module::Load under the
hood.