view release on metacpan or  search on metacpan

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

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

            # XXX: check for conflicts and uninstalls(!) them.
            if (defined(my $cur = _version_check(_load($mod), $arg ||= 0))) {
                print "loaded. ($cur".($arg ? " >= $arg" : '').")\n";
                push @Existing, $mod => $arg;
                $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
            }
            else {
                print "missing." . ($arg ? " (would need $arg)" : '') . "\n";
                push @required, $mod => $arg;
            }
        }

        next unless @required;

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

        if (!$SkipInstall and ($CheckOnly 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;
        }
    }

    _check_lock(); # check for $UnderCPAN

    if (@Missing and not ($CheckOnly or $UnderCPAN)) {
        require Config;
        print "*** Dependencies will be installed the next time you type '$Config::Config{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';
}

# CPAN.pm is non-reentrant, so check if we're under it and have no CPANPLUS
sub _check_lock {
    return unless @Missing;
    return if _has_cpanplus();

    require CPAN; CPAN::Config->load;
    my $lock = MM->catfile($CPAN::Config->{cpan_home}, ".lock");

    if (-f $lock and open(LOCK, $lock)
        and ($^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid())
        and ($CPAN::Config->{prerequisites_policy} || '') ne 'ignore'
    ) {
        print << '.';

*** Since we're running under CPAN, I'll just let it take care
    of the dependency's installation later.
.
        $UnderCPAN = 1;
    }

    close LOCK;
}

sub install {
    my $class  = shift;

    my $i; # used below to strip leading '-' from config keys
    my @config = (map { s/^-// if ++$i; $_ } @{+shift});

    my (@modules, @installed);
    while (my ($pkg, $ver) = splice(@_, 0, 2)) {
        # grep out those already installed
        if (defined(_version_check(_load($pkg), $ver))) {
            push @installed, $pkg;
        }
        else {
            push @modules, $pkg, $ver;
        }
    }

    return @installed unless @modules; # nothing to do

    print "*** Installing dependencies...\n";

    return unless _connected_to('cpan.org');

    my %args = @config;
    my %failed;
    local *FAILED;

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

    # don't show start-up info
    $CPAN::Config->{inhibit_startup_message} = 1;

    # set additional options
    while (my ($opt, $arg) = splice(@config, 0, 2)) {
        ($args{$opt} = $arg, next)
            if $opt =~ /^force$/; # pseudo-option
        $CPAN::Config->{$opt} = $arg;
    }

    while (my ($pkg, $ver) = splice(@modules, 0, 2)) {
        MY::preinstall($pkg, $ver) or next if defined &MY::preinstall;

        print "*** Installing $pkg...\n";

        my $obj = CPAN::Shell->expand(Module => $pkg);
        my $success = 0;

        if ($obj and defined(_version_check($obj->cpan_version, $ver))) {
            my $pathname = $pkg; $pathname =~ s/::/\\W/;

            foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) {
                delete $INC{$inc};
            }

            $obj->force('install') if $args{force};

            if ($obj->install eq 'YES') {
                print "*** $pkg successfully installed.\n";
                $success = 1;
            }
            else {
                print "*** $pkg installation failed.\n";
                $success = 0;
            }

            $installed += $success;
        }
        else {
            print << ".";
*** Could not find a version $ver or above for $pkg; skipping.
.
        }

        MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall;
    }

    return $installed;
}

sub _has_cpanplus {
    return (
        $HasCPANPLUS = (
            $INC{'CPANPLUS/Config.pm'} or
            _load('CPANPLUS::Shell::Default')
        )
    );
}

# make guesses on whether we're under the CPAN installation directory
sub _under_cpan {
    require Cwd;
    require File::Spec;

    my $cwd  = File::Spec->canonpath(Cwd::cwd());
    my $cpan = File::Spec->canonpath($CPAN::Config->{cpan_home});

    return (index($cwd, $cpan) > -1);
}

sub _update_to {
    my $class = __PACKAGE__;
    my $ver   = shift;

    return if defined(_version_check(_load($class), $ver)); # no need to upgrade

    if (_prompt(
        "==> A newer version of $class ($ver) is required. Install?", 'y'
    ) =~ /^[Nn]/) {
        die "*** Please install $class $ver manually.\n";
    }

    print << ".";
*** Trying to fetch it from CPAN...
.

    # install ourselves
    _load($class) and return $class->import(@_)
        if $class->install([], $class, $ver);

    print << '.'; exit 1;

*** Cannot bootstrap myself. :-( Installation terminated.
.
}

# check if we're connected to some host, using inet_aton
sub _connected_to {
    my $site = shift;

    return (
        ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(qq(
*** Your host cannot resolve the domain name '$site', which
    probably means the Internet connections are unavailable.
==> Should we try to install the required module(s) anyway?), 'n'
        ) =~ /^[Yy]/
    );
}

# check if a directory is writable; may create it on demand
sub _can_write {
    my $path = shift;
    mkdir ($path, 0755) unless -e $path;

    require Config;
    return 1 if -w $path and -w $Config::Config{sitelib};

    print << ".";
*** You are not allowed to write to the directory '$path';
    the installation may fail due to insufficient permissions.