view release on metacpan or  search on metacpan

bin/bootstrap-perl  view on Meta::CPAN

my $OLDSTDOUT;
my $OLDSTDERR;
my $LOGFILE;
my $COMMAND;
my $USER;

use constant {
    NO_REINSTALL => 0,
    REINSTALL   => 1,
    NO_FORCE     => 0,
    FORCE       => 1,
};

sub caller_line {
        my $i = 0;
        my ($rc, $rc_prev, $func);
        while (1) {
                my @v = caller($i);
                defined($v[0]) or last;
                $rc_prev = $rc;
                ($rc, $func) = @v[2..3];
                $i++;
        };
        $func ne "(eval)"? $rc: $rc_prev;
}

sub setup_user {
        open($USER, ">&", \*STDOUT) || die;
}

sub setup_log {
        open($OLDSTDOUT, ">&", \*STDOUT) || die;
        open($OLDSTDERR, ">&", \*STDERR) || die;
        open($LOGFILE,   ">>" , $logfile) || die;
        open($COMMAND,   ">>",  $logcommand) || die;
}

# Execute a command via system(). Output goes to log file.
sub print_and_system {
        my ($cmd) = @_;
        my $exitcode;
        my $line = caller_line();

        my @cmd = split / +/, $cmd;
        my $bin = $cmd[0];
        my $is_cpan = $bin eq bin_cpan();

        open(STDOUT, ">>&", $LOGFILE) || die;
        open(STDERR, ">>&", $LOGFILE) || die;

        print $COMMAND $cmd, "\n";
        print $LOGFILE $cmd, "\n";
        $exitcode = system ($cmd);

        open(STDOUT, ">&", $OLDSTDOUT) || die;
        open(STDERR, ">&", $OLDSTDERR) || die;

        $exitcode == 0 || warn "$0($line): $cmd ($exitcode>>".($exitcode>>8).")";
}

# Execute a command via system(). Output goes to normal stdout/stderr.
sub print_and_system_out {
        my ($cmd) = @_;
        my $line = caller_line();

        print $COMMAND $cmd, "\n";
        print $LOGFILE $cmd, "\n";
        print $USER    $cmd, "\n";
        system ($cmd) == 0 || warn "$0($line): $cmd ($?>>".($?>>8).")";
}

# Execute a command via qx(). Output goes to log file.
sub print_and_qx {
        my ($cmd) = @_;
        my $line = caller_line();
        my $exitcode;
        my $out;

        print $COMMAND $cmd, "\n";
        print $LOGFILE $cmd, "\n";
        $out = qx($cmd 2>&1);
        $exitcode = $?;
        print $LOGFILE $out, "\n";
        $exitcode == 0 || warn "$0($line): $cmd ($exitcode>>".($exitcode>>8).")";

        $out;
}

# Execute a command via qx(). Output goes to normal stdout/stderr.
sub print_and_qx_chomp {
        my $out = print_and_qx @_;
        chomp $out;
        $out;
}

sub _perl_base_name {
        my ($perl_revision, $perl_version, $perl_subversion, $usethreads, $bit64, $taintsupport, $silentnotaint, $gitdescribe, $gitchangeset, $exe_suffixes, $blead) = @_;
        return join("-",
                    ($blead      ? "blead" : "$perl_revision.$perl_version"),
                    ($usethreads ? "" : "no" )."thread",
                    ($bit64      ? "" : "no" )."64bit",
                    ($taintsupport ? "" : (($silentnotaint ? "silent" : "")."no"))."taint",
                    @$exe_suffixes,
                   );
}

sub _perl_exe_name {
        my ($perl_revision, $perl_version, $perl_subversion, $usethreads, $bit64, $taintsupport, $silentnotaint, $gitdescribe, $gitchangeset, $exe_suffixes, $blead) = @_;

        return join("-",
                    "perl",
                    _perl_base_name(@_),
                   );
}

sub _perl_pathprefix {
        my ($perl_revision, $perl_version, $perl_subversion, $usethreads, $bit64, $taintsupport, $silentnotaint, $gitdescribe, $gitchangeset, $exe_suffixes, $blead) = @_;

        return join("-",
                    $prefixbase."/perl",
                    _perl_base_name(@_),
                    $gitdescribe,
                   );
}

# ========== setup user log ==========

setup_user();

# ========== getopt ==========

my $ok = GetOptions (
                     "prefix=s"     => \$prefix,
                     "prefixbase=s" => \$prefixbase,
                     "version|commit|c=s" => \$version,
                     "installdeps=s" => \$installdeps,
                     "sourcetgz=s"  => \$sourcetgz,
                     "blead!"       => \$blead,
                     "usethreads!"  => \$usethreads,
                     "use64bit!"    => \$bit64,
                     "taintsupport!" => \$taintsupport,
                     "silentnotaint!" => \$silentnotaint,
                     "help|h"       => \$help,
                     "jobs|j=i"     => \$jobs,
                     "test|t"       => \$test,
                     "cpan!"        => \$cpan,
                     "cleancpansources!" => \$cleancpansources,
                     "forcecpancfg!" => \$forcecpancfg,
                     "forcebuildperl!" => \$forcebuildperl,