bin/makeperl.pl

   1 #!/usr/bin/perl
   2
   3 # use 5.010;
   4 use strict;
   5 use warnings;
   6 use CPAN::Version;
   7
   8 =head1 NAME
   9
  10
  11
  12 =head1 SYNOPSIS
  13
  14
  15
  16 =head1 OPTIONS
  17
  18 =over 8
  19
  20 =cut
  21
  22 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  23
  24 =item B<--addopts=s@>
  25
  26 Options to be added to the Configure call. Do not use a leading C<->
  27 (dash) for the content of the option as in
  28 C<--addopts=Duserelocatableinc>
  29
  30 =item B<--debugging!>
  31
  32 Defaults to true and sets -DDEBUGGING=-g. Cannot be combined with
  33 --debuggingoption
  34
  35 =item B<--debuggingoption=s>
  36
  37 No default. Passed through to perl with a C<-D>. Cannot be combined with
  38 --debugging.
  39
  40 Example:
  41
  42   --debuggingoption=DEBUGGING=both
  43
  44 =item B<--dotcpanhome=s>
  45
  46 defaults to C< $ENV{HOME}/.cpan >. The place passed to every
  47 smoker-perl where it should pick the MyConfig from.
  48
  49 =item B<--help|h!>
  50
  51 This help
  52
  53 =item B<--inversemodule=s>
  54
  55 If we are running a bisect to find out when a breakage was fixed, we
  56 need to fake the other return value than what we usually do. I.e. when
  57 the module passes we return a fail and when it fails we return a pass.
  58 Because git-bisect is so braindead. You get this by supplying a
  59 --inversemodule.
  60
  61 =item B<--jobs|j=i>
  62
  63 Parameter to pass to 'make -j' on normal C<make> runs and to assign to
  64 the TEST_JOBS environment variable on C<make test> runs. Since
  65 20160607 we also set HARNESS_OPTIONS accordingly. Defaults to 3.
  66
  67 It seems perl 5.8.7 needs --jobs=1 . It doesn't succeed with x2p stuff
  68 but it's even worse when called with parallel make.
  69
  70 =item B<--keepfiles!>
  71
  72 Do not do any cleanup after perl installation. Cleanup should be done
  73 by the user then, e.g. with C<git clean -dfx>.
  74
  75 =item B<--keepfilesonerror!>
  76
  77 Do not do any cleanup on error, just bail out with an error.
  78
  79 =item B<--module=s@>
  80
  81 Install this (or these) module(s), die when it (the last of those)
  82 cannot be updated to the current version. See also --inversemodule.
  83
  84 Misnomer. the argument can be any argument that can be passed to CPAN
  85 shell's install command. B<But>: since we only have the uptodate
  86 command to verify that an install has taken place, we are unable to
  87 determine success for arguments like
  88 MSCHWERN/Test-Simple-1.005000_005.tar.gz.
  89
  90 In so far, it is not such a misnomer.
  91
  92 Additional hook: if the argument contains no slash but a minus, we
  93 replace it with C<::> as we are used to do it in many other contexts.
  94
  95 And another hook: if there is only one --module option and the
  96 argument contains a comma, we split into an arrayref.
  97
  98 =item B<--prefix=s>
  99
 100 Defaults to /home/sand/src/perl/repoperls/installed-perls/perl, but only
 101 when hostname=k83. All other hostnames get the last path element
 102 C<perl> replaced with C<host/> concatenated with their hostname. We
 103 started with this rule on 2012-04-22 because relocateableinc does not
 104 work (see https://rt.perl.org:443/rt3/Ticket/Display.html?id=112448).
 105
 106 It gets the output of C<git describe> and a config-dependent
 107 hex-encoded hash appended.
 108
 109 =item B<--report!>
 110
 111 Short for
 112
 113   --module=Bundle::CPANxxl --module=Bundle::CPANReporter2
 114
 115 Defaults to false.
 116
 117 =item B<--suppressreadline!>
 118
 119 $CPAN::Suppress_readline will be set to true. Useful for testing
 120 modules that need a readline handle, like Term::Completion
 121
 122 =item B<--successchecker=s>
 123
 124 Run a perl script that determines success or failure. Will only be
 125 executed when state is success.
 126
 127 =item B<--test!>
 128
 129 Runs C<make test> on perl and exits with an error if it does not
 130 succeed.
 131
 132 Since 2016-01-02 we default this to true.
 133
 134 =item B<--tmpdir=s>
 135
 136 Defaults to /tmp.
 137
 138 =item B<--ud=s>
 139
 140 One of C<UU>, C<UD>, C<DU>, C<DD>, C<rand>.
 141
 142 Defaults to UD, gets expanded to
 143
 144   --addopts=Uuseithreads
 145   --addopts=Duselongdouble
 146
 147 UU gets expanded to
 148
 149   --addopts=Uuseithreads
 150   --addopts=Uuselongdouble
 151
 152 etc.
 153
 154 Argument C<rand> changes the option itself to one of the four
 155 available uppercase settings at random.
 156
 157 =item B<--usegit!>
 158
 159 If current directory contains a C<.git/> subdirectory, defaults to
 160 true, otherwise to false.
 161
 162 =back
 163
 164 =head1 DESCRIPTION
 165
 166 Script to build perl and one or more modules and return true when the
 167 module (or the last of several modules) can be built.
 168
 169 Chdir to the git repo and for a simple build run
 170
 171   makeperl.pl
 172
 173 The default is a nonthreaded build with -Duselongdouble. To choose a
 174 different permutation of threadedness and uselongdoubleness use the
 175 option -ud=, eg:
 176
 177   makeperl.pl -ud=DD
 178   makeperl.pl -ud=UU
 179   makeperl.pl -ud=DU
 180
 181 To immediately build one module with the resulting perl:
 182
 183   makeperl.pl -module=YAML::Syck
 184
 185 With the ability to return false on fail we can start bisecting:
 186
 187   git bisect start v5.14.0-658-g65374be v5.14.0-523-gc5caff6
 188
 189 And then C<run bisect>:
 190
 191   git bisect run makeperl.pl -ud=rand --module=YAML::Syck
 192
 193 =cut
 194
 195 # stolen from loop-over-recent.pl
 196 use BSD::Resource;
 197 BSD::Resource::setrlimit(BSD::Resource::RLIMIT_CORE(),  40*1024*1024, 40*1024*1024);
 198 BSD::Resource::setrlimit(BSD::Resource::RLIMIT_CPU(),   3600, 3600);
 199 BSD::Resource::setrlimit(BSD::Resource::RLIMIT_RSS(),   3_000_000_000, 3_000_000_000);
 200 BSD::Resource::setrlimit(BSD::Resource::RLIMIT_AS(),    4_000_000_000, 4_000_000_000);
 201
 202 use FindBin;
 203 use lib "$FindBin::Bin/../lib";
 204 BEGIN {
 205     push @INC, qw(       );
 206 }
 207
 208 use Dumpvalue;
 209 use Cwd;
 210 use File::Basename qw(dirname basename);
 211 use File::Path qw(mkpath rmtree);
 212 use File::Spec;
 213 use File::Temp;
 214 use Getopt::Long;
 215 use Pod::Usage;
 216 use Hash::Util qw(lock_keys);
 217 use Digest::SHA;
 218 use Sys::Hostname qw(hostname);
 219 our $HAVE_DEVEL_PATCHPERL;
 220 {
 221     local $@;
 222     $HAVE_DEVEL_PATCHPERL = eval { require Devel::PatchPerl; Devel::PatchPerl->import("1.42"); 1; };
 223 }
 224 our %Opt;
 225 lock_keys %Opt, map { /([^=!\|]+)/ } @opt;
 226 GetOptions(\%Opt,
 227            @opt,
 228           ) or pod2usage(1);
 229 if ($Opt{help}) {
 230     pod2usage(0);
 231 }
 232
 233 $Opt{report} ||= 0;
 234 $Opt{test} //= 1;
 235 $Opt{tmpdir} ||= "/tmp";
 236 $Opt{dotcpanhome} ||= "$ENV{HOME}/.cpan";
 237 unless (defined $Opt{usegit}) {
 238     if (-d ".git") {
 239         $Opt{usegit} = 1;
 240     } else {
 241         $Opt{usegit} = 0;
 242     }
 243 }
 244
 245 sub cleanup_or_die {
 246     # error: Untracked working tree file 'lib/Search/Dict.pm' would be overwritten by merge.
 247     if ($Opt{usegit}) {
 248         unless (0==system git => clean => "-dfx") {
 249             die;
 250         }
 251         my $dirty = `git status --porcelain --untracked-files=no`;
 252         until (!$dirty) {
 253             system git => reset => "--hard";
 254             $dirty = `git status --porcelain --untracked-files=no`;
 255         }
 256     }
 257 }
 258
 259 cleanup_or_die;
 260 my $gitdescribe;
 261 if ($Opt{usegit}) {
 262     chomp($gitdescribe = `git describe`); # eg: v5.19.6-105-g448f81e
 263 } else {
 264     $gitdescribe = basename(cwd());
 265 }
 266 my($perlversion) = $gitdescribe =~ /(?:v|perl-)(5[\d\.]+)/;
 267 if ($HAVE_DEVEL_PATCHPERL) {
 268     eval { Devel::PatchPerl->patch_source($perlversion, "."); };
 269     if ($@) {
 270         warn "Alert: Devel::PatchPerl failed!";
 271         use Term::Prompt qw(prompt);
 272         my $answer = lc prompt "x", "Shall I continue? (y/n)", "", "n";
 273         if ($answer eq "n") {
 274             print "Exiting per user request\n";
 275             exit;
 276         }
 277     }
 278 } else {
 279     require version;
 280     my $perlversionnumeric = version->new($perlversion)->numify;
 281     if ($perlversionnumeric < 5.022001) {
 282         die "ALERT: Found perl $perlversionnumeric; need to tell that we really need PatchPerl";
 283     }
 284 }
 285 $Opt{jobs} = 3 unless defined $Opt{jobs};
 286 if ($Opt{ud} eq "rand") { # one rare place where overwriting an option feels ok
 287     $Opt{ud} = (qw(UD UU DD DU))[int rand 4];
 288 }
 289 my($useithreads,$uselongdouble) = unpack "aa", $Opt{ud} ||= "UD";
 290 my($debuggingoption);
 291 if (defined $Opt{debugging}) {
 292     if (defined $Opt{debuggingoption}) {
 293         die "debugging and debuggingoption not meant to be combined";
 294     } elsif ($Opt{debugging}) { # --debugging
 295         $debuggingoption = "DEBUGGING=-g";
 296     } else { # --nodebugging
 297         $debuggingoption = "";
 298     }
 299 } elsif (defined $Opt{debuggingoption}) {
 300     if ($Opt{debuggingoption} eq "rand") {
 301         my @o = (("")x7,("DEBUGGING=-g")x5,"DEBUGGING=both");
 302         $debuggingoption = $o[int rand scalar @o];
 303     } elsif ($Opt{debuggingoption} =~ /^DEBUGGING=(?:-g|both)/) {
 304         $debuggingoption = $Opt{debuggingoption};
 305     } else {
 306         warn "WARNING: Got unusual debugging option '$Opt{debuggingoption}'; not sure whether I should accept that";
 307         $debuggingoption = $Opt{debuggingoption};
 308     }
 309 } else {
 310     $debuggingoption = "DEBUGGING=-g";
 311 }
 312 my $hostname = hostname;
 313 $hostname =~ s/\..*//;
 314 unless ($Opt{prefix}) {
 315     if ($hostname eq "k83") {
 316         $Opt{prefix} = "/home/sand/src/perl/repoperls/installed-perls/perl";
 317     } else {
 318         $Opt{prefix} = "/home/sand/src/perl/repoperls/installed-perls/host/$hostname";
 319     }
 320 }
 321 warn "prefix is going to be '$Opt{prefix}'. Please interrupt if this is not your intention\n";
 322 {
 323     local $|=1;
 324     for (1..0) {
 325         printf "\r%d   ", 5-$_;
 326         sleep 1 if $_;
 327     }
 328     print "\n";
 329 }
 330 my @cargs =
 331     (
 332      "-Dmyhostname=$hostname",
 333      "-Dinstallusrbinperl=n",
 334      "-Uversiononly",
 335      "-Dusedevel",
 336      "-des",
 337      "-Ui_db",
 338      # 20160102: the -lnm surprise seems to make this necessary:
 339      "-Dlibswanted=cl pthread socket inet nsl gdbm dbm malloc dl ld sun m crypt sec util c cposix posix ucb BSD gdbm_compat",
 340      "-$useithreads"."useithreads",
 341      "-$uselongdouble"."uselongdouble",
 342      $debuggingoption ? "-D$debuggingoption" : (),
 343      (map { "-$_" } @{$Opt{addopts}||[]})
 344     );
 345 my $sha = Digest::SHA->new(1);
 346 for my $c (@cargs) {
 347     $sha->add($c);
 348 }
 349 my $hex = $sha->hexdigest;
 350 my $prefix;
 351
 352 for (my $i=4; $i<length($hex); $i++) {
 353     my $cargshash = substr($hex,0,$i);
 354     $prefix = "$Opt{prefix}/$gitdescribe/$cargshash";
 355     unless (-e "$prefix/bin/perl") {
 356         last;
 357     }
 358 }
 359 unshift @cargs, "-Dprefix=$prefix";
 360 unless (0==system "./Configure", @cargs) {
 361     die;
 362 }
 363 my @makes = (["make"], ["make", "test"]);
 364 $ENV{PERL_CANARY_STABILITY_NOPROMPT} = 1;
 365 for my $make_i (0 .. ($Opt{test}?1:0)) {
 366     my @make = @{$makes[$make_i]};
 367     if ($Opt{jobs} && $Opt{jobs} > 1) {
 368         if ($make_i == 0) {
 369             push @make, "-j$Opt{jobs}";
 370         } elsif ($make_i == 1) {
 371             $ENV{TEST_JOBS} = $Opt{jobs};
 372             $make[1] =~ s/\Atest\z/test_harness/ or die;
 373         }
 374     }
 375     my $ret = system @make;
 376     if (0==$ret) {
 377     } elsif ($Opt{keepfilesonerror}) {
 378         die "Running make[@make] returned ret[$ret], dieing according to 'keepfilesonerror'";
 379     } else {
 380         cleanup_or_die;
 381         warn sprintf
 382             (
 383              "Alert: %s: %s returning 125 after running make[%s] returned ret[%s]",
 384              scalar localtime,
 385              $0,
 386              join(" ", @make),
 387              $ret,
 388             );
 389         exit 125;
 390     }
 391 }
 392 unless (0==system "./installperl") {
 393     cleanup_or_die;
 394     die;
 395 }
 396 if ($Opt{keepfiles}) {
 397     warn "No cleanup according to --keepfiles option. You may want to 'git clean -dfx'";
 398 } else {
 399     cleanup_or_die;
 400 }
 401 my $inverse = 0;
 402 my $m = $Opt{module} || [];
 403 if (@$m == 1 and $m->[0] =~ /,/) {
 404     $m = [ split /,/, $m->[0] ];
 405 }
 406 if ($Opt{inversemodule}) {
 407     $inverse = 1;
 408     push @$m, $Opt{inversemodule};
 409 }
 410 if ($Opt{report} || @$m) {
 411     my $transient_build_dir = 1;
 412     my $bdir;
 413     if ($transient_build_dir) {
 414         $bdir = File::Temp::tempdir(
 415                                     "makeperl-XXXXXX",
 416                                     DIR => $Opt{tmpdir},
 417                                     CLEANUP => 1,
 418                                    ) or die $!;
 419     }
 420     require Sys::Hostname;
 421     my $hostname = Sys::Hostname::hostname();
 422     my @hostspecific;
 423     unless ($hostname eq "k83") {
 424         # -I ~/.cpan-k75 -MCPAN::MyConfig"
 425         @hostspecific =
 426             (
 427              "-I",
 428              "$ENV{HOME}/.cpan-$hostname",
 429              "-MCPAN::MyConfig",
 430             );
 431     }
 432     my @cpanshell =
 433         (
 434          "$prefix/bin/perl",
 435          @hostspecific,
 436          "-I$Opt{dotcpanhome}",
 437          "-M-lib='.'",
 438          "-MCPAN::MyConfig",
 439          "-MCPAN",
 440          $bdir ? ("-e","\$CPAN::Config->{build_dir}=q{$bdir};") : (),
 441          "-e",
 442         );
 443     $ENV{HARNESS_OPTIONS} = "j".$Opt{jobs} if $Opt{jobs} > 1;
 444     if ($Opt{report}) {
 445         my @script;
 446         my $opcfv = `$prefix/bin/perl -MCPAN::FTP -e print\\\$CPAN::FTP::VERSION;`;
 447         if (CPAN::Version->vlt($opcfv,"5.5009")) { # very kamikaze
 448             my $cwd = cwd;
 449             eval {
 450                 chdir "/home/sand/cpanpm";
 451                 mkpath "tmp-$$";
 452                 chdir  "tmp-$$";
 453                 0 == system rsync => "--exclude=tmp-$$", "--exclude=.git",
 454                     "--exclude=distroprefs", "-va", "..", "."
 455                     or die "Could not rsync cpanpm to tmp-$$";
 456                 #                             vvvvv kamikaze here vvvvv (no dependency resolution)
 457                 0 == system qq{$prefix/bin/perl Makefile.PL; $prefix/bin/perl -Ilib -MCPAN -e 'install(q(.))'}
 458                     or die "Could not run make install from /home/sand/cpanpm";
 459                 chdir "/home/sand/cpanpm";
 460                 rmtree "tmp-$$";
 461             } or warn "Error while trying to install CPAN from repo: $!";
 462             chdir $cwd;
 463         }
 464         my $opcv = `$prefix/bin/perl -MCPAN -e print\\\$CPAN::VERSION;`; # other perl cpan version
 465         if (CPAN::Version->vlt($opcv,"2.18")) {
 466             push @script, qq{install('ANDK/CPAN-2.18-TRIAL.tar.gz');
 467                 die unless
 468                     CPAN::Shell->expand(
 469                         Module=>"CPAN"
 470                     )->uptodate;
 471                 };
 472         }
 473         push @script, qq{install(
 474                   "CPAN::Meta::Requirements",
 475                   "Bundle::CPANxxl",
 476                   "Bundle::CPANReporter2",
 477                   "BSD::Resource",
 478                   "Log::ger",
 479                   "Log::ger::Output::File",
 480                   "Log::ger::Layout::Pattern",
 481                   "BSD::Resource",
 482                   "Term::Prompt",
 483                   # "Module::Info",
 484                   # "Devel::PatchPerl",
 485                   # "Module::Versions::Report",
 486                   # "V",
 487               );
 488               die unless
 489                   CPAN::Shell->expand(
 490                       Module=>"Test::Reporter::Transport::Metabase"
 491                   )->uptodate;
 492              };
 493         for my $script (@script) {
 494             my(@system) =
 495                 (@cpanshell,
 496                  $script,
 497                 );
 498             warn "DEBUG: system[@system]";
 499             unless (0==system @system) {
 500                 die "Alert: problem running system[@system]";
 501             }
 502         }
 503     }
 504     my $ret = 0;
 505     if ($m && @$m) {
 506         for (@$m) {
 507             s/-/::/g if /-/ and !m|/|;
 508         }
 509         my $install = join ",", map { "'$_'" } @$m;
 510         my $last = $m->[-1];
 511         my $shellcmd = "install($install); die unless CPAN::Shell->expand(Module => '$last')->uptodate;";
 512         if ($Opt{suppressreadline}) {
 513             $shellcmd = "\$CPAN::Suppress_readline=1;$shellcmd";
 514         }
 515         if (0==system @cpanshell, $shellcmd) {
 516             $ret = 0;
 517         } else {
 518             $ret = 1;
 519         }
 520         if ($inverse) {
 521             $ret ^= 1
 522         }
 523     }
 524     if (!$ret && $Opt{successchecker}) {
 525         if (0==system "$prefix/bin/perl", $Opt{successchecker}) {
 526             $ret = 0;
 527         } else {
 528             $ret = 1;
 529         }
 530     }
 531     exit $ret;
 532 }
 533 # Local Variables:
 534 # mode: cperl
 535 # cperl-indent-level: 4
 536 # End: