#!/usr/bin/env perl eval 'exec /usr/bin/env perl -S $0 ${1+"$@"}' if 0; # not running under some shell #BEGIN {$DB::single=1} # debug into attribute handling # TODO: # tee make test with -v (unbuffered IPC::Run or via fork-like callback?) # maketest or -q: mark FAIL tests *RED*, p line bold black (see t/testc.sh) # implement smoke, bench # maketest --all (locally and testvm --all) # more testvm_ctl: xen-shell, vmrun, VBoXManage # uninstall: packfile of installed files instead of rather unsafe globbing # cmd --help # get msys compiled, bootstrap a mingw perl without strawberry # build win32 from win32/ # -v --help fails on some machines, broken Pod::Usage # TEST: # init-modules: \ handling and `` expansion # testvm logs back from forks # fix testvm forked and --fork arg # 'perlall=5.8* perlall do -m' should filter only main 5.8* # testvm max balancing # init is unstable (IO::Tee in IPC::Run) - refactored # --as explicit and implicit - looks good, but no test # non-critical TODO: # 5.8.8 (centos5) fails with Attribute::Handler 0.78_02. monkeypatch or fail? # build: test perlbrew and HOME friendly (no hardcoded paths) # windows support (paths, tee, tools), die on other non-POSIX exots (VMS)... # CPAN::Shell->expand("Devel::*"), not easy todo with metacpan. use strict; use 5.006; our $VERSION = '0.29'; use Config; use Cwd (); use File::Spec (); use File::Basename 'basename'; use Fcntl (); my @extuse; BEGIN { # check platform support: perldoc perlport @extuse = qw(App::Rad IPC::Cmd IO::Scalar Devel::Platform::Info Devel::PatchPerl); if ($^O !~ /^linux|freebsd|darwin|solaris|openbsd|cygwin$/) { if ($^O =~ /^vms|dos|bsdos$/) { die "unsupported OS $^O"; # fixes welcome } elsif ($^O =~ /^MSWin32|msys/) { warn "$^O not yet fully supported\n"; } else { # should theoretically work: # netbsd sunos aix haiku beos hpux irix next svr4 unicos* plan9 # scary: VOS os390 os400 posix-bc vmesa riscos amigaos mpeix warn "untested OS $^O. Feedback welcome"; # VOS forbids slashes in filenames. no big deal } } sub _auto_use { # autoinstall the non-core modules, and use them my @m; for (@_) { push @m, $_ unless eval "require $_;" } if (@m) { # Checked the API back to 1.76_01 (v5.8.4) require CPAN; CPAN->import; warn "CPAN::Shell->install(qw(@m))\n"; CPAN::Shell->install(@m); } $_->import for @m; } _auto_use( @extuse ); } # 5.8.4: solaris, 5.8.5: centos4, 5.8.8: centos5 # below dynamically parsed from git tags our @main_releases = qw(5.6.2 5.8.4 5.8.5 5.8.8 5.8.9 5.10.1 5.12.4 5.14.3 5.16.2); push @App::Rad::ISA, 'main'; our @opts = ( [ "skip=s", "skip versions (glob-style) or --skip=outdated" ], [ "newer=s", "only newer and same versions (glob-style)" ], [ "older=s", "only older versions (glob-style)" ], [ "nogit", "skip @ git versions" ], [ "main|m", "same as --skip=outdated" ], [ "reverse|r","reverse, oldest first" ], [ "quiet|q", "no TEST_VERBOSE, no system >STDOUT" ], [ "verbose|v","Make perlall command say more" ], [ "dryrun!", "do not execute commands, only print" ], [ "nolog", "skip writing log file(s)" ], [ "list|l", "shortcut for command list" ], [ "help|h", "print usage for commands and options" ], [ "debug|d", "lots of internal debugging output" ], [ "gittag=s", "for the testvm logfile"], [ "timeout=i", "IPC::Cmd::run timeout in seconds, Default: 0"], [ "version|V" ]); App::Rad->import ('debug') if grep /^-d$/, @ARGV; App::Rad->run(); =head1 NAME perlall - build, test and do with all perls =head1 SYNOPSIS perlall [opts] cmd [ what [ how ]] perlall build perl5.15.4 perlall build perl5.14.2-nt perlall -v build -j4 bleadd-nt smoke-me/khw-tk perlall build perl5.15.5d-nt-blead-clang blead # or with --as perlall build --as perl5.15.5d-nt-blead-clang bleadd-nt perlall uninstall perl5.15.4d-nt@khw-tk perlall init perl5.15.4d-nt@blead DBI CPAN::SQLite $(cat ~/Perl/B-C/t/top100) perlall set perl5.16.2d perlall="5.1*" perlall do -MData::Dumper -e'my $a;$b={1=>\$a};$a=\$b;print Dumper($b)' perlall --older 5.12 make -Mblib t/0basic.t perlall=5.15.4 perlall maketest # test with version as ENV perlall="5.14*" perlall makeinstall perlall cpan My::Module perlall cpanm More::Modules perlall maketest "5.*.d*" # test with all debugging, version as option perlall testvm centos4 centos5 solaris10 perlall initvm --all --max=6 perlall testvm --all --fork -c=init # see testvm in .perlall perlall config perlall selfupgrade =head2 Planned Features perlall maketest --all perlall smoke -j4 bleadd-nt smoke-me/* perlall=5*[0-9]-nt perlall bench [ what [ how ]] perlall cpan Devel::*Prof* =head1 OPTIONS General options before the command: --skip=s skip versions (glob-style) or --skip=outdated versions might be a glob-style regex. E.g. --skip '5.1[024]d*' --newer=s only newer and same versions (glob-style) globs may include the special arch suffix. E.g. perlall do --newer "5.10.?d-nt" --older=s only older versions. glob-style as in --newer. --nogit skip @ git versions --main|-m same as --skip=outdated, only 5.6.2 5.8.[4589] 5.10.1 5.12.4 5.14.2 5.15.5 --reverse|-r oldest first. default is sorted by newest first --quiet|-q make perlall command quieter --verbose|v make perlall command say more --dryrun! do not execute commands, only print --nolog skip writing log file(s) --debug|-d, lots of internal debugging output --timeout=i IPC::Cmd::run timeout in seconds, Default: 0 --gittag=s Internally set by testvm for the logfile --forked! Internally set by testvm --list|-l shortcut for command list --help|-h --version|-V Specific options after the command I<(see also below)> build and smoke only: --D=s Configure option --A=s Configure option --U=s Configure option --j=n parallel make --link -Dmksymlinks with blead, otherwise copy --install skip Configure && make, only do make install --allpatches apply also asan patches build and makeinstall: --notest|-n skip the test suite on build and makeinstall --force|-f force install testvm: see L =head1 DESCRIPTION B is like a better L with a lot of testing features. The perls are in the default F, and F paths, instead of locally, and . You need write access to the default PREFIX F, e.g. via C. It does not use L, does not mangle C and builds and keeps sane global perl installations with special suffices, without the need to save and restore internal states. The suffices are used in postprocessing scripts. The currently used perl together with more options is stored as alias C

in F<~/.perlall>, which can be sourced by your F<.profile>. alias p=perl5.15.4d-nt Build and init perls: Version numbers look like C<5.xx.x> and the perl C can be any of: C DEBUGGING C<-nt> non-threaded, or C<-m> multi (non-threaded) C<@xxxxxx> git ids / branch names You want to switch to use the "thr" suffix, then the default is non-threaded. This behaviour is controlled via the config setting C. But be consistent to interpret the logfiles. For older perls special patches are applied to successfully build them. C and the archlibs are extended by C<-debug> and special git suffices. The installed perl binary and on windows the F ditto. Platforms I use and support perlall on cygwin, linux (debian+centos), freebsd, openbsd and solaris, with bash, dash and ksh. Supporting other platforms besides VMS should not be hard. freebsd needs sudo from ports. mingw (strawberry) and msys (mingw cross) support is planned. Log Files Most commands always create a log file with the command, platform and version, like F or F, F. In the L perl-compiler distribution there are some post-processing scripts F, F, F for such logfiles. Windows Note in cmd.exe you need different quoting rules. You can try: perlall do -e"""print $^O""" But easier is: perlall do '-e"print $^O"' =cut sub setup { $_[0]->register_commands( {-ignore_prefix => '_'} ); $_[0]->register('install', \&build, "alias to build"); $_[0]->register('smoke', \&build, "(NYI) smoke [ perl branch ]"); $_[0]->unregister('basename'); #imported (bug) } sub App::Rad::Help::usage { return "\nUsage: ".basename($0)." [options] command [arguments]"; } sub pre_process { my $c = shift; my $cmd = $c->cmd; # config defaults: for all $c->config->{PERLALL_PREFIX} = '/usr/local'; # build only $c->config->{PERLALL_BUILDROOT} = '/usr/src/perl'; if ($cmd eq 'init') { $c->config->{cpan} = 'cpan'; $c->config->{'init-modules'} = 'YAML DBI DBD::SQLite CPAN::SQLite Devel::Platform::Info' .' Params::Util Bundle::CPANReporter2 Math::Round Params::Classify Bundle::CygwinVendor' .' YAML::XS List::MoreUtils DBIx::Class SQL::Abstract Module::Find Mouse MouseX::Types Modern::Perl' .' Task::Kensho'; if (basename(Cwd::getcwd) =~/^B-C/ and -f "t/top100") { _auto_use("File::Slurp"); $c->config->{'init-modules'} .= " " .join(" ",File::Slurp::read_file("t/top100")); } } my $sudo = $^O =~ /cygwin|msys|MSWin32/ ? "" : "sudo"; $c->config->{sudo} = $sudo; if ($^O eq 'MSWin32') { $ENV{HOME} = $ENV{HOMEDRIVE} . $ENV{HOMEPATH} unless $ENV{HOME}; $c->config->{PERLALL_PREFIX} = $Config{prefix}; $c->config->{PERLALL_BUILDROOT} = $ENV{HOME}."\\perl5"; # bindir should be in the path. if ($Config{installsitebin} and $Config{installsitebin} =~ $ENV{PATH}) { $c->config->{PERLALL_BINDIR} = $Config{installsitebin}; } else { $c->config->{PERLALL_BINDIR} = $ENV{HOME}."\\perl5\\bin"; } } # read .perlall config if ($cmd =~ /^build|config|uninstall|init|list|testvm|smoke|do|make.*$|cpan.*/) { for ( "/etc/perlall", "$ENV{HOME}/.perlall" ) { $c->_dot_perlall($_) if -f $_; } $c->config->{PERLALL_PREFIX} = '/usr/local' unless $c->config->{PERLALL_PREFIX}; $c->config->{PERLALL_BINDIR} = $c->config->{PERLALL_PREFIX}."/bin" unless $c->config->{PERLALL_BINDIR}; $c->config->{PERLALL_BUILDROOT} = '/usr/src/perl' unless $c->config->{PERLALL_BUILDROOT}; $c->config->{'perl-git'} = $c->config->{PERLALL_BUILDROOT}.'/blead/perl-git' unless $c->config->{'perl-git'}; $c->config->{'perlall_timeout'} = 0 unless $c->config->{'perlall_timeout'}; if ($c->is_command($cmd) and $cmd !~ /^list/) { # logging + locking my $d = Devel::Platform::Info->new->get_info(); my $s = $d->{oslabel}; my $v = $d->{osvers}; if ($^O eq 'solaris' and !$s) { $s = "solaris"; $v = $d->{kvers} if $v eq 'SunOS'; } $v =~ s/^\D*//; # strip non-number lead $v =~ s/[^\d\.]//g; # only numbers and dots $s = $s . $v; $s =~ s/[\s\(\)\[\}\[\]]//g; if ($^O eq 'cygwin') { $s = $d->{source}->{uname}->[2]; $s =~ s/\(.+$//; $s = 'cygwin'.$s.'_'.$d->{source}->{uname}->[1]; # cygwin1.7.10s_winxp } $s = $^O unless $s; if ($cmd eq 'maketest') { $c->stash->{logprefix} = "log.test-".lc($s)."-"; } else { $c->stash->{logprefix} = "log.$cmd-".lc($s)."-"; } # "we should not disturb a running perlall in this dir" $c->_check_lock() if $cmd =~ /^do|make/; } } # accept multiple versions? # expand versions from $ENV{perlall} or version from first argument if ($cmd =~ /^do|make.*|init|cpanm?|list|uninstall$/) { my @p; if ( $c->argv->[0] =~ /^(perl)?5\./ ) { @p = (shift @{$c->argv}); if ($p[0] =~ /[\*\?\[]/) { # only glob if necessary $p[0] =~ s/^perl//; @p = $c->_get_perlall($p[0]); } else { $p[0] =~ s/^5\./perl5\./; } } else { @p = $c->_get_perlall(); } $c->stash->{perlall} = \@p; } } # add opts for specific commands # getopts overwites the old opts sub App::Rad::addopts { my $c = shift; my $savopts = $c->options; my @savargv = @ARGV; if ($c->cmd =~ /^make|do/) { $c->debug("pass options verbatim through"); @ARGV = (); } $c->getopt( @_ ); $c->options->{$_} = $savopts->{$_} for keys %$savopts; # merge with old opts @ARGV = @savargv; } # only process opts before the command. # all other opts are passed verbatim to the subprocesses sub App::Rad::_get_input { my $c = shift; require Getopt::Long; die "Getopt::Long needs to be version 2.36 or above" unless $Getopt::Long::VERSION >= 2.36; my (@options, @params); my $base = basename($0); my $cmd; if ($base ne 'perlall') { # take cmd from link name ($cmd) = $base =~ /perlall-(\w+)$/; $c->{'cmd'} = $cmd; unless ($c->is_command($cmd)) { warn "invalid link $base: unknown Command $cmd\n"; return; } $c->config->{linked} = $cmd; # yet unused } for (my $i=0; $i<@ARGV; $i++) { # the first non-option is the cmd, the rest its args if (defined ($ARGV[$i]) and substr($ARGV[$i], 0, 1) ne '-') { $c->{'cmd'} = $ARGV[$i] unless $cmd; @params = (@ARGV[$i..$#ARGV]); shift @params unless $c->config->{linked}; last; } push @options, ($ARGV[$i]); } @{$c->argv} = (@params); $c->{'cmd'} = '' unless $c->{'cmd'}; my $parser = new Getopt::Long::Parser; $parser->configure( qw(bundling) ); @ARGV = @options; # getoptions eats @ARGV my $ret = $parser->getoptions($c->{'_options'}, map {$_->[0]} @opts); $c->options->{timeout} = $c->config->{perlall_timeout} unless exists $c->options->{timeout}; delete $c->options->{timeout} unless $c->options->{timeout}; $c->debug('received options: ' . join(' ',@options) . ' => ' . _opts($c->options)); $c->debug('received command: ' . $c->{'cmd'}); $c->debug('received parameters: ' . join (' ', @{$c->argv} )); @ARGV = @{$c->argv}; if (!$c->{'cmd'} and $c->options->{list}) { $c->execute('list'); $c->{'cmd'} = ''; exit; } if (!$c->{'cmd'} and $c->options->{version}) { return $c->version(); } return $c; } # from cmdline arg or ENV perlall sub _get_perlall { my ($c, $glob) = @_; unless ($glob) { $glob = $ENV{perlall} ? $ENV{perlall} : "5.*"; } die "invalid version $glob" if $glob !~ /^5\./ or $glob =~ /[!"';,\(\)]/; my $prefix = $c->config->{PERLALL_BINDIR}; $prefix = "/usr/local/bin" unless $prefix; my @p; my $pathsep = $^O eq 'MSWin32' ? '\\' : '/'; my $perl = "$prefix$pathsep"."perl"; if ($c->options->{dryrun} and $ENV{HARNESS_ACTIVE}) { # testing only @p = map{"/usr/local/bin/perl$_"} qw(5.8.9d 5.12.1-nt 5.14.2 5.15.4@ababab); } else { @p = glob "$perl$glob"; } # do the filtering my %skip; if ($c->options->{skip} or $c->options->{main}) { if ($c->options->{main} or $c->options->{skip} eq 'outdated') { # no @git releases only blead # Check newer main releases from git tags #@main_releases = qw(5.6.2 5.8.4 5.8.5 5.8.8 5.8.9 5.10.1 5.12.4 5.14.2 5.16.0); my $srcdir = $c->config->{'perl-git'}; if ($srcdir and -d $srcdir and -d "$srcdir/.git" ) { my $major; for (split(/\n/,`git --git-dir="$srcdir/.git" tag -l`)) { my ($mj, $mi) = $_ =~ m/^(?:v|perl-)5\.(\d+)\.(\d+)$/; push @{$major->{$mj}}, $mi if $mj and $mj % 2 == 0; } for my $mj (keys %$major) { my $max = 0; for (@{$major->{$mj}}) { $max = $_ if $_ > $max; } unless (grep {"5.$mj.$max" eq $_} @main_releases) { @main_releases = grep !/^5\.$mj\.\d+/, @main_releases; push @main_releases, "5.$mj.$max"; } } } my @np; for my $p (grep !/\@/, @p) { push @np, map{index($p, "perl$_")>=0 ? $p :()} @main_releases; } @p = @np; @np = (); for my $p (@p) { # '5.8.9-nt' vs '5.8.9d-nt' my $nondbg = $p; $nondbg =~ s/(\.\d)d/$1/; # skip debug if non-debug exists if ($nondbg ne $p) { $skip{$p}++ if grep {$nondbg eq $_} @p; } } } else { %skip = map {$_ => 1} glob $perl.$c->options->{skip}; } } @p = grep !/(\@|-git)/,@p if $c->options->{nogit}; # glob-style if (my $ver = $c->options->{older}) { # XXX? if last char is non-decimal match this suffix filter also. or use skip for (@p) { $skip{$_}++ unless $c->_older( $_, $ver); } } if (my $ver = $c->options->{newer}) { #or same for (@p) { $skip{$_}++ if $c->_older( $_, $ver); } } @p = grep(!$skip{$_},@p) if %skip; # resolve symlinks: @blead => @id (just to simplify implementation) # XXX: we really should keep the -l and remove the target if also in the list #for (grep {-l} @p) { # @p = grep { # my $b = readlink($_); # if (basename($b) eq $b) { # -> perl5.some # $b ne basename($_) ? $_ : 0 # } else { # /usr/bin/perl5.some # $b ne $_ ? $_ : 0 # } # } @p; #} @p = grep { (-l $_ and (readlink($_) =~ m|$prefix/perl5\..*|)) ? 0 : $_ } @p; if ($c->options->{reverse}) { # oldest first sort { _strip2float($a) <=> _strip2float($b) } @p; } else { # sort reverse numerically, newest first sort { _strip2float($b) <=> _strip2float($a) } @p; } } # string of hash key=val... sub _opts { my $h = shift; my $s = ''; for (keys %$h) { my $v = $h->{$_}; if (ref($v) eq 'ARRAY') { for my $v (@{$h->{$_}}) { $s .= ($v != 1 ? " --".$_."=$v" : " --".$_); } } else { $s .= ($v != 1 ? " --".$_."=$v" : " --".$_); } } substr($s,1); } # perl5.14.2d-nt => 14.2 sub _strip2float { my $p = shift; $p =~ s/^.*perl5\.//; $p =~ s/^5\.//; $p =~ s/(\.\d+)\D.*$/$1/; $p } # if p is older then ver # $p gets full path sub _older { my $c = shift; my ($p, $ver) = @_; $p =~ s/^.*perl5\.//; $p =~ s/^5\.//; $p =~ s/(\.\d+)\D.*$/$1/; # perl5.14.2d-nt@345aef vs 5.12 => 14.2 vs 12 $ver =~ s/^5\.//; $c->debug("_older($_[0], $_[1]) => $p, $ver"); return $p < $ver; } sub _dot_perlall { my ($c, $filename, $write) = (@_); $c->debug(($write?"writing":"loading")." configuration from $filename"); open my $CONFIG, '<', $filename or Carp::croak "error opening $filename: $!\n"; my ($s, $NEW); $write = undef if $c->options->{dryrun}; if ($write) { open $NEW, '>', $filename.".tmp" or Carp::croak "error opening $filename.tmp: $!\n"; } while (<$CONFIG>) { $s = $_ if $write; # backup chomp; s/#.*//; s/\s+$//; print $NEW $s if $s and !length; next unless length; if (/\\\s*$/) { my $t = ''; do { s/\\\s*$//; s/#.*//; chomp; $t .= $_; } while ($_ = <$CONFIG> and $_ =~ /\\\s*$/); s/#.*//; chomp; $t .= $_; $_ = $t; } s/^\s+//; if ( m/^alias\s([^\=\:\s]+) # alias key=value (?:=['"]?) # =' ([^'"]+) # value /x ) { my ($k,$v) = ($1, $2); if ($k eq 'perl-git') { $v =~ s/^cd //; $c->config->{$k} = $v; $v = "cd ".$v; } else { $c->config->{$k} = $v; } if ($write and $k eq 'p') { $v = $write; } print $NEW "alias $k='$v'\n" if $write; } elsif ( m/^([^\=\:\s]+) # key (?: # (value is optional) (?:\s*[\=\:]\s*|\s+) # separator ('=', ':', '"' or whitespace) (.+) # value )? /x ) { my $v = $2; if (substr($v,0,1) eq '"' and substr($v,-1,1) eq '"') { $v = substr($v,1,-1); } $c->config->{$1} = $v; print $NEW $s if $write; } elsif ($write) { print $NEW $s; } } close $CONFIG; if ($write) { close $NEW; unlink $CONFIG; rename $filename.".tmp", $filename or Carp::croak "error writing $filename: $!\n"; } scalar keys %{$c->config}; } # store alias p if explicitly wished (2nd arg $p), # or if only one version was selected. received with no perl prefix sub _set_alias { my ($c, $p) = @_; my $f = "$ENV{HOME}/.perlall"; unless ($p) { $p = $c->stash->{perlall}->[0] if @{$c->stash->{perlall}} == 1; $c->_dot_perlall($f, $p) if -f $f and $p; # set alias } else { $c->_dot_perlall($f, "perl$p") if -f $f and $p; # set alias } "" } sub _numonly { my $p = shift; $p =~ s/^.*perl//; $p =~ s/\-.+$//; $p =~ s/@.+$//; $p =~ s/thr$//; $p =~ s/d$//; return $p; } sub _short { my $p = shift; $p =~ s/^.*perl//; return $p; } sub _print { my $level = shift; if ($^O eq 'MSWin32') { print join(" ",@_),"\n"; } elsif ($level == 0) { # bold green, highest level, headers print "\033[1;32m",join(" ",@_),"\033[0;0m\n"; } elsif ($level == 1) { # bold red/black, major commands print "\033[1;39m",join(" ",@_),"\033[0;0m\n"; } } sub _backup($) { my $f = shift; my $i = 1; while (-e "$f.$i") { $i++ } rename $f,"$f.$i"; } sub __system { my $c = shift; unless ($c->options->{dryrun}) { # MSWin32 ExtUtils::Command methods (tools_other section) if ($^O eq 'MSWin32' and $_[0] =~ /^(rm|mv|mkdir) /) { my $what = join " ",@_; if ($what =~ /^rm -rf/) { system("$^X -MExtUtils::Command -e 'rm_rf' -- ",substr($what,6)); } elsif ($what =~ /^rm /) { system("$^X -MExtUtils::Command -e 'rm_f' -- ",substr($what,5)); } elsif ($what =~ /^mv /) { system("$^X -MExtUtils::Command -e 'mv' -- ",substr($what,3)); } elsif ($what =~ /^mkdir (-p)?(.*)/) { system("$^X -MExtUtils::Command -e 'mkpath' -- $2"); } else { die "unhandled $what"; } # native chdir/rmdir/mkdir/unlink/rename } elsif ($_[0] =~ /^chdir|rmdir|mkdir|unlink|rename$/) { my $cmd = shift @_; my $what = join "','",@_; if ($cmd =~ /^mkdir -p/) { system(@_); } else { eval "$cmd('$what')"; } } else { my $fh = $c->stash->{log_fh}; if ($^O eq 'MSWin32') { # Need to replace ' with " otherwise we would need to write # perlall do -e"""print $^O""". Now we only need to do # perlall do '-e"print $^O"' map { s/\'/"/g } @_; } my ($success, $error_message, $full_buf, $stdout_buf, $stderr_buf) = IPC::Cmd::run('command' => [ @_ ], ($c->options->{verbose} ? ('verbose' => 1) : ()), (defined $c->options->{timeout} ? ('timeout' => $c->options->{timeout} ) : ()) ); if ($fh and !$c->options->{verbose} and @$full_buf) { print $fh $_ for @$full_buf; if (!$c->options->{quiet} and $c->cmd =~ /^smoke|do|make.*|cpan.*/) { print $_ for @$stdout_buf; } } if (@$stderr_buf and !$c->options->{quiet}) { print STDERR $_ for @$stderr_buf; } $success; } } } sub _loginit { my $c = shift; my $q = $c->options->{quiet}; my $v = $c->options->{verbose}; my $dryrun = $c->options->{dryrun}; my $log = $c->stash->{log}; if ( !$dryrun and $log ) { _backup($log) if -e $log; $c->stash->{log_fh} = IO::File->new($v ? ">& $log" : "> $log"); } } # $c->_log(level, @messages) # -q only print to log, STDOUT level 0 # STDOUT level 1, STDOUT+STDERR >>log # -v tee to STDOUT (STDERR not yet) and log sub _log { my $c = shift; my $level = shift; my $q = $c->options->{quiet}; my $v = $c->options->{verbose}; my $dryrun = $c->options->{dryrun}; my $log = $c->stash->{log}; my $fh = $c->stash->{log_fh}; local $| = 1; if ($log) { $c->_loginit unless $fh; $fh = $c->stash->{log_fh}; if (!$q) { if ($level ne '') { _print($level,@_); } if ($fh) { print $fh join(" ",@_),"\n"; $fh->flush; } elsif ($level eq '') { print join(" ",@_),"\n"; # fails on my centos5 } } elsif ($level == 0) { _print(0,@_); } } elsif ($v or $level == 0) { if ($level ne '') { _print($level,@_); } else { print join(" ",@_),"\n"; } } } sub _system { my $c = shift; $c->_log('', @_) unless $c->options->{quiet}; $c->__system(@_); } sub _system0 { my $c = shift; $c->_log(0,@_); $c->__system(@_); } sub _system1 { my $c = shift; $c->_log(1,@_); $c->__system(@_); } sub _check_lock { my $lock = Cwd::getcwd()."/perlall.lock"; if (-f $lock) { print "$lock exists. Probably perlall still running.\n"; system("pgrep","-fl","perlall"); exit 1; } open LOCK,">",$lock;# XXX where? for build in the builddir print LOCK $$,"\n"; close LOCK; $SIG{INT} = $SIG{TERM} = sub {my $l=$lock; unlink $l if -f $l; exit 1; }; END { my $l = $lock; if (-f $l) { # do not override other locks open LOCK,"<",$l; my $pid = ; chomp $pid; close LOCK; if ($$ == $pid) { unlink $l; } else { warn "Other perlall process $pid still running. perlall.lock kept\n"; warn `ps -l -p $pid`,"\n"; # unlink $l; } } } } sub _lognew { my $c = shift; my $p = shift; if ($p) { $p = substr($p,0,-4) if $p =~ /\.exe$/; $c->stash->{log} = $c->stash->{logprefix} . $p; } else { $c->stash->{log} = substr($c->stash->{logprefix},0,-1); # strip last - } if ($c->stash->{log_fh}) { $c->stash->{log_fh}->close() if ref($c->stash->{log_fh}) eq 'IO::File'; undef $c->stash->{log_fh}; } $c->_loginit(); } # -i inplace editing or just grep # print unless // # s,$dll,$newdll,; print sub _grep { my $c = shift; my $cmd = shift; my ($inplace, $out); if (substr($cmd,0,3) eq '-i ') { $inplace = 1; $cmd = substr($cmd,3); } $c->_log('',"perl -i~ -ne'$cmd'",join(" ",@_)) if $inplace; return if $c->options->{dryrun}; my $catch = ''; while (my $f = shift @_) { next unless -f $f; my $b = $f; if ($inplace) { $b .= "~"; unlink $b if -e $b; # does this work on windows? rename($f, $b); open($out, ">", $f); select $out; } else { $out = IO::Scalar->new(\$catch); select $out; } open(IN, "<", $b); LINE: while () { eval $cmd; } close IN; close $out; } select(STDOUT); $catch; } # takes path to file and applies all os patches from HEAD up to blead sub _patch { my ($c, $file) = @_; $c->_system("git show HEAD..blead $file | patch -N -p1") and warn("patch HEAD..blead $file had some errors\n"); } # like Porting/bisect-runner.pl apply_commit sub _apply_commit { my ($c, $commit, @files) = @_; $c->_system("git show $commit @files | patch -N -p1") and warn("cannot apply commit $commit".(@files ? " to @files":"")."\n"); } sub _teardown { my $c = shift; close $c->stash->{log_fh} if $c->stash->{log_fh}; "" } sub _fail { my $c = shift; if ($c->options->{verbose}) { warn $c->{output}," at perlall line @{[(caller(0))[2]]}\n"; } die "@_\n"; } sub _glob_git { my $c = shift; my $git = shift; return qw(smoke-me/scream smoke-me/taint.t ) if $c->options->{dryrun}; my $srcdir = $c->config->{'perl-git'}; my $cwd = Cwd::getcwd; chdir "$srcdir/.git/refs/heads" or die; # XXX expand subdirs with glob. smoke-me/s*: smoke-me/s/r => smoke-me/s # => File::Find my @git = glob $git; chdir "../remotes/origin" or die; push @git, glob $git; chdir "../../tags" or die; push @git, glob $git; chdir $cwd or die; return @git; } =head2 COMMANDS =over =item B [OPTIONS] [ branch|from ] Build and install the given version of perl. The optional 2nd argument C can be a git tag/commit/branch id, e.g. a smoke-me branch, or a file or url with the perl-*.tar.gz. The branchname or commit-id is added to the archname and dll suffix, such as C<@sproututf8> for C, the binary name is taken from the first argument. All unreleased git versions, like C or C branches get a C<@gitid> suffix. C is stripped from the suffix. The special version "blead" denotes the latest version. E.g. C builds latest non-threaded. If the checkout from a bit branch is not a release, the suffix will be marked with C<@> and the sources are copied to the builddir. More special perl suffix rules: d -DDEBUGGING -nt non-threaded -m multiplicity -clang -Dcc=clang -asan clang -fsanitize=address -tsan clang -fsanitize=thread -msan clang -fsanitize=memory -ubsan clang -fsanitize=undefined -cow -DPERL_NEW_COPY_ON_WRITE -mad -Dmad C<-Dmksymlinks> is used for blead, unless the option C<--link> is specified. On cygwin and windows the F also gets the suffix, because they are stored globally. The specified perl is taken from a perl git repo (version or tag or branch) (specified via perl-git in ~/.perlall), or downloaded via CPAN. (not yet) C files are not installed. This is the job for the default /usr/local/bin/perl or /usr/bin/perl. C<-Dusedevel -Uversiononly> is always used to install versioned executables. Special site-specific non-default config vars are taken from F, such as C. The builddir is under C (Default: "/usr/src/perl") as "build-EversionEEsuffix>" The intermediate "make install DESTDIR" as "inst-EversionEEsuffixE". Specific Options: -D.. -U.. -A.. pass through switches to the perl Configure script. perlall build perl5.10.1-nt -Dusemymalloc -Uuselargefiles Certain special switches are merged from F or F --as name Install a given perl under the given name. (not yet) perlall build perl5.6.2 -Dusemymalloc --as perl5.6.2-mymalloc perlall build blead-nt smoke-me/test --as perl5.15.4-test -jnum Enable parallel make and test (if supported by the target perl) perlall build -j5 perl5.12.3 --link Force -Dmksymlinks to the srcdir for blead only. Otherwise releases from git are copied anew. -n|--notest Skip the test suite -f|--force Force installation if make test fails. --install skip Configure, make, make test. make install only. =cut sub build :Help('build [opts] perl [ branch|from ]') { my $c = shift; # special build options (after the cmd) if (@{$c->argv}) { my @build_opts = ( [ "as=s", "install perl under given name" ], [ "D=s@", "./configure option" ], [ "A=s@", "./configure option" ], [ "U=s@", "./configure option" ], [ "j=n", "parallel make (>5.10)" ], [ "link", "make symlinks (blead only) from git" ], [ "notest|n", "skip the test suite on build and makeinstall" ], [ "force|f", "force install" ], [ 'install', 'only do install' ], [ "allpatches", "apply also asan patches" ], ); $c->addopts( map {$_->[0]} @build_opts ); } my @args = @{$c->argv}; my $p = $args[0]; if ($p =~ /^(perl)?5\./ ) { shift @args; } elsif ($p =~ /^blead/ ) { my $srcdir = $c->config->{'perl-git'} or $c->_fail("blead needs perl-git"); my $v = `$^X -ane'print \$F[2] if /PERL_API_VERSION/' $srcdir/patchlevel.h`; my $sv = `$^X -ane'print \$F[2] if /PERL_API_SUBVERSION/' $srcdir/patchlevel.h`; $p = "5.$v.$sv".substr($p,5); if (@args > 1) { shift @args; } else { $args[0] = 'blead'; # set $from, allows --link } } else { $c->output("perlall build missing perlversion argument\n"); $c->execute('help') and return undef; } $p =~ s/^perl//; $p =~ s/^-//; if ($p =~ /[\*\?\[]/ or $p !~ /^5\.\d/) { $c->output("perlall build invalid perlversion argument $p\n"); $c->execute('help') and return undef; } # $c->_log(0,"perlall",_opts($c->options),"build",$p,@args); # $c->_fail("build not yet supported on Windows") if $^O eq 'MSWin32'; my $cwd = Cwd::getcwd(); END { chdir $cwd if $cwd } my $dryrun = $c->options->{dryrun}; my $root = $c->config->{PERLALL_BUILDROOT}; my $prefix = $c->config->{PERLALL_PREFIX}; unless ($root) { $c->_fail("Empty PERLALL_BUILDROOT in .perlall"); } if (!-d $root and !$dryrun) { $c->_log( 1, "mkdir $root # PERLALL_BUILDROOT"); $c->_system1( "mkdir",$root) and $c->_fail("Cannot create PERLALL_BUILDROOT $root"); } my $from = shift @args ; # might be empty my $ps = _numonly($p); my ($suffix) = $p =~ /5\.\d\d?\.\d\d?(.+)$/; my $gitsuffix; unless ($from) { # XXX git only at first if ($ps =~ /^5\./ and -d $c->config->{'perl-git'}) { $from = $c->_older($ps,"5.11.0") ? "perl-$ps" : "v$ps"; } elsif ($c->options->{install}) { ; } else { $c->_log(1, "downloading perl-$ps via CPAN::Perl::Releases"); # get perl-release from CPAN-Perl-Releases _auto_use("CPAN::Perl::Releases"); my $urls = CPAN::Perl::Releases::perl_tarballs($ps); my $url = (values%$urls)[0]; require CPAN; CPAN->import; warn "CPAN::Shell->get(qw($url))\n"; CPAN::Shell->get($url); # $c->_fail ("could not determine from/branch argument for $p. perl-git missing?"); } } # check explicit --as. which suffix to use? # 1. valid version, perl5.15.5-clang # 2. any other name (or bleadperl-test): no suffix to extract if ($c->options->{as}) { my $p_as = $c->options->{as}; $p_as =~ s/^perl//; $p_as =~ s/^-//; my $suffix_as = $p_as =~ /5\.\d\d?\.\d\d?(.+)$/; if ($suffix_as) { $gitsuffix = $suffix_as; $ps = _numonly($p_as) unless $ps; $c->debug("explicit --as suffix $suffix_as"); } else { warn "missing version for --as suffix $suffix_as"; } } else { # check implicit --as # normalize suffix my ($suffix_as) = $suffix =~ /^d?(?:-nt|thr)?(?:-clang|-tsan|-asan|-msan|-mad|-cow)?(?:@.+)?(.*)$/; if ($suffix_as) { # 5.15.5d-nt-git-clang => -git-clang $gitsuffix = $suffix_as; $c->debug("implicit --as suffix $gitsuffix"); } } warn "--link ignored. Only valid with blead.\n" if $c->options->{link} and $from ne 'blead'; $c->_system("chdir", $root); # chdir $root unless $dryrun; # XXX build perl5.15.5d-nt-blead-clang blead # => gitsuffix=d-nt-blead-clang # p as --as if (!$gitsuffix and $from and $from !~ /^(perl-|v)5\./) { $gitsuffix = $from if !$gitsuffix and $from !~ /^(perl-|v)5\./; if ($gitsuffix =~ /^[a-f0-9]{5,24}$/) { $gitsuffix = "@".substr($gitsuffix,0,6); $p .= $gitsuffix unless $p =~ /@/; } else { if ($gitsuffix =~ /\*/) { #expand branch glob-style my $result = ''; my @git = $c->_glob_git($gitsuffix); _print(0,"perlall build $p $gitsuffix => ",@git); for my $git (@git) { my $pg = $p; my $s = $git; $s =~ s/^smoke-me\///; # $s =~ s{/}{}g; $s =~ s/\W//g; # collapse non-word chars $pg = $p."@".substr($s,0,12); $result .= $c->_build($pg, $git, $ps, '@'.$git, $root, $prefix, $cwd); } return $result; } my $srcdir = $c->config->{'perl-git'}; if ($gitsuffix =~ /^blead/ and !$dryrun and -d "$srcdir/.git") { $gitsuffix = substr(`GIT_DIR=$srcdir/.git git rev-parse $gitsuffix`,0,8); } unless ($p =~ /@/) { my $git = $gitsuffix; $git =~ s/^smoke-me\///; # $git =~ s{/}{}g; $git =~ s/\W//g; # collapse non-word chars $git = "@".substr($git,0,12); $p .= $git; } $gitsuffix = "@".$gitsuffix; } } return $c->_build($p, $from, $ps, $gitsuffix, $root, $prefix, $cwd); } sub _build { my ($c, $p, $from, $ps, $gitsuffix, $root, $prefix, $cwd) = @_; $c->debug("c, \$p=$p, \$from=$from, \$ps=$ps, \$gitsuffix=$gitsuffix," ." \$root=$root, \$prefix=$prefix, \$cwd=$cwd"); my $make = $Config{make}; my $sed = $Config{sed}; $sed = "sed" unless $sed; my $cp = $Config{cp}; $cp = "cp" unless $cp; my $mv = $Config{mv}; $mv = "mv" unless $mv; my $rm = $Config{rm}; $rm = "rm" unless $rm; my $sudo = $c->config->{sudo}; $sudo = "" if $root =~ m!^/home!; # don't sudo if installing locally $sudo = "" unless $<; # already sudo # since when was make test parallel safe? my @j = ("-j".$c->options->{j}) if $c->options->{j} and !$c->_older( $ps, "5.10.0"); my ($testerr, $archname); my $dryrun = $c->options->{dryrun}; my $srcdir = $c->config->{'perl-git'}; my ($suffix) = $p =~ /5\.\d\d?\.\d\d?(.+)$/; my $debug = substr($suffix,0,1) eq 'd'; my $multi = $suffix =~ /^d?-m/; my $ithreads = $suffix !~ /^d?-nt/; my ($archsuffix) = $suffix =~ /d?(?:-nt|-m|thr)(.+)$/; my ($asan, $cc); if ($suffix =~ /-mad/) { push @{$c->options->{D}}, "mad=y"; } if ($suffix =~ /-cow/) { push @{$c->options->{A}}, "ccflags=-DPERL_NEW_COPY_ON_WRITE"; } if ($suffix =~ /-(clang|asan|tsan|msan|ubsan)/) { $cc = 'clang'; unless (grep /cc=/, @{$c->options->{D}}) { push @{$c->options->{D}}, "cc=clang"; } else { ($cc) = map /cc=(.*)$/, @{$c->options->{D}}; } if ($suffix =~ /-asan/) { # check clang old or new style asan $asan = "-faddress-sanitizer"; my $version = `$cc --version`; my $result = `$cc -c $asan /dev/null 2>&1`; if ($result =~ /argument unused during compilation: '-faddress-sanitizer'/) { $asan = "-fsanitize=address"; } push @{$c->options->{A}}, "ccflags=$asan"; push @{$c->options->{D}}, 'optimize=-g\ -O1'; } if ($suffix =~ /-tsan/) { push @{$c->options->{A}}, "ccflags='-fsanitize=thread\\ -fPIE'", "ldflags='-fsanitize=thread\\ -pie'", "lddlflags='-fsanitize=thread\\ -pie'"; } if ($suffix =~ /-ubsan/) { push @{$c->options->{A}}, "ccflags='-fsanitize=undefined\\ -fPIE'", "ldflags='-fsanitize=undefined\\ -pie'", "lddlflags='-fsanitize=undefined\\ -pie'"; } if ($suffix =~ /-msan/) { push @{$c->options->{A}}, "ccflags='-fsanitize=memory\\ -fPIE'", "ldflags='-fsanitize=memory\\ -pie'", "lddlflags='-fsanitize=memory\\ -pie'"; } } $ithreads = undef if $multi; my $bindir = $c->config->{PERLALL_BINDIR}; # XXX assert $p = $ps . $suffix; if ($c->options->{install}) { $c->stash->{logprefix} =~ s/^log.build-/log.build-install-/; } $c->stash->{log} = "$root/" . $c->stash->{logprefix} . $p; if ($c->stash->{log_fh}) { close $c->stash->{log_fh}; undef $c->stash->{log_fh}; } $c->_log(0,"perlall",_opts($c->options),"build",$p,$from); my $builddir = "build-".$p; if ($c->options->{install}) { $c->_system1( "chdir", $root.'/'.$builddir ); $c->_check_lock(); goto INSTALL; } # XXX maybe it already exists and is not empty if (-f $from or $from =~ /^https?:|ftp:|rsync:/) { warn "XXX build from file very very unstable.\n" . "No idea how to know the resulting srcdir yet"; if (!-f $from) { # try CPAN instead? $c->_system1( "wget","-O","perl-$ps.tgz",$from) and $c->_fail("downloading $from failed"); $from = "perl-$ps.tgz"; } my @tarx = (($^O eq 'solaris' ? 'gtar' : 'tar'), ($from =~ m/\.bz2$/ ? 'xjf' : 'xzf' )); $c->_system1( @tarx, $from) and _fail("extracting the tarball $from failed"); $srcdir = $root."/perl-$ps"; if (! -d $builddir) { # OOPS LOOKS LIKE AN ERROR $c->_system("mkdir", $builddir) and $c->_fail("Cannot create $builddir." ." Check your PERLALL_BUILDROOT in ~/.perlall"); } $c->_system1( "chdir", $root.'/'.$builddir ); $c->_check_lock(); } else { # git, much better $c->_fail("perl-git $srcdir missing") if !-d $srcdir and !$dryrun; my @cmd = ("mkdir", $builddir); unshift @cmd, $sudo if $sudo and !-w $root; $c->_log(1,"mkdir $root/$builddir # PERLALL_BUILDROOT") unless -d $builddir; $c->_system1( @cmd) unless -d $builddir; $c->_fail( "invalid builddir $builddir") if !-d $builddir and !$dryrun; $c->_system($sudo, "chown", $<, $builddir) if $sudo eq $cmd[0]; if ( $from eq 'blead' and $c->options->{link} ) { # mksymlink for blead only $c->debug("working symlinked to perl-git tree \@$gitsuffix") if $c->options->{link}; $c->_system1( "chdir", $root.'/'.$builddir); $c->_fail( "not existing builddir $builddir") if basename(Cwd::getcwd()) ne $builddir and !$dryrun; $c->_check_lock(); $c->_system1( "rm -rf * .config") if -f 'Configure' and !-l "Configure"; } else { # cp anew $c->debug("copy git tree for $from"); @cmd = ($cp, "-r", "$srcdir/.git", "$builddir/"); # unshift @cmd, $sudo if $sudo; # cannot trust !-w "$builddir/.git"; if ($^O eq 'MSWin32') { $c->_system1( "rm -rf \"$builddir\\.git\"") if -d "$builddir/.git"; @cmd = ("xcopy", "/S/I/H/Y".($c->options->{verbose}?"":"/Q"), "\"$srcdir/.git\"", "\"$builddir\\.git\""); } $c->_system1( @cmd); $srcdir = "."; # clean copy $c->_system1( "chdir", $builddir); $c->_fail( "not existing builddir $builddir") if basename(Cwd::getcwd()) ne $builddir and !$dryrun; $c->_check_lock(); $c->_system1( "git","checkout","-f",$from); # git returns strange values, ignore $c->_fail( "git checkout -f $from") if !-f "Configure" and !$dryrun; $c->_system1( "git","reset","--hard"); $c->_system1( "git","clean","-dxf"); } } # Backport various Configure and hints patches from blead # via Devel::PatchPerl if ($srcdir eq "." or $srcdir eq $root."/perl-$ps" ) { $c->_log('',"Devel::PatchPerl::patch_source($ps)"); # common patches, not yet # $ENV{PERL5_PATCHPERL_PLUGIN} = 'Devel::PatchPerl::Plugin::perlall'; if ($asan or $c->options->{allpatches}) { $ENV{PERL5_PATCHPERL_PLUGIN} = 'Devel::PatchPerl::Plugin::Asan'; } Devel::PatchPerl::patch_source($ps) unless $dryrun; if ($ps =~ /^5\.6\.2/) { $c->_log('',"patch to use 5.8.0 lib/File/Find.pm"); $c->_system("git diff HEAD..perl-5.8.0 lib/File/Find.pm | patch -N -p1") and warn("patch HEAD..perl-5.8.0 lib/File/Find.pm had some errors\n"); } } elsif (!$dryrun) { warn "Warning: Building -Dmksymlink with no Devel::PatchPerl patches applied.\n" ."Use --no-link if this fails.\n"; } # on versions rf .git now if ( !$gitsuffix and -d ".git" and !$c->options->{debug}) { $c->_system1( $rm,"-rf",".git"); } # $c->_system( $make, @j, "clean") if -f "Makefile" and -f 'miniperl'; $c->_system( $rm, "config.h") if -f "config.h"; $c->_system( $rm, "Policy.sh") if -f "Policy.sh"; $c->_system( $rm, "-rf", "UU") if -d "UU"; $c->_system( $rm, "-rf", ".config") if -d ".config"; # prepare configure options, dependent on options and $p my @conf = ("sh","$srcdir/Configure","-de","-Dusedevel", "-Uversiononly", "-Dinstallman1dir=none","-Dinstallman3dir=none", "-Dinstallsiteman1dir=none","-Dinstallsiteman3dir=none"); # we cannot force archname, because we don't know the resulting name yet # we fix that post-configure my ($libperl); if ($c->config->{usethrsuffix} and !$multi) { $ithreads = $suffix =~ /^d?thr/; # perl5.14.2dthr } push @conf, "-Dmksymlinks" if $srcdir ne "."; push @conf, "-DEBUGGING" if $debug; push @conf, "-Doptimize=-g3" if $debug and $Config{gccversion} and !grep(/^optimize=/, @{$c->options->{D}}); push @conf, "-Dusemultiplicity" if $multi; if ($^O eq 'cygwin') { # fixed with 5.15.8 [perl #109968] push @conf, ($ithreads ? "-D" :"-U") . "usethreads"; } else { push @conf, ($ithreads ? "-D" :"-U") . "useithreads"; } push @conf, "-D'".$_."'" for @{$c->options->{D}}; push @conf, "-A'".$_."'" for @{$c->options->{A}}; push @conf, "-U'".$_."'" for @{$c->options->{U}}; push @conf, "-Dprefix='$prefix'" if $prefix ne '/usr/local'; # special *perl.dll if non-default if ($^O =~ /cygwin|msys/ and $suffix) { if ($^O eq 'cygwin') { $libperl = $ps; $libperl =~ s/\./_/g; $libperl = 'cygperl'.$libperl.$suffix.'.dll'; push @conf, "-Dlibperl=$libperl"; } else { $libperl = $ps; $libperl =~ s/\.//g; $libperl = 'perl'.$libperl.$suffix.'.dll'; push @conf, "-Dlibperl=$libperl"; } } # ensure ldflags and lddflags -faddress-sanitizer on ccflags=-faddress-sanitizer # XXX this should go into darwin and linux hints somewhen if (grep /-[DA]'ccflags=.*-f(sanitize=address|address-sanitizer)/, @conf) { my $f = 'ldflags'; if (!(grep /-[DA]'$f=.*-f(sanitize=address|address-sanitizer)/, @conf)) { push @conf, "-A'$f=$asan" . ($^O eq 'darwin' ? "\\ -Wl,-no_pie'" : "'"); } $f = 'lddlflags'; if (!(grep /-[DA]'$f=.*-f(sanitize=address|address-sanitizer)/, @conf) and !(grep /-U'?useshrplib/, @conf)) { push @conf, ($^O eq 'darwin' ? "-A'$f=-bundle\\ $asan\\ -Wl,-no_pie'" : "-A'$f=-shared\\ $asan'"), "-Duseshrplib"; } } $c->_system( $rm, "config.sh") if -f "config.sh"; $c->debug("config_args: ".join(" ",@conf)); for my $tryperl ("$bindir/perl", "/usr/local/bin/perl", "/usr/bin/perl") { if (-e $tryperl) { # use tryperl as template and merge options # same overrides as with tryperl my $tryargs = `$tryperl -V:config_args`; $c->debug("old args: $tryargs"); for my $f (qw(cc ld ccflags ldflags libpth incpth pager cf_email perladmin useshrplib)) { next if grep /^$f[= ]/, @{$c->options->{D}} or grep /^$f[= ]/, @{$c->options->{A}} or grep /^$f[= ]/, @{$c->options->{U}}; # -Dlibpth=/usr/local/lib64 /lib64 /usr/lib64 -D my ($d,$v) = $tryargs =~ m/-([AUD])$f=(.+?) (?:-[ADU]|;)/; # Not until -L # check the if ($f =~ /^use/ and !$v) { my ($u) = $tryargs =~ /-([DU])$f /; $c->debug("-$u$f") if $u; push @conf, "-$u$f" if $u; } elsif ($v and $d) { $v =~ s/([^\\]) /$1\\ /g; # There can be multiple -A$f=$v if ($d eq 'A') { for my $v ($tryargs =~ m/-A$f=(.+?) /g) { $c->debug("-$d$f=$v") if $v; $v =~ s/([^\\]) /$1\\ /g; push @conf, "-$d$f='$v'"; } } else { # avoid the BSDPAN ports hack, we do not want to register our modules with ports next if $^O =~ /bsd/ and $f eq "ccflags" and $v =~ /APPLLIB_EXP.*BSDPAN/; $c->debug("-$d$f=$v"); $v =~ s/([^\\]) /$1\ /g; push @conf, "-$d$f='$v'"; } } } $c->debug("merged config_args: ".join(" ",@conf)); last; } } # https://www.socialtext.net/perl5/installing_perl_on_os_x if ($ps =~ /^5\.6\.2/ and $^O =~ /darwin|bsd|dragon/) { push @conf, "-Dd_Gconvert=sprintf"; } # darwin: if -m32 or -m64 use -flat_namespace to avoid 2level if ($^O eq 'darwin') { my $conf = join(" ",@conf); # XXX change @conf, not add push @conf, "-Aldflags=-flat_namespace" if $conf =~ /ccflags='?-m64/ or $conf =~ /ccflags='?-m32/; # clang: use ld also # XXX: done automatically on linux. bother only for darwin push @conf, "-Dld=$cc" if $cc =~ /clang/; if ($c->_older($p,'5.6.2')) { # need to use 5.6.2 hints/darwin.sh #open F,">hints/darwin.sh"; #close F; } } if ($^O eq 'msys') { # msys: mingw bootstrapping push @conf, "-Dlibc=/usr/lib.libmsys-1.0.dll.a", "-Dusenm=no"; } if ($cc =~ /clang/) { # our macros are just too bad #if (grep /^-[DA]ccflags/, @conf) { push @conf, "-Accflags=-Wno-unused-value"; # this belongs into Configure and cflags.SH #} } if ($^O ne 'MSWin32') { $c->_system1( @conf); $c->_fail("Configure failed") unless -f 'config.sh' or $dryrun; } else { my ($w64, $config); my $aperl = $make eq 'nmake'; $c->_system1("chdir","win32"); # XXX check which config and makefile we will need my $makefile = $aperl ? 'Makefile' : 'makefile.mk'; # XXX copy and tune config.h and Makefile (INST_DRV, INST_TOP) if ($ENV{WIN64}) { # XXX check if our compiler can do 64bit, else unset WIN64 $w64++; warn "WIN64 not yet tested"; } if ($w64) { $config = $aperl ? 'config.vc64' : 'config.gc64'; } else {$config = $aperl ? 'config.vc' : 'config.gc';} $c->_log(1,"win32 configure $config $make"); $c->_system1($cp, $config, 'config.h'); $dryrun = 1; # hack to skip post-configure patchups } $c->_log(1,"post-configure fixes"); # fix libs on debug and git-stuff $archname = $dryrun ? "fake-arch" : $c->_grep("/^archname='(.+?)'\$/ and print \$1", "config.sh"); my $new = $archname; for my $d (@{$c->options->{D}}) { if ($d =~ /^archname/) { $new = $d; $new =~ s/^archname=//; $new =~ s/'//g; } } if (($new ne $archname) or $archsuffix or $debug) { if ($new eq $archname) { $new .= "-debug" if $debug and $archname !~ /-debug/; $new .= $archsuffix if $archsuffix and $archname !~ /$archsuffix$/; if (!$ithreads and $new =~ /-thread/) { $new =~ s/-thread//; } elsif ($ithreads and $new !~ /-thread/) { $new .= "-thread"; } } $c->debug("post-configure archname fixes: $archname => $new"); $c->_fail("archname not detected in config.sh") unless $archname; # This was very fragile: e.g. archname=darwin or mach # FIXME libpth was changed to /usr/lib/x86_64-linux-debug-gnu if ($archname and $archname ne $new) { # Time to make this stable $new =~ s/([\$\%\@])/\\$1/g; # which keys exactly? only those keys. # maybe redo the whole Configure step again $c->_grep("-i s|(\\d)/$archname'|\\1/$new'|;" . " s|(\\d)/$archname\"|\\1/$new\"|;" . " s|/$archname/CORE|/$new/CORE|;" . " s|define ARCHNAME \"$archname\"|define ARCHNAME \"$new\"|;" . " s|archname=$archname,|archname=$new,|;" . " s|archname='$archname'|archname='$new'|; print", qw(config.h config.sh Policy.sh myconfig)); } } if (!$dryrun and $c->_older($p,'5.14')) { #seems to be <=5.6.2 only # remove archs from inc_version_list if ($c->_grep('m|inc_version_list.+(\d\.\d\d?\.\d\d?)/'.$archname.' | and print $1', "config.sh")) { $c->debug("post-configure remove archlibs from inc_version_list"); $c->_grep('-i s|(\d\.\d\d?\.\d\d?)/'.$archname.' ||;' . ' s|"(\d\.\d\d?\.\d\d?)/'.$archname.'",||;' . " print", qw(config.h config.sh)); } } if ($archname and $archname ne $new) { $archname = $new; } if ($^O =~ /cygwin|msys/) { $c->debug("post-configure perl.dll fixes"); # libperl really is libperl.a. Should be libperl.dll.a at least. we use the dll. my $dll = $dryrun ? "fake.dll" : $c->_grep("/^libperl='(.+?)'\$/ and print \$1", "config.sh"); if ($libperl eq $dll) { $c->_log('',"configure did keep our libperl, good"); } elsif ($libperl and $dll) { $libperl =~ s/([\.\$\%\@])/\\$1/g; $c->_grep("-i s,$dll,$libperl,; print", qw(config.sh config.h Makefile GNUmakefile myconfig)); if ($^O eq 'cygwin') { $c->_grep("-i s,libperl='libperl\.a',libperl='$libperl',; print", qw(config.sh)); $c->_grep("-i s,libperl=libperl\.a,libperl=$libperl,; print", qw(myconfig)); } } if ($^O eq 'cygwin' and !$dryrun) { my $cygmk = 'cygwin/Makefile.SHs'; my $dll = substr($libperl,0,-4); if ($c->_older($p,'5.8.9')) { if (-e $cygmk and $c->_grep("/^linklibperl=(-l)/ and print \$1", $cygmk)) { $c->debug("post-configure LLIBPERL llibperl fixes"); $c->_grep("-i s/^LLIBPERL= \$linklibperl/DLLNAME= $dll/; print", $cygmk); $c->_grep('-i s/^-o $(LIBPERL)$(DLSUFFIX)/-o $(DLLNAME)$(DLSUFFIX)/; print', $cygmk); $c->_grep('-i s/^$(LIBPERL).dll$(LIB_EXT): $& perl$(OBJ_EXT) $(cwobj) ld2/' .'libperl.dll$(LIB_EXT): $& perl$(OBJ_EXT) $(cwobj)/; print;', $cygmk); $c->_grep('-i s/$(LDLIBPTH) ld2 $(SHRPLDFLAGS) -o $(LIBPERL)$(DLSUFFIX)/' .'$(LDLIBPTH) $(CC) $(SHRPLDFLAGS) -o $(DLLNAME)$(DLSUFFIX) -Wl,--out-implib=$@/; print', $cygmk); } } # since 5.8.9 if (my $dllname = $c->_grep("/^DLLNAME= (\$dllname)\$/ and print \$1", $cygmk)) { $c->debug("post-configure DLLNAME $dllname fixes"); if ($dll ne $dllname) { $c->_grep("-i s/^DLLNAME= \$dllname/DLLNAME= $dll/; print", $cygmk); } $c->_grep('-i s/^-o $(LIBPERL)$(DLSUFFIX)/-o $(DLLNAME)$(DLSUFFIX)/; print', $cygmk); } $c->_grep('-i s/^-o $(LIBPERL)$(DLSUFFIX)/-o $(DLLNAME)$(DLSUFFIX)/; print', $cygmk); } # XXX fix config_args also } if ($^O eq 'darwin') { # darwin hints overwrote ld $c->debug("post-configure darwin ld fixes"); my $ld = $dryrun ? "env MACOSX_DEPLOYMENT_TARGET=10.3 cc" : $c->_grep("/^ld='(.+?)'/ and print \$1", "config.sh"); my $cc = $dryrun ? "cc" : $c->_grep("/^cc='(.+?)'/ and print \$1", "config.sh"); if ($ld ne $cc) { # XXX check cmdline -Dld= $c->_grep("-i s,^ld='$ld',ld='$cc',; print", "config.sh"); } } $c->debug("post-configure startperl fixes"); my $qp = $p; $qp =~ s/([\$\%\@])/\\$1/g; # -Uversiononly: $c->_grep("-i s,bin/perl,bin/perl$qp,; print", qw(config.h config.sh)); # XXX fix config_args also my $makefile = -f "GNUmakefile" ? "GNUmakefile" : "makefile"; $c->debug("post-configure clang fixes"); if (join(" ",@conf) =~ /-D'?cc='?clang'?/) { $c->_grep("-i s/-fstack-protector//; print", "config.sh", "myconfig", $makefile); } if (!$dryrun and `grep '' $makefile`) { # <5.8.8? $c->debug("post-configure old-perl Makefile fixes"); $c->_grep("-i print unless //", $makefile, "x2p/$makefile"); } if ($^O eq 'MSWin32') { $dryrun = $c->options->{dryrun}; $c->_log(1,"win32 $make"); $c->_system1($make); $c->_system1("chdir",".."); } else { $c->_system1( $make, @j); } $c->debug("post-make versiononly"); # TODO: need to install pureperl libs, # but also version the executables if (!grep /^-Uversiononly/, @{$c->options->{U}}) { $c->_grep("-i s/versiononly='undef'/versiononly='define'/; print", "config.sh", 'lib/Config_heavy.pl'); } if ($c->cmd eq 'smoke') { return $c->execute('_smoke', $p, $from, @j); # XXX not yet } unless ($c->options->{notest}) { if ($dryrun) { $c->_system1(join(" ",$make, @j, "test")); } else { if ($^O eq 'MSWin32') { $c->_system1(join(" ",$make, @j, "test", "> log.test")); } else { $c->_system1(join(" ",$make, @j, "test", "2>&1 |tee log.test")); } system("tail -30 log.test") unless $dryrun or $c->options->{quiet}; # XXX system is not giving me back the errcode?? $testerr = `grep "All tests successful." log.test` ? undef : 1; } } INSTALL: if ($^O eq 'cygwin') { # patch installperl for cygwin my $patch = <<'EOP'; # ignored --- installperl.orig 2012-02-03 16:10:51.000000000 -0600 +++ installperl 2012-02-03 19:53:29.614891000 -0600 @@ -263,9 +263,11 @@ if ($Is_Cygwin) { $perldll = $libperl; - my $v_e_r_s = substr($ver,0,-2); $v_e_r_s =~ tr/./_/; - $perldll =~ s/(\..*)?$/$v_e_r_s.$dlext/; - $perldll =~ s/^lib/cyg/; + if (substr($perldll,-4) ne ".dll") { + my $v_e_r_s = substr($ver,0,-2); $v_e_r_s =~ tr/./_/; + $perldll =~ s/(\..*)?$/$v_e_r_s.$dlext/; + $perldll =~ s/^lib/cyg/; + } } else { $perldll = 'perl58.' . $dlext; } EOP $c->debug("patch installperl for perldll"); $c->_grep('-i s{\$perldll =~ s/^lib/cyg/}{\$perldll = \$libperl}; print', 'installperl'); } # XXX $archname is empty if --install if (!$archname) { $archname = $dryrun ? "fake-arch" : $c->_grep("/^archname='(.+?)'\$/ and print \$1", "config.sh"); } if (!$testerr or $c->options->{force}) { $c->_system1( "rm","-rf","$root/inst-$p"); # XXX <= 5.8.0 needs sudo, as it doesn't do DESTDIR # it also doesn't do lib on versiononly (i.e. usedevel) # we better patch installperl if ($c->_older($p,'5.8.1')) { warn("TODO perl <= 5.8.0 needs to patch installperl: DESTDIR, versiononly w/ lib"); } if ($^O eq 'darwin' and $c->_older($p,'5.6.2')) { $c->_system1('mv','INSTALL','INSTALL.txt'); } if ($^O eq 'cygwin' and $c->_older($p,'5.9.0')) { $c->_system1("mkdir -p $prefix/lib/perl5/$ps/$archname"); } my @c = ($make, @j, "install", "DESTDIR=$root/inst-$p"); unshift @c, $sudo if $sudo and (!-w "$root" or $c->_older($p,'5.8.1')); $c->_system1(@c); } # make install for static extensions severely broken my $static_ext; if (-d "$root/inst-$p" and $static_ext = $c->_grep("m|static_ext='(.+?)'| and print \$1", "config.sh")) { $c->debug("post-make install static extensions $static_ext") if $static_ext; for my $ext (split(/ /,$static_ext)) { # may be PerlIO/scalar my $base = basename($ext); my $dir = "$root/inst-$p$prefix/lib/perl5/$ps/$archname/auto/$ext"; $c->_system1("mkdir -p $dir") unless -d $dir; $c->_system1($cp, "lib/auto/$ext/$base.a", "$dir/") if -e "lib/auto/$ext/$base.a"; } } # XXX on freebsd and windows there's no sudo. well in freebsd ports there is. # do we need sudo? check writable if ($c->_older($p,'5.8.1')) { my @c = ( $mv, "$bindir/perl$ps","$bindir/perl$p" ); unshift @c, $sudo if $sudo and !-w "$bindir/perl$p"; $c->_system1( @c ); } elsif (-f "$root/inst-$p$prefix/bin/perl$ps") { my @c = ($cp, "$root/inst-$p$prefix/bin/perl$ps","$bindir/perl$p"); unshift @c, $sudo if $sudo and !-w "$bindir/perl$p"; $c->_system1( @c ); if ($^O =~ /^MSWin32|cygwin/) { $c->_system1( "$cp $root/inst-$p$prefix/bin/*.dll $bindir/" ); } # symlink to symbolic name (blead, smoke-me, ...) if ($from eq 'blead' and $^O ne 'MSWin32') { my $s = $p; $s =~ s/\@.*//; my @c = ('ln', '-sf', "$bindir/perl$p", "$bindir/perl$s\@blead"); unshift @c, $sudo if $sudo and !-w "$bindir/perl$p"; $c->_system( @c ); # move away perl5.x $c->_system( 'mv', "$root/inst-$p$prefix/bin/perl$ps", "$root/inst-$p$prefix/perl$ps" ); # copy all versioned tools my $cmd = "$cp $root/inst-$p$prefix/bin/* $bindir/"; $cmd = "$sudo $cmd" if $sudo and !-w "$bindir/perl$p"; $c->_system( $cmd ); # move back perl5.x $c->_system( 'mv', "$root/inst-$p$prefix/perl$ps", "$root/inst-$p$prefix/bin/perl$ps" ); } else { for (qw(cpan perldoc pod2man perlbug)) { my @c = ($cp, "$root/inst-$p$prefix/bin/$_$ps","$bindir/"); unshift @c, $sudo if $sudo and !-w "$bindir/perl$p"; $c->_system1( @c ); } } @c = ($cp, "-r", "$root/inst-$p$prefix/lib", "$prefix/"); unshift @c, $sudo if $sudo and !-w "$prefix/lib/perl5/$ps"; $c->_system1( @c ); if (!$testerr and $srcdir eq "." and -d '.git') { $c->_system1( "rm","-rf",".git"); } } chdir $cwd; $c->_set_alias($p); print $c->output() if $c->options->{verbose}; return "$bindir/perl$p faked" if $dryrun; return -f "$bindir/perl$p" ? "$bindir/perl$p installed" : "$bindir/perl$p failed to install"; } =item B [ perl [ from ]] Same as build =item B perl Uninstalls the given version(s). =cut sub uninstall :Help('sudo rm /usr/local/bin/perl and its archlibs') { my $c = shift; for my $p (@{$c->stash->{perlall}}) { my $bindir = $c->config->{PERLALL_BINDIR}; $bindir = "/usr/local/bin" unless $bindir; $p = basename($p); $c->_fail("$bindir/$p does not exist") unless -e "$bindir/$p"; my $pq = $p; $pq =~ s/([\@\$\%])/\\$1/; my $archlib = `$bindir/$pq -MConfig -e'print \$Config{archlibexp}'`; $archlib = `$bindir/$pq -MConfig -e'print \$Config{archlib}'` unless $archlib; my $sitearch = `$bindir/$pq -MConfig -e'print \$Config{sitearchexp}'`; # may be empty if ($c->options->{dryrun} or (-f "$bindir/$p" and -d $archlib)) { $c->_system0("sudo","rm","-rf", "$bindir/$p", $archlib, $sitearch); } else { $c->_fail("$p archlib $archlib did not exist"); } my $root = $c->config->{PERLALL_BUILDROOT}; if (-d "$root/inst-$p") { $c->_system1("rm","-rf","$root/inst-$p"); } # XXX ask if (-d "$root/build-$p") { $c->_log("rm","-rf","$root/build-$p"); } print "perl$p uninstalled\n"; } } =item B [OPTIONS] perl [ branch|from ] Same as C, but reports the testresults to the smokers mailing list. C may be a wildcard for multiple smoke branches, as C. Description and OPTIONS see L. =cut sub _smoke { my ($c, $p, $from, @j) = @_; return "unimplemented"; } =item B [OPTIONS] [ how ] Runs a short perl-core benchmark, and optionally a third-party script, automatically until the benchmark statistically stabilizes. Rejects statistical outliers, heavy load, and does the iterations up to 2 seconds on shorter scripts. Tested are array access, hash access, s///, in a tak with recursion and tail-recursion without IO to prevent too many external influences, though perl typically shines on IO. =cut sub bench :Help('NYI') { my $c = shift; # http://blogs.perl.org/users/rurban/2011/11/on-simple-benchmarks.html return "unimplemented"; } =item B [perl [--deps] [...]] =item perlall="5.*" B [...] Installs and updates basic CPAN modules. Default: C in F<~/.perlall> YAML DBI DBD::SQLite CPAN::SQLite Devel::Platform::Info \ Params::Util Bundle::CPANReporter2 \ B::Flags Opcodes Math::Round Params::Classify `cat ~/Perl/B-C/t/top100` \ Bundle::CygwinVendor YAML::XS DBIx::Class SQL::Abstract Module::Find Mouse \ MouseX::Types Task::Kensho Specific Options: --cpan=-MCPAN Default: C=C or C in F<.perlall> --deps scan blib/lib and t for modules with ack =cut sub init :Help('Installs and updates basic CPAN modules') { my $c = shift; $c->addopts( "cpan=s", "deps" ); my @argv = @{$c->argv}; my $mods = @argv ? join(" ",@argv) : $c->config->{'init-modules'}; if (!@argv and $mods =~ /`(.+?)`/) { # expand `` in init-modules my $sh = `$1`; $mods =~ s/`(.+?)`/$sh/; } if ($c->options->{deps}) { my $ack = q(ack -ho '(^\s*|\{\s*)(use|require) ([\w:]+);' blib/lib t | perl -lpe's/^\s*(\{|;|use|require)\s*//g;s/;?\s*\$//;' | sort -u); $mods = `$ack`; $mods = join(" ",split(/\n/, $mods)); return "no --deps found" unless $mods; } return "missing config init-modules" unless $mods; my $cpan = $c->options->{'cpan'}; $cpan = $c->config->{'cpan'} unless $cpan; $c->options->{verbose} = 1; for my $p (@{$c->stash->{perlall}}) { $c->_lognew(_short($p)); if ($c->_older( $p, "5.8.1")) { $cpan = '-MCPAN'; } else { if (!$cpan) { if (qx($p -MApp::Cpan -e'print q(ok)') eq 'ok') { $cpan = 'cpan'; } elsif (qx($p -MApp::cpanminus -e'print q(ok)') eq 'ok') { $cpan = 'cpanm'; } else { $cpan = '-MCPAN'; } } } if ($cpan eq 'cpan') { # XXX and use_sqlite # if App::cpan exists and works ok, -S cpan # otherwise need -MCPAN -e'install qw(mods)' # use_sqlite bootstrap: YAML DBI DBD::SQLite CPAN::SQLite qx($p -MCPAN::SQLite -e'CPAN::SQLite->query(mode=>"dist",name=>"CPAN")' 2>/dev/null); if ($? >> 8) { my $nosql = "$ENV{HOME}/.cpan/CPAN/nosqlite.pm"; unless ( -f $nosql ) { $c->_system("cp","$ENV{HOME}/.cpan/CPAN/MyConfig.pm", $nosql); $c->_grep("-i s/'use_sqlite' => q\[1\]/'use_sqlite' => q\[0\]/; print", $nosql); } # XXX only newer cpan's can do -j $c->_system1( $p, "-S", "cpan", "-j", $nosql, 'DBI', 'DBD::SQLite'); } } if ($cpan eq '-MCPAN') { $c->_system1( $p, "-MCPAN", "-e", "install qw($mods)" ); } else { $c->_system1( $p, "-S", $cpan, split(/\s+/,$mods)); } } $c->_set_alias() if @{$c->stash->{perlall}} < 5; } =item B [version*] List all installed perls available for perlall. Note that options after list are ignored. =cut sub list :Help('List all installed perlall versions') { my $c = shift; warn "additional arguments @{$c->argv} ignored\n" if @{$c->argv}; return join "\n", @{$c->stash->{perlall}}; } =item B version Set alias p in .perlall =cut sub set :Help('Set alias p in .perlall') { my $c = shift; my $p = pop @{$c->argv}; warn "additional arguments @{$c->argv} ignored\n" if @{$c->argv}; $c->_set_alias($p); return; } =item B [] commands... Execute commands with all perls. Specific Options: --verbose|-v --quiet|-q --dryrun --forked --gittag="hex" All other options and arguments are passed through to the perl. For example, run a Hello program: perlall do -E'say "Hello from $]"' is expanded to something like: for perl in /usr/local/bin/perl5*; do p=$perl echo $perl $* $perl $* done Better restricts perls via ENV: perlall="5.14.*d*" perlall do -E'say "Hello from $]"' is expanded to something like: for perl in /usr/local/bin/perl5.14.*d*; do p=$perl echo $p $* $p $* done The output depends on your perl installations, and looks like this: perl5.12.2-nt -E'say "Hello from $]"' Hello from perl-5.012002 perl5.12.3-m -E'say "Hello from $]"' Hello from perl-5.012003 perl5.14.2 -E'say "Hello from $]"' Hello from perl-5.014002 perl5.14.2d -E'say "Hello from $]"' Hello from perl-5.014002 perl5.14.2d-nt -E'say "Hello from $]"' Hello from perl-5.014002 perl5.8.9-nt -E'say "Hello from $]"' Unrecognized switch: -E (-h will show valid options). perl5.6.2-nt -E'say "Hello from $]"' Unrecognized switch: -E (-h will show valid options). Notice that the commands are not executed in parallel. =cut sub do :Help('Execute commands with all perls') { my $c = shift; my $argv = join " ",@{$c->argv}; return "missing args" unless $argv; $c->addopts( "verbose|v", "quiet|q", "dryrun!", 'forked', "gittag=s" ); # $c->options->{verbose} = 1 unless $c->options->{quiet}; for my $p (@{$c->stash->{perlall}}) { $c->_lognew(_short($p)); local $ENV{p} = $p; local $c->options->{quiet}; $c->_system0( "$p $argv"); } $c->_set_alias() if @{$c->stash->{perlall}} < 5; } =item B modules like C, but calls C for all perls =cut sub cpan :Help('Call cpan with args for all perls') { my $c = shift; my $argv = join " ",@{$c->argv}; return "missing args" unless $argv; $c->options->{verbose} = 1 unless $c->options->{quiet}; for my $p (@{$c->stash->{perlall}}) { $c->_lognew(_short($p)); $c->_system0($p, "-S", "cpan", @{$c->argv}); } $c->_set_alias() if @{$c->stash->{perlall}} < 5; } =item B modules like C, but uses C. Note: C<--sudo> is very common argument passed trough. =cut sub cpanm :Help('Call cpanm with args for all perls') { my $c = shift; my $argv = join " ",@{$c->argv}; return "missing args" unless $argv; $c->options->{verbose} = 1 unless $c->options->{quiet}; for my $p (@{$c->stash->{perlall}}) { $c->_lognew(_short($p)); $c->_system0($p, "-S", "cpanm", @{$c->argv}); } $c->_set_alias() if @{$c->stash->{perlall}} < 5; } sub _gitoneliner { my $c = shift; return $c->options->{gittag} if $c->options->{gittag}; -d '.svn' ? `svn info t | grep Revision` : (-d '.git' ? `git log --oneline -1` : ''); } =item B [commands...] like C, but prepends C before executing the arguments. C<$p> is expanded to the currently run perl. perlall is also Build.PL aware but prefers Makefile.PL. perlall make '-e1 && valgrind \$p -Mblib test.pl' Specific Options: --verbose|-v --quiet|-q --dryrun --forked --gittag="hex" All other options and arguments are passed through to the perl. =cut sub _make { my $c = shift; my $p = shift; my $make = $Config{make}; # checks MB $c->_system( $make, "-s", "clean") if -f "Makefile"; $c->_lognew(_short($p)) unless $c->stash->{log_fh}; if (-f "Makefile.PL") { $c->_system0( $p, "Makefile.PL"); $c->_system1( $make); } elsif (-f "Build.PL") { # This is broken and needs a realclean $c->_system( "./Build", "realclean") if -f "Build";# and $^O ne 'MSWin32'; $c->_system( "rm", "-rf", "blib", "_Build", "Build" ) if $^O ne 'MSWin32'; $c->_system0( $p, "Build.PL"); $c->_system1( $p, "Build"); } } sub make :Help('Do perl Makefile.PL; make for all perls') { my $c = shift; my $argv = join " ",@{$c->argv}; my $make = $Config{make}; $c->addopts( "verbose|v", "quiet|q", "dryrun!", 'forked', "gittag=s" ); my $gitshort = $c->_gitoneliner(); my $v = $c->options->{verbose}; for my $p (@{$c->stash->{perlall}}) { $c->_lognew(_short($p)); my $fh = $c->stash->{log_fh}; print $fh $gitshort if $fh and $gitshort; local $c->options->{verbose} = 0; local $c->options->{quiet} = 1; # undef $c->stash->{log_fh}; $c->_make( $p); if ($argv) { # preserves quotes as in -e'my $a;' #$c->options->{verbose} = 1 unless $c->options->{quiet}; local $ENV{p} = $p; local $c->options->{quiet}; local $c->options->{verbose} = $v; $c->_system0( "$p $argv" ); } } $c->_set_alias() if @{$c->stash->{perlall}} < 5; } =item B [commands...] like C, but runs C after C. This is the most used command. On C<--quiet> or C<-q> does not do TEST_VERBOSE=1 Specific Options: --verbose|-v --quiet|-q --dryrun --forked --gittag="hex" All other options and arguments are passed through to the perl. =cut sub maketest :Help('Do make; make test for all perls') { my $c = shift; my $make = $Config{make}; $c->addopts( "verbose|v", "quiet|q", "dryrun!", 'forked', "gittag=s" ); my $gitshort = $c->_gitoneliner(); my $v = $c->options->{verbose}; for my $p (@{$c->stash->{perlall}}) { $c->_lognew(_short($p)); my $fh = $c->stash->{log_fh}; print $fh $gitshort if $fh and $gitshort; local $c->options->{verbose} = 0; local $c->options->{quiet} = 1; $c->_make($p); my @opts = ("test", $v ? "TEST_VERBOSE=1" : ()); unshift @opts,"-j".$c->options->{j} if $c->options->{j} and !$c->_older( $p,"5.10.0"); if (!-f "Makefile" and -f "Build") { $c->_system1( $p, "Build", @opts); } else { $c->_system1( $make, @opts); } unless ($v) { my $log = $c->stash->{log}; my $result = `grep -a Result: $log`; $c->_log(0, $result) if $result; } if (@{$c->argv}) { local $c->options->{quiet}; local $c->options->{verbose} = $v; # optionally additional tests $c->_system0( "p=$p $p @{$c->argv}"); } if (-d '.svn' and $fh) { print $fh `svn info t | grep Revision`; print $fh `svn diff -x -w` if -d '.svn'; } elsif (-d '.git' and $fh) { print $fh `git log -1`; print $fh `git diff`; } print $fh `$p -V` if $fh; } # special hooks: `./store_rpt` if -f 'store_rpt'; $c->_set_alias() if @{$c->stash->{perlall}} < 5; } =item B [commands...] like C, but runs C after C. Specific Options: --force|-f --notest|-n =cut sub makeinstall :Help('Do make test && sudo make install for all perls') { my $c = shift; my $make = $Config{make}; $c->addopts( "force|f", "notest|n" ); # XXX check CPAN/MyConfig.pm for sudo #warn "additional arguments @{$c->argv} ignored\n" if @{$c->argv}; my $gitshort = $c->_gitoneliner(); my $sudo = $c->config->{sudo}; my $v = $c->options->{verbose}; for my $p (@{$c->stash->{perlall}}) { $c->_lognew(_short($p)); local $c->options->{verbose} = $v; my $fh = $c->stash->{log_fh}; print $fh $gitshort if $fh and $gitshort; # undef $c->stash->{log_fh}; $c->_make($p); my $instcmd = "$sudo $make install"; if ($c->options->{notest}) { $c->options->{verbose} = 1 unless $c->options->{quiet}; $c->_system1( $instcmd ); } elsif ($c->options->{force}) { $c->_system1( $make, 'test' ); $c->options->{verbose} = 1 unless $c->options->{quiet}; $c->_system1( $instcmd ); } else { $c->options->{verbose} = 1 unless $c->options->{quiet}; $c->_system1( "$make test && $instcmd" ); # csh? } if (@{$c->argv}) { # optionally additional tests local $ENV{p} = $p; $c->_system0( $p, @{$c->argv} ); } } $c->_set_alias() if @{$c->stash->{perlall}} < 5; } # may return undef if not possible to start it sub _startvm { my $c = shift; my $m = shift or die "_startvm missing vm name"; # XXX only virsh supported so far. BTW, we do not want to use the Libvirt XML module my $ctl = $c->config->{testvm_ctl}; unless ($ctl) { $c->_log('',"no testvm_ctl in .perlall. _startvm $m skipped"); return 1; } $c->_fail("Unsupported testvm_ctl='$ctl' in .perlall. Only virsh.") if $ctl ne 'virsh'; my $status = `sudo virsh list --all`; my $test = ' Id Name State ---------------------------------- 14 win running 15 freebsd7 paused 18 centos6 paused 22 centos5 paused 24 centos4 paused 25 solaris running - freebsd8 shut off - openbsd49 shut off'; # XXX resolve DNS aliases (from /etc/hosts). i.e. c5 => centos5 my $max = $c->options->{max}; my (@running); my @status = split/\n/,$status; if ($max) { for (@status) { my @v = split /\s+/; shift @v if $v[0] eq ''; push @running, $v[1] if $v[2] eq 'running'; } } for (@status) { my @v = split /\s+/; shift @v if $v[0] eq ''; if ($v[1] eq $m) { if ($v[2] eq 'running') { # running,idle,paused,shutdown,shut off,crashed,dying return 1; } elsif ($v[2] eq 'paused') { if ($max and @running > $max) { my $r = shift @running; $c->_system1(qw(sudo virsh suspend), $r); push @{$c->stash->{vm}}, [$m,'suspend']; } $c->_system1(qw(sudo virsh resume), $m); sleep 0.1; unshift @running, $m; return 1; } elsif ($v[2] eq 'shut') { if ($max and @running > $max) { my $r = shift @running; $c->_system1(qw(sudo virsh suspend), $r); push @{$c->stash->{vm}}, [$m,'shutdown']; } $c->_system1(qw(sudo virsh start), $m); sleep 25; unshift @running, $m; return 1; } else { $c->_fail("vm $m in invalid state $v[2]"); return; } } } $c->debug("vm $m not found"); return 1; } sub _vm_prevstatus { my $c = shift; my $m = shift or die "_vm_prevstatus missing vm name"; while (@{$c->stash->{vm}}) { my $a = shift @{$c->stash->{vm}}; return $a->[1] if $a->[0] eq $m; } } sub _vm_delstatus { my $c = shift; my $m = shift or die "_vm_delstatus missing vm name"; my @v = grep {$_->[0] ne $m} @{$c->stash->{vm}}; $c->stash->{vm} = \@v; } =item B [OPTIONS] [user@]hostname... Does C in parallel on remote machines. C is only usable within a perl core builddir/srcdir or in a module rootdir. It shells out to ssh account(s), copies the files in MANIFEST to the machine, runs C there and copies the logfiles back. Specific Options: --all|a - all hosts defined in config C --up - only upload (files from local MANIFEST) --cmd|c= any valid perlall command, like build, init, makeinstall, smoke. Default: maketest --option|o="" remaining remote perlall cmd options and args --max|j 4 - how many machines in parallel. --fork - test in parallel and do not wait for the results, just gather logfiles --prefix|p=Perl - remote basedir if different to local basedir Config settings: testvm="[user@]hostnames..." testvm_prefix=Perl - relative remote basepath of your modules i.e. local basename = B-Generate => remote: vmhost:Perl/B-Generate testvm_max=4 - balancing, default for -j testvm_ctl=virsh - type of vm ctl: virsh, xen-shell, vmrun, VBoXManage VM Balancing: If the remote hosts are VM's on this machine, you can control how many VM's should run in parallel, and how they are started and stopped. Currently only C is supported to resume a paused vm and start a stopped vm. C<--max> is yet ignored. If C is not set, no balancing - start+shutdown - will be done, such as on physical hosts or enough VM power. See F<.perlall> =cut sub testvm :Help('Test on remote accounts via ssh/rsync (vm or host)') { my $c = shift; # testvm has a different option set and allows options after the command my $gopts = _opts($c->options); $c->addopts( "all|a", "up", "prefix|p=s", "cmd|c=s", "option|o=s", "max|j=n", "fork!" ); my ($base); my @testvm = split / /,$c->config->{testvm_all}; my @machines = $c->options->{all} ? @testvm : @{$c->argv}; return "missing args" unless @machines; $c->options->{max} = $c->config->{testvm_max} unless $c->options->{max}; # XXX Expand glob-style machines # Idea: - check /etc/hosts so testvm can be empty? # But then we have to check the network for possible machines, # or we want to do all hosts in /etc/hosts? # - check hosts in .ssh/known_hosts # XXX check if pwd in core or in a module my $opts = _opts($c->options); $opts =~ s/$_// for split/ /,$gopts; $gopts = " ".$gopts if $gopts; _print(1,"perlall$gopts testvm ".$opts,@machines) if $c->options->{verbose}; $c->_lognew(''); my $cmd = $c->options->{cmd} || "maketest"; my $opt = $c->options->{option} ? (' '.$c->options->{option}) : ' -q'; my $man = 'MANIFEST'; $c->_fail("$man not found") unless -f $man; my $f = 'MANIFEST.files'; if ( ! -f $f or -M $man < -M $f ) { $c->_log(1,"Creating $f"); open M,'<',$man; open F,'>',$f; while () { s/ +$//; s/^(\S+)(\s+.+)$/$1/; print F $_ unless /^#/; } close M; close F; } # $vmprefix = File::Spec->abs2rel(Cwd::getcwd, $ENV{HOME}); my $home = $ENV{HOME}; if (!$home or !-d $home) { _auto_use('File::HomeDir'); $home = File::HomeDir->my_home; } if (File::Spec->can('abs2rel') and $home) { my $cwd = Cwd::getcwd(); $base = File::Spec->abs2rel($cwd, $home); if (length($cmd) < length($base)) { # use absolute paths if shorter $base = $cwd; } } else { my $vmprefix = $c->options->{testvm_prefix} || "Perl"; $base = File::Spec->catdir($vmprefix, basename(Cwd::getcwd())); } my $msg = "done"; my $remotecmd = "cd $base && touch Makefile.PL && perlall$gopts $cmd$opt"; my $up = $c->options->{up}; my $do_fork = $c->options->{fork} and IPC::Cmd->can_use_run_forked(); my $gitshort = $c->_gitoneliner(); my $fh = $c->stash->{log_fh}; print $fh $gitshort if $fh and $gitshort; my @forked; for my $m (@machines) { $c->_startvm($m) or next; # XXX some old systems (centos4) have rsync 2.6 which will fail. # -vldogDtpRze.Lsf: unknown option $c->_system1("rsync","-avzL","--delete", '--files-from=MANIFEST.files', '.', "$m:$base/") or next; unless ( $up ) { # my $buf = ' 'x10000; my $logglob = $cmd eq 'maketest' ? "log.test-*" : "log.$cmd-*"; if ($gitshort and $remotecmd != /--gittag/) { my ($commit) = split / /, $gitshort; $remotecmd .= " --gittag=$commit"; } if ($do_fork) { # run cmds in parallel $remotecmd .= ' --forked' if $cmd eq 'maketest' and $cmd !~ /--forked/; my @cmd = ("sh","-c", "if ssh $m '$remotecmd'; then rsync -avz $m:$base/$logglob .; grep Result $logglob; fi"); # if virsh was resumed, pause it back afterwards if ($c->stash->{vm} and my $prevstat = $c->_vm_prevstatus($m)) { @cmd = ("sh","-c", "if ssh $m '$remotecmd'; then rsync -avz $m:$base/$logglob .; grep Result $logglob; " ."sudo virsh $m $prevstat; fi"); _vm_delstatus($m); } my $pid; #my $pid = IPC::Cmd::run_forked( \@cmd, # {timeout => 3600, # seconds, max 1h # # discard_output => 1, # rather collect logfiles. # # terminate_on_parent_sudden_death => 1, # }); FORK: { if ($pid = fork) { $c->debug("forked $pid"); #parent push @forked, $pid; $msg = "forked"; $c->_log(0,"forked $remotecmd on $m"); } elsif (defined $pid) { exec @cmd; # child just ends } elsif ($! == &Fcntl::EAGAIN) { # supposedly recoverable fork error sleep 5; redo FORK; } else { die "Can't fork: $!\n"; # weird fork error } } # do not wait for children forked off. they are perlall.lock'ed and come back alone #sleep 15.0 if $forked; ## DEBUGGING } else { $c->_system1("ssh",$m,$remotecmd); $c->_system1("rsync","-avz","$m:$base/$logglob","."); $c->_system1("grep Result $logglob"); } } } if (!@forked and $c->stash->{vm}) { while (@{$c->stash->{vm}}) { my $a = shift @{$c->stash->{vm}}; $c->_system1(qw(sudo virsh), $a->[1], $a->[0]); } } "testvm $cmd $msg on ".join(" ",@machines) } =item B [--all] user@[hostname]... copies pubkey to host:.ssh/authorized_keys if not exists copies perlall to host:bin/ (if perlbin is installed at /usr/local/bin/ then symlink to it) ssh hostname perlall -v init App::Rad IO::Scalar Devel::Platform::Info Devel::PatchPerl =cut sub initvm :Help('Init remote perlall via ssh/rsync (vm or host)') { my $c = shift; $c->addopts( "all|a", "max|j=n"); my @m = $c->options->{all} ? split(/ /,$c->config->{testvm_all}) : @{$c->argv}; return "missing host" unless @m; $c->options->{max} = $c->config->{testvm_max} unless $c->options->{max}; $c->_lognew(''); for my $m (@m) { _print(0,"perlall initvm $m") unless $c->options->{quiet}; $c->_startvm($m) or next; unless (`ssh $m ls .ssh/authorized_keys` =~ /authorized_keys$/m) { for my $t (/ecdsa dsa rsa/) { if (-f "$ENV{HOME}/.ssh/id_$t.pub") { _print 1,"rsync -avzL ~/.ssh/id_$t.pub >>$m:.ssh/authorized_keys" unless $c->options->{quiet}; qx(rsync -avzL $ENV{HOME}/.ssh/id_$t.pub $m:.ssh/copied.pub); qx(ssh $m cat .ssh/copied.pub >> .ssh/authorized_keys); last } } } # XXX To ~/bin/ or /usr/local/bin/? # make install puts it into /usr/local/bin/ but this will need sudo # XXX if $m is cygwin, check if pl2bat needed # XXX TODO current msys and mingw recipes: #rsync -azL ~/bin/perlall win:/cygdrive/c/mingw/msys/1.0/home/$USER/bin/ #rsync -azL ~/bin/perlall win:/cygdrive/c/perl514/perl/site/bin #ssh win 'cd /cygdrive/c/perl514/perl/site/bin && cmd /C "PATH=c:\perl514\perl\bin;%PATH% & c:\perl514\perl\bin\pl2bat perlall"' #rsync -azL /home/rurban/bin/perlall win:/cygdrive/c/perl512/perl/site/bin #ssh win 'cd /cygdrive/c/perl512/perl/site/bin && cmd /C "PATH=c:\perl512\perl\bin;%PATH% & c:\perl512\perl\bin\pl2bat perlall"' $c->_system1("rsync","-avzL",$0,"$m:bin/perlall") or next; # check .perlall, and cpan deps unless (`ssh $m ls .perlall` =~ /.perlall$/m) { $c->_system1("rsync","-avzL","$ENV{HOME}/.perlall","$m:.perlall"); } $c->_system1("ssh $m " ."'perl -MCPAN -e\"install qw/" . join(" ",@extuse). "/\"'"); my $patchperlpath = `ssh $m perldoc -l Devel::PatchPerl`; chomp $patchperlpath; $patchperlpath =~ s|PatchPerl\.pm|PatchPerl/Plugin|; my $patchasan = `perldoc -l Devel::PatchPerl::Plugin::Asan`; chomp $patchasan; die "Devel::PatchPerl::Plugin::Asan missing\n" unless $patchasan; my $patchperlall = `perldoc -l Devel::PatchPerl::Plugin::perlall`; chomp $patchperlall; die "Devel::PatchPerl::Plugin::perlall missing\n" unless $patchperlall; $c->_system1("ssh",$m,"mkdir -p $patchperlpath"); $c->_system1("rsync","-avz",$patchasan,"$m:$patchperlpath/Asan.pm"); $c->_system1("rsync","-avz",$patchperlall,"$m:$patchperlpath/perlall.pm"); } while ($c->stash->{vm} and @{$c->stash->{vm}}) { # restore previous vm state my $a = shift @{$c->stash->{vm}}; $c->_system1(qw(sudo virsh), $a->[1], $a->[0]); } "initvm done on ".join(" ",@m) } =item B I<(var (value))> =cut sub config :Help('Print (or update - not yet) config') { my $c = shift; $c->addopts('options|o'); my $file = ".perlall="; for ( "/etc/perlall", "$ENV{HOME}/.perlall" ) { $file .= $_.":" if -f $_; } print substr($file,0,-1),"\n"; for (keys %{$c->config}) { print $_,"=",$c->config->{$_},"\n"; } if ($c->options->{options}) { delete $c->options->{options}; for (keys %{$c->options}) { print $_,"=",$c->options->{$_},"\n"; } } } =item B [ --latest ] This command upgrades perlall to its latest or stable version. =cut sub selfupgrade :Help('Upgrade perlall to its latest or stable version') { my $c = shift; $c->addopts('latest|l'); my $branch = $c->options->{latest} ? 'master' : 'release'; $c->_system("wget","--no-check-certificate","-O","perlall.tmp", "http://github.com/rurban/App-perlall/raw/$branch/script/perlall"); if (-s "perlall.tmp" > 5000) { $c->_system("chmod","0755","perlall.tmp"); $c->_system("mv","perlall.tmp",-l $0 ? readlink($0) : $0) or "$0 updated" } else { "wget download from github failed" } } =item B prints this help. With -v even more. =cut sub help :Help('List of commands. With -v more') { my $c = shift; $c->addopts( 'verbose|v' ); require Pod::Usage; return Pod::Usage::pod2usage ( { -message => App::Rad::Help::usage() . "\n\n" . App::Rad::Help::helpstr($c), -verbose => $c->options->{verbose} ? 3 : 0, } ); } =item B =cut sub version :Help('Print version') { # hardlink variants (perlall-make, ...) print basename($0)." $main::VERSION\n"; exit; } =back =head1 CONFIGURATION Stored in F<~/.perlall> or F This is shell-script syntax with ENV vars and aliases. C is also written by C. It is recommended to source this from your F<.profile> for the handy aliases. =over 4 =item alias p=perl5.15.4d-nt Save current perl in shell alias form. This is stored after each perlall execution. Dependend on p there are several other handy p aliases, which are active if you source them from your F<~/.profile> See F<.perlall> =item alias perl-git="cd /usr/src/perl/blead/perl-git" Directory with a perl5 git repo to avoid downloading perl-*.tar.gz from CPAN, in shell alias form. C stores the perl git workdir, and is also a handy alias to cd into it. =item PERLALL_PREFIX Where perls are installed into. Default: /usr/local =item PERLALL_BINDIR Where perl5.* binaries are expected. Currently built into PERLALL_PREFIX/bin only. Default: PREFIX/bin but can also be ~/perl5/perlbrew/bin =item PERLALL_BUILDROOT Where perls are built. Default: /usr/src/perl =item cpan For init only. C or C (C<-MCPAN> not yet) =item init-modules List of CPAN module names for C =item sudo Default: "sudo". Or "" on cygwin|msys|MSWin32 =item testvm See L. =back =head1 SEE ALSO The bash scripts, which I used for some years: L L which is good for complete private unshared installations. It looked like my bash scripts and B, but cannot be used as easily. L which also builds a lot of perls to smoke cpan releases with them. =head1 COPYRIGHT This software is copyright (c) 2011,2012 by cPanel Inc. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut