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, $debuggingoption2);
 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 = "EBUGGING=-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} =~ /^EBUGGING=(?:-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 = "EBUGGING=-g";
 311 }
 312 {
 313     # older perls did not understand EBUGGING=-g, only optimize=-g
 314
 315     # commit eaf812ae1a347289872c15b0fb8a27a85b03dc2f
 316     # Author: H.Merijn Brand <h.m.brand@xs4all.nl>
 317     # Date:   Mon Apr 17 12:18:07 2006 +0000
 318     #
 319     #     Support for -DDEBUGGING and its alias -DEBUGGING
 320
 321     require version;
 322     my $perlversionnumeric = version->new($perlversion)->numify;
 323     if ($perlversionnumeric < 5.010) {
 324         if (   $debuggingoption eq "EBUGGING=-g"
 325             || $debuggingoption eq "EBUGGING=both"
 326            ) {
 327             $debuggingoption = "optimize=-g";
 328             if ($debuggingoption eq "EBUGGING=both") {
 329                 $debuggingoption2 = "EBUGGING";
 330             }
 331         }
 332     }
 333 }
 334 my $hostname = hostname;
 335 $hostname =~ s/\..*//;
 336 unless ($Opt{prefix}) {
 337     if (0 && $hostname eq "k83") { # obsolet 2018
 338         $Opt{prefix} = "/home/sand/src/perl/repoperls/installed-perls/perl";
 339     } else {
 340         $Opt{prefix} = "/home/sand/src/perl/repoperls/installed-perls/host/$hostname";
 341     }
 342 }
 343 warn "prefix is going to be '$Opt{prefix}'. Please interrupt if this is not your intention\n";
 344 {
 345     local $|=1;
 346     for (1..0) {
 347         printf "\r%d   ", 5-$_;
 348         sleep 1 if $_;
 349     }
 350     print "\n";
 351 }
 352 my @cargs =
 353     (
 354      "-Dmyhostname=$hostname",
 355      "-Dinstallusrbinperl=n",
 356      "-Uversiononly",
 357      "-Dusedevel",
 358      "-des",
 359      "-Ui_db",
 360      # 20160102: the -lnm surprise seems to make this necessary:
 361      "-Dlibswanted=cl pthread socket inet nsl gdbm dbm malloc dl ld sun m crypt sec util c cposix posix ucb BSD gdbm_compat",
 362      "-$useithreads"."useithreads",
 363      "-$uselongdouble"."uselongdouble",
 364      $debuggingoption ? "-D$debuggingoption" : (),
 365      $debuggingoption2 ? "-D$debuggingoption2" : (),
 366      (map { "-$_" } @{$Opt{addopts}||[]})
 367     );
 368 my $sha = Digest::SHA->new(1);
 369 for my $c (@cargs) {
 370     $sha->add($c);
 371 }
 372 my $hex = $sha->hexdigest;
 373 my $prefix;
 374
 375 for (my $i=4; $i<length($hex); $i++) {
 376     my $cargshash = substr($hex,0,$i);
 377     $prefix = "$Opt{prefix}/$gitdescribe/$cargshash";
 378     unless (-e "$prefix/bin/perl") {
 379         last;
 380     }
 381 }
 382 unshift @cargs, "-Dprefix=$prefix";
 383 unless (0==system "./Configure", @cargs) {
 384     die;
 385 }
 386 my @makes = (["make"], ["make", "test"]);
 387 $ENV{PERL_CANARY_STABILITY_NOPROMPT} = 1;
 388 for my $make_i (0 .. ($Opt{test}?1:0)) {
 389     my @make = @{$makes[$make_i]};
 390     if ($Opt{jobs} && $Opt{jobs} > 1) {
 391         if ($make_i == 0) {
 392             push @make, "-j$Opt{jobs}";
 393         } elsif ($make_i == 1) {
 394             $ENV{TEST_JOBS} = $Opt{jobs};
 395             $make[1] =~ s/\Atest\z/test_harness/ or die;
 396         }
 397     }
 398     my $ret = system @make;
 399     if (0==$ret) {
 400     } elsif ($Opt{keepfilesonerror} || $Opt{keepfiles}) {
 401         die "Running make[@make] returned ret[$ret], dieing according to 'keepfiles(onerror)?'";
 402     } else {
 403         cleanup_or_die;
 404         warn sprintf
 405             (
 406              "Alert: %s: %s returning 125 after running make[%s] returned ret[%s]",
 407              scalar localtime,
 408              $0,
 409              join(" ", @make),
 410              $ret,
 411             );
 412         exit 125;
 413     }
 414 }
 415 unless (0==system "./installperl") {
 416     cleanup_or_die;
 417     die;
 418 }
 419 if ($Opt{keepfiles}) {
 420     warn "No cleanup according to --keepfiles option. You may want to 'git clean -dfx'";
 421 } else {
 422     cleanup_or_die;
 423 }
 424 my $inverse = 0;
 425 my $m = $Opt{module} || [];
 426 if (@$m == 1 and $m->[0] =~ /,/) {
 427     $m = [ split /,/, $m->[0] ];
 428 }
 429 if ($Opt{inversemodule}) {
 430     $inverse = 1;
 431     push @$m, $Opt{inversemodule};
 432 }
 433 if ($Opt{report} || @$m) {
 434     my $transient_build_dir = 1;
 435     my $bdir;
 436     if ($transient_build_dir) {
 437         $bdir = File::Temp::tempdir(
 438                                     "makeperl-XXXXXX",
 439                                     DIR => $Opt{tmpdir},
 440                                     CLEANUP => 1,
 441                                    ) or die $!;
 442     }
 443     require Sys::Hostname;
 444     my $hostname = Sys::Hostname::hostname();
 445     my @hostspecific;
 446     unless ($hostname eq "k83") {
 447         # -I ~/.cpan-k75 -MCPAN::MyConfig"
 448         @hostspecific =
 449             (
 450              "-I",
 451              "$ENV{HOME}/.cpan-$hostname",
 452              "-MCPAN::MyConfig",
 453             );
 454     }
 455     my @cpanshell =
 456         (
 457          "$prefix/bin/perl",
 458          @hostspecific,
 459          "-I$Opt{dotcpanhome}",
 460          "-M-lib='.'",
 461          "-MCPAN::MyConfig",
 462          "-MCPAN",
 463          $bdir ? ("-e","\$CPAN::Config->{build_dir}=q{$bdir};") : (),
 464          "-e",
 465         );
 466     $ENV{HARNESS_OPTIONS} = "j".$Opt{jobs} if $Opt{jobs} > 1;
 467     if ($Opt{report}) {
 468         my @script;
 469         my $opcfv = `$prefix/bin/perl -MCPAN::FTP -e print\\\$CPAN::FTP::VERSION;`;
 470         if (CPAN::Version->vlt($opcfv,"5.5009")) { # very kamikaze
 471             my $cwd = cwd;
 472             eval {
 473                 chdir "/home/sand/cpanpm";
 474                 mkpath "tmp-$$";
 475                 chdir  "tmp-$$";
 476                 0 == system git => "clone", "..", "."
 477                     or die "Could not clone cpanpm to tmp-$$";
 478                 #                             vvvvv kamikaze here vvvvv (no dependency resolution)
 479                 0 == system qq{$prefix/bin/perl Makefile.PL; $prefix/bin/perl -Ilib -MCPAN -e 'install(q(.))'}
 480                     or die "Could not run make install from /home/sand/cpanpm";
 481                 chdir "/home/sand/cpanpm";
 482                 rmtree "tmp-$$";
 483             } or warn "Error while trying to install CPAN from repo: $!";
 484             chdir $cwd;
 485         }
 486         my $opcv = `$prefix/bin/perl -MCPAN -e print\\\$CPAN::VERSION;`; # other perl cpan version
 487         if (CPAN::Version->vlt($opcv,"2.20")) {
 488             push @script, qq{install('ANDK/CPAN-2.20-TRIAL.tar.gz');
 489                 die unless
 490                     CPAN::Shell->expand(
 491                         Module=>"CPAN"
 492                     )->uptodate;
 493                 };
 494         }
 495         push @script, qq{install(
 496                   "CPAN::Meta::Requirements",
 497                   "Bundle::CPANxxl",
 498                   "Bundle::CPANReporter2",
 499                   "BSD::Resource",
 500                   "Log::ger",
 501                   "Log::ger::Output::File",
 502                   "Log::ger::Layout::Pattern",
 503                   "Term::Prompt",
 504                   # "Module::Info",
 505                   # "Devel::PatchPerl",
 506                   # "Module::Versions::Report",
 507                   # "V",
 508               );
 509               die unless
 510                   CPAN::Shell->expand(
 511                       Module=>"Test::Reporter::Transport::Metabase"
 512                   )->uptodate;
 513              };
 514         for my $script (@script) {
 515             my(@system) =
 516                 (@cpanshell,
 517                  $script,
 518                 );
 519             warn "DEBUG: system[@system]";
 520             unless (0==system @system) {
 521                 die "Alert: problem running system[@system]";
 522             }
 523         }
 524     }
 525     my $ret = 0;
 526     if ($m && @$m) {
 527         for (@$m) {
 528             s/-/::/g if /-/ and !m|/|;
 529         }
 530         my $install = join ",", map { "'$_'" } @$m;
 531         my $last = $m->[-1];
 532         my $shellcmd = "install($install); die unless CPAN::Shell->expand(Module => '$last')->uptodate;";
 533         if ($Opt{suppressreadline}) {
 534             $shellcmd = "\$CPAN::Suppress_readline=1;$shellcmd";
 535         }
 536         if (0==system @cpanshell, $shellcmd) {
 537             $ret = 0;
 538         } else {
 539             $ret = 1;
 540         }
 541         if ($inverse) {
 542             $ret ^= 1
 543         }
 544     }
 545     if (!$ret && $Opt{successchecker}) {
 546         if (0==system "$prefix/bin/perl", $Opt{successchecker}) {
 547             $ret = 0;
 548         } else {
 549             $ret = 1;
 550         }
 551     }
 552     exit $ret;
 553 }
 554 # Local Variables:
 555 # mode: cperl
 556 # cperl-indent-level: 4
 557 # End: