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