bin/generate-recent.pl

   1 #!/usr/bin/perl
   2
   3 # use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 =head1 NAME
   8
   9 generate-recent.pl -
  10
  11 =head1 SYNOPSIS
  12
  13  generate-recent.pl [OPTIONS]
  14
  15 =head1 OPTIONS
  16
  17 =over 8
  18
  19 =cut
  20
  21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  22
  23 =item B<--help|h!>
  24
  25 This help
  26
  27 =item B<--jobs|j=i>
  28
  29 Parameter to pass to 'makeperl.pl'. Defaults to 1 which is usually
  30 what we want. But in rare situations, when for example TEST produces a
  31 fail but harness produces a pass, this comes in handy.
  32
  33 Update 2017-12-11 akoenig: I do not understand what I wanted to say
  34 with that.
  35
  36 =item B<--keepfilesonerror!>
  37
  38 Do not do any cleanup on error, just bail out with an error.
  39
  40 =back
  41
  42 =head1 DESCRIPTION
  43
  44 Runs makeperl.pl in a loop. Stops when no patches have arrived.
  45
  46 The loop is to run installed-perls-overview and inspect the list from
  47 top to bottom. It is expected that the list is based on I<git
  48 describe> and sorted like the trunk. And when the current 'git
  49 describe' matches the first line, then we have nothing to do.
  50
  51 We set --jobs to 1 because at the moment we are much faster (>100
  52 times) than the smoker and sleep long times between invocations. If we
  53 were yet faster we would only waste both disk and CPU.
  54
  55 =cut
  56
  57
  58 use FindBin;
  59 use lib "$FindBin::Bin/../lib";
  60 BEGIN {
  61     push @INC, qw(       );
  62 }
  63
  64 use Dumpvalue;
  65 use File::Basename qw(dirname);
  66 use File::Path qw(mkpath);
  67 use File::Spec;
  68 use File::Temp;
  69 use Getopt::Long;
  70 use Hash::Util qw(lock_keys);
  71 use Pod::Usage;
  72
  73 our %Opt;
  74 lock_keys %Opt, map { /([^=!\|]+)/ } @opt;
  75 GetOptions(\%Opt,
  76            @opt,
  77           ) or pod2usage(1);
  78
  79 if ( $Opt{help} ) {
  80     pod2usage(0);
  81 }
  82 $Opt{jobs} //= 1;
  83
  84 use YAML::Syck;
  85 use POSIX;
  86 use Sys::Hostname ();
  87
  88 my @valid_debuggingoptions = (("EBUGGING=both")x1, ("EBUGGING=-g")x5, ("EBUGGING=none")x7);
  89
  90 my $waitabit = 0;
  91 LOOP: while () {
  92     if ( $waitabit > time ) {
  93         my $sleep = $waitabit - time;
  94         $sleep = 1 if $sleep < 1;
  95         sleep $sleep;
  96     } else {
  97         $waitabit = time +120; # arbitrary
  98     }
  99     open my $fh, "-|", $^X, "$FindBin::Bin/installed-perls-overview.pl", "--max=100", "--minperl=v5.15.7";
 100     my(@perls,%perls_seen);
 101  OVLINE: while (<$fh>) {
 102         my($perl) = split " ", $_, 2;
 103         my $hostname = Sys::Hostname::hostname;
 104         $hostname =~ s/\..*//;
 105         my $perl_or_host;
 106         if ($hostname eq "k83") {
 107             $perl_or_host = "perl";
 108         } else {
 109             $perl_or_host = "host/$hostname";
 110         }
 111         # Can't exec "/home/sand/src/perl/repoperls/installed-perls/perl/v5.23.7-35-g6002757/3bd2/bin/perl": No such...
 112         my $absperl = sprintf "/home/sand/src/perl/repoperls/installed-perls/%s/%s/bin/perl", $perl_or_host, $perl;
 113         open my $fh2, "-|", $absperl, "-V:useithreads|uselongdouble";
 114         my @stat = stat $absperl;
 115         my $mtime = POSIX::strftime "%FT%TZ", gmtime $stat[9];
 116         my %conf;
 117         while (<$fh2>) {
 118             my($k,$v) = /(\w+)='(\w*)';/;
 119             $conf{$k} = $v || 'undef';
 120         }
 121         next OVLINE if $perls_seen{join ",", @conf{qw(useithreads uselongdouble)}}++;
 122         push @perls, +{ perl => $perl, mtime => $mtime, %conf };
 123         last OVLINE if @perls >= 4;
 124     }
 125     warn YAML::Syck::Dump \@perls;
 126     my @system_git = (git => "pull");
 127     while () {
 128         last if 0 == system @system_git;
 129         warn sprintf "%s UTC: git poll has failed, sleeping 900 for the next retry\n", scalar gmtime;
 130         sleep 900; # arbitrary
 131     }
 132     my $describe = `git describe`;
 133     warn $describe;
 134     chomp $describe;
 135     if ($describe eq
 136         substr($perls[0]{perl},0,index($perls[0]{perl},"/"))) {
 137         my $sleep = 2700; # arbitrary
 138         my $eta = time+$sleep;
 139         local($|)=1;
 140         while () {
 141             my $left = $eta - time;
 142             last if $left < 0;
 143             printf "\r%d    ", $left;
 144             sleep 1;
 145         }
 146         print "\n";
 147         next LOOP;
 148     }
 149     my $ud;
 150     if (@perls >= 4) {
 151         $ud = sprintf "%s%s",
 152             uc(substr($perls[3]{useithreads}||qw(D U)[int rand 2], 0, 1)),
 153                 uc(substr($perls[3]{uselongdouble}||qw(D U)[int rand 2], 0, 1));
 154     } else {
 155         my %pickud = map { $_ => 1 } qw(UU UD DU DD);
 156         for my $p (@perls) {
 157             my $thisud = sprintf "%s%s",
 158             uc(substr($p->{useithreads}, 0, 1)),
 159                 uc(substr($p->{uselongdouble}, 0, 1));
 160             delete $pickud{$thisud};
 161         }
 162         $ud = (keys %pickud)[int rand scalar keys %pickud];
 163     }
 164     my $debuggingoption = $valid_debuggingoptions[int rand scalar @valid_debuggingoptions];
 165     my @system_mp =
 166         ($^X,
 167          $DB::VERSION ? ("-d") : (),
 168          "$FindBin::Bin/makeperl.pl",
 169          "--jobs=$Opt{jobs}",
 170          "--ud=$ud",
 171          "--report",
 172          "--debuggingoption=$debuggingoption",
 173          $Opt{keepfilesonerror} ? "--keepfilesonerror" : (),
 174         );
 175     warn YAML::Syck::Dump \@system_mp;
 176     sleep 3; # just so that the message can be seen
 177     0 == system @system_mp or die "Alert: problem running system[@system_mp]";
 178 }
 179
 180 # Local Variables:
 181 # mode: cperl
 182 # cperl-indent-level: 4
 183 # End: