13 generate-recent.pl [OPTIONS]
21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
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.
33 =item B<--keepfilesonerror!>
35 Do not do any cleanup on error, just bail out with an error.
41 Runs makeperl.pl in a loop. Stops when no patches have arrived.
43 The loop is to run installed-perls-overview and inspect the list from
44 top to bottom. It is expected that the list is based on I<git
45 describe> and sorted like the trunk. And when the current 'git
46 describe' matches the first line, then we have nothing to do.
48 We set --jobs to 1 because at the moment we are much faster (>100
49 times) than the smoker and sleep long times between invocations. If we
50 were yet faster we would only waste both disk and CPU.
56 use lib
"$FindBin::Bin/../lib";
62 use File
::Basename
qw(dirname);
63 use File
::Path
qw(mkpath);
67 use Hash
::Util
qw(lock_keys);
71 lock_keys
%Opt, map { /([^=!\|]+)/ } @opt;
85 my @valid_debuggingoptions = (("EBUGGING=both")x1
, ("EBUGGING=-g")x5
, ("EBUGGING=none")x7
);
89 if ( $waitabit > time ) {
90 my $sleep = $waitabit - time;
91 $sleep = 1 if $sleep < 1;
94 $waitabit = time +120; # arbitrary
96 open my $fh, "-|", $^X
, "$FindBin::Bin/installed-perls-overview.pl", "--max=100", "--minperl=v5.15.7";
97 my(@perls,%perls_seen);
98 OVLINE
: while (<$fh>) {
99 my($perl) = split " ", $_, 2;
100 my $hostname = Sys
::Hostname
::hostname
;
101 $hostname =~ s/\..*//;
103 if ($hostname eq "k83") {
104 $perl_or_host = "perl";
106 $perl_or_host = "host/$hostname";
108 # Can't exec "/home/sand/src/perl/repoperls/installed-perls/perl/v5.23.7-35-g6002757/3bd2/bin/perl": No such...
109 my $absperl = sprintf "/home/sand/src/perl/repoperls/installed-perls/%s/%s/bin/perl", $perl_or_host, $perl;
110 open my $fh2, "-|", $absperl, "-V:useithreads|uselongdouble";
111 my @stat = stat $absperl;
112 my $mtime = POSIX
::strftime
"%FT%TZ", gmtime $stat[9];
115 my($k,$v) = /(\w+)='(\w*)';/;
116 $conf{$k} = $v || 'undef';
118 next OVLINE
if $perls_seen{join ",", @conf{qw(useithreads uselongdouble)}}++;
119 push @perls, +{ perl
=> $perl, mtime
=> $mtime, %conf };
120 last OVLINE
if @perls >= 4;
122 warn YAML
::Syck
::Dump \
@perls;
123 my @system_git = (git
=> "pull");
125 last if 0 == system @system_git;
126 warn sprintf "%s UTC: git poll has failed, sleeping 900 for the next retry\n", scalar gmtime;
127 sleep 900; # arbitrary
129 my $describe = `git describe`;
133 substr($perls[0]{perl
},0,index($perls[0]{perl
},"/"))) {
134 my $sleep = 2700; # arbitrary
135 my $eta = time+$sleep;
138 my $left = $eta - time;
140 printf "\r%d ", $left;
148 $ud = sprintf "%s%s",
149 uc(substr($perls[3]{useithreads
}||qw(D U)[int rand 2], 0, 1)),
150 uc(substr($perls[3]{uselongdouble
}||qw(D U)[int rand 2], 0, 1));
152 my %pickud = map { $_ => 1 } qw(UU UD DU DD);
154 my $thisud = sprintf "%s%s",
155 uc(substr($p->{useithreads
}, 0, 1)),
156 uc(substr($p->{uselongdouble
}, 0, 1));
157 delete $pickud{$thisud};
159 $ud = (keys %pickud)[int rand scalar keys %pickud];
161 my $debuggingoption = $valid_debuggingoptions[int rand scalar @valid_debuggingoptions];
164 $DB::VERSION ?
("-d") : (),
165 "$FindBin::Bin/makeperl.pl",
169 "--debuggingoption=$debuggingoption",
170 $Opt{keepfilesonerror
} ?
"--keepfilesonerror" : (),
172 warn YAML
::Syck
::Dump \
@system_mp;
173 sleep 3; # just so that the message can be seen
174 0 == system @system_mp or die "Alert: problem running system[@system_mp]";
179 # cperl-indent-level: 4