view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

    # We want to know if we're under CPAN early to avoid prompting, but
    # if we aren't going to try and install anything anyway then skip the
    # check entirely since we don't want to have to load (and configure)
    # an old CPAN just for a cosmetic message

    $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget;

    while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
        my ( @required, @tests, @skiptests );
        my $default  = 1;
        my $conflict = 0;

        if ( $feature =~ m/^-(\w+)$/ ) {
            my $option = lc($1);

            # check for a newer version of myself
            _update_to( $modules, @_ ) and return if $option eq 'version';

            # sets CPAN configuration options
            $Config = $modules if $option eq 'config';

            # promote every features to core status
            $core_all = ( $modules =~ /^all$/i ) and next
              if $option eq 'core';

            next unless $option eq 'core';
        }

        print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";

        $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );

        unshift @$modules, -default => &{ shift(@$modules) }
          if ( ref( $modules->[0] ) eq 'CODE' );    # XXX: bugward combatability

        while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
            if ( $mod =~ m/^-(\w+)$/ ) {
                my $option = lc($1);

                $default   = $arg    if ( $option eq 'default' );
                $conflict  = $arg    if ( $option eq 'conflict' );
                @tests     = @{$arg} if ( $option eq 'tests' );
                @skiptests = @{$arg} if ( $option eq 'skiptests' );

                next;
            }

            printf( "- %-${maxlen}s ...", $mod );

            if ( $arg and $arg =~ /^\D/ ) {
                unshift @$modules, $arg;
                $arg = 0;
            }

            # XXX: check for conflicts and uninstalls(!) them.
            my $cur = _version_of($mod);
            if (_version_cmp ($cur, $arg) >= 0)
            {
                print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
                push @Existing, $mod => $arg;
                $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
            }
            else {
                if (not defined $cur)   # indeed missing
                {
                    print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
                }
                else
                {
                    # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
                    print "too old. ($cur < $arg)\n";
                }

                push @required, $mod => $arg;
            }
        }

        next unless @required;

        my $mandatory = ( $feature eq '-core' or $core_all );

        if (
            !$SkipInstall
            and (
                $CheckOnly
                or ($mandatory and $UnderCPAN)
                or $AllDeps
                or $InstallDepsTarget
                or _prompt(
                    qq{==> Auto-install the }
                      . ( @required / 2 )
                      . ( $mandatory ? ' mandatory' : ' optional' )
                      . qq{ module(s) from CPAN?},
                    $default ? 'y' : 'n',
                ) =~ /^[Yy]/
            )
          )
        {
            push( @Missing, @required );
            $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
        }

        elsif ( !$SkipInstall
            and $default
            and $mandatory
            and
            _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
            =~ /^[Nn]/ )
        {
            push( @Missing, @required );
            $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
        }

        else {
            $DisabledTests{$_} = 1 for map { glob($_) } @tests;
        }
    }

    if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
        require Config;
        my $make = $Config::Config{make};
        if ($InstallDepsTarget) {
            print
"*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
        }
        else {
            print
"*** Dependencies will be installed the next time you type '$make'.\n";
        }

        # make an educated guess of whether we'll need root permission.
        print "    (You may need to do that as the 'root' user.)\n"
          if eval '$>';
    }
    print "*** $class configuration finished.\n";

    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';

    return (@Existing, @Missing);
}

sub _running_under {
    my $thing = shift;
    print <<"END_MESSAGE";
*** Since we're running under ${thing}, I'll just let it take care
    of the dependency's installation later.
END_MESSAGE
    return 1;
}

# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {
    return unless @Missing or @_;

    if ($ENV{PERL5_CPANM_IS_RUNNING}) {
        return _running_under('cpanminus');
    }

    my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};

    if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
        return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
    }

    require CPAN;

    if ($CPAN::VERSION > '1.89') {
        if ($cpan_env) {
            return _running_under('CPAN');
        }

inc/Module/AutoInstall.pm  view on Meta::CPAN

    } else {
    	# Older versions had the load method in Config directly
        CPAN::Config->load;
    }
}

# compare two versions, either use Sort::Versions or plain comparison
# return values same as <=>
sub _version_cmp {
    my ( $cur, $min ) = @_;
    return -1 unless defined $cur;  # if 0 keep comparing
    return 1 unless $min;

    $cur =~ s/\s+$//;

    # check for version numbers that are not in decimal format
    if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
        if ( ( $version::VERSION or defined( _load('version') )) and
             version->can('new') 
            ) {

            # use version.pm if it is installed.
            return version->new($cur) <=> version->new($min);
        }
        elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
        {

            # use Sort::Versions as the sorting algorithm for a.b.c versions
            return Sort::Versions::versioncmp( $cur, $min );
        }

        warn "Cannot reliably compare non-decimal formatted versions.\n"
          . "Please install version.pm or Sort::Versions.\n";
    }

    # plain comparison
    local $^W = 0;    # shuts off 'not numeric' bugs
    return $cur <=> $min;
}

# nothing; this usage is deprecated.
sub main::PREREQ_PM { return {}; }

sub _make_args {
    my %args = @_;

    $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
      if $UnderCPAN or $TestOnly;

    if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
        require ExtUtils::Manifest;
        my $manifest = ExtUtils::Manifest::maniread('MANIFEST');

        $args{EXE_FILES} =
          [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
    }

    $args{test}{TESTS} ||= 't/*.t';
    $args{test}{TESTS} = join( ' ',
        grep { !exists( $DisabledTests{$_} ) }
          map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );

    my $missing = join( ',', @Missing );
    my $config =
      join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
      if $Config;

    $PostambleActions = (
        ($missing and not $UnderCPAN)
        ? "\$(PERL) $0 --config=$config --installdeps=$missing"
        : "\$(NOECHO) \$(NOOP)"
    );

    my $deps_list = join( ',', @Missing, @Existing );

    $PostambleActionsUpgradeDeps =
        "\$(PERL) $0 --config=$config --upgradedeps=$deps_list";

    my $config_notest =
      join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
	  'notest', 1 )
      if $Config;

    $PostambleActionsNoTest = (
        ($missing and not $UnderCPAN)
        ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
        : "\$(NOECHO) \$(NOOP)"
    );

    $PostambleActionsUpgradeDepsNoTest =
        "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";

    $PostambleActionsListDeps =
        '@$(PERL) -le "print for @ARGV" '
            . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);

    my @all = (@Missing, @Existing);

    $PostambleActionsListAllDeps =
        '@$(PERL) -le "print for @ARGV" '
            . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);

    return %args;
}

# a wrapper to ExtUtils::MakeMaker::WriteMakefile
sub Write {
    require Carp;
    Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;

    if ($CheckOnly) {
        print << ".";
*** Makefile not written in check-only mode.
.
        return;
    }

    my %args = _make_args(@_);

    no strict 'refs';