21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
25 Be prepared for interactivity without an end. Nothing will be cleaned
26 up without asking. See also --interative.
30 defaults to C</home/sand/var/ctr/done/archive/>
34 Only show reports for this distro. Exact distroname required
35 (like C<Imager-Graph-0.09>). E.g.:
37 smokehistory.pl --numversions=1 --verbose --filter Test-Simple-1.301001026
43 =item B<--interactive|i!>
45 Defaults to true. If set to false (--nointeractive or --noi), you can
46 remove hundreds of thousands of file without being asked a single
49 =item B<--delete-max=i>
51 Maximum number of files we want to see removed
53 =item B<--mixedtoyaml=s>
55 Writes a yaml file containing distros and reports where the reports
56 are mixed. That's because the next step will have to parse the reports
57 and may need a lot more focus and attention, so it makes sense to get
58 that stuff separated out.
60 =item B<--numversions=i>
62 Defaults to 2 which means look at the two most recent versions for
63 whatever we're doing. Everything older is discarded considered
68 Skip both NA and unknown reports.
72 write one line per report found
78 Walk through all reports we have generated and makes simple
79 statistics. Or remove old reports (with --cleanup) for the distros
80 that have got newer releases.
82 The initial version was only for cleanup and we called it like
85 sudo -u sand /path/to/perl bin/smokehistory.pl --numversions=3 --cleanup --noi
87 because we wanted to keep 3 versions and delete the older stuff and
88 sudo was needed because the files belong to sand.
90 The second usage was for finding BBC candidates. For that we wrote
91 smokehistoryfocus and combined
93 perl bin/smokehistory.pl --numversions=1 --mixedtoyaml=bin/smokehistory.pl.yml --skipna
97 perl bin/smokehistoryfocus.pl --bbc --skipanno --minperl 5.015004
99 numversions=1 drops all distros which are not the most recent release.
101 skipna only takes reports that are either pass or fail.
103 mixedtoyaml write those to a yaml file that promise some sort of mix
106 bbc picks those that had 100% OK in a previous period and went to less.
108 skipanno ignores the stuff we have in annotate.txt
112 linux hardcoded. If this shall be shared with non-linux results, reconsider.
122 use lib
"$FindBin::Bin/../lib";
128 use File
::Basename
qw(dirname);
129 use File
::Path
qw(mkpath);
134 use Hash
::Util
qw(lock_keys);
135 use List
::MoreUtils
qw(uniq);
136 use List
::Util
qw(first);
137 use Term
::Prompt
qw(prompt);
143 lock_keys
%Opt, map { /([^=!\|]+)/ } @opt;
150 $Opt{dir
} ||= "/home/sand/var/ctr/done/archive";
151 $Opt{interactive
} = 1 unless defined $Opt{interactive
};
152 $Opt{numversions
} ||= 2;
154 opendir my $dh, $Opt{dir
} or die;
155 my %S; # for the summary at the end
156 my $Y; # for the yaml option
157 my $tf = Text
::Format
->new(firstIndent
=>0);
158 my $total_deleted = 0;
160 LETTERDIR
: for my $dirent (sort readdir $dh) { # A B C
161 next LETTERDIR
unless $dirent =~ /^[A-Za-z]$/;
162 next LETTERDIR
if $Opt{filter
} && substr($Opt{filter
},0,1) ne $dirent;
163 opendir my $dh2, "$Opt{dir}/$dirent" or die;
164 DISTRO
: for my $dirent2 (readdir $dh2) { # FvwmPiazza CGI LWP-UserAgent-WithCache
165 next DISTRO
if $dirent2 =~ /^\.\.?$/;
166 next DISTRO
if $Opt{filter
} && substr($Opt{filter
},0,length($dirent2)) ne $dirent2;
167 # we get A-B here even if we asked for A-B-C-42
168 my $distro = $dirent2;
169 my $cldir = "$Opt{dir}/$dirent/$dirent2/";
170 opendir my $dh3, "$Opt{dir}/$dirent/$dirent2" or die;
174 REPORT
: for my $dirent3 (readdir $dh3) { # pass.FvwmPiazza-0.2002.x86_64-linux-thread-multi-ld.2.6.32-5-xen-amd64.1300583966.24270.rpt
175 next REPORT
if $dirent3 =~ /^\.\.?$/;
176 next REPORT
unless $dirent3 =~ /\.rpt$/;
177 my($result,$vdistro,$archname,$osversion,$time) =
178 $dirent3 =~ m
{(\w
+)\
. # pass
179 (\S
+)\
. # Dist-Zilla-4.300039
180 ([^\
.]+(?
:linux
|freebsd
)[^\
.]*)\
.
181 # i686-linux-thread-multi-64int-ld
182 (\d\S
+)\
. # 3.10-3-amd64
183 (\d
+\
.\d
+) # 1379556685.18399
186 die "could not parse '$dirent3' from directory '$dirent2' into its constituents" unless $vdistro;
187 # warn "vdistro[$vdistro]";
188 next REPORT
if $Opt{filter
} && $Opt{filter
} ne $vdistro;
189 if ($Opt{skipna
} && $result =~ /(unknown|na)/) {
194 my($ts) = POSIX
::strftime
("%FT%T", localtime $time);
195 my $file = "$Opt{dir}/$dirent/$dirent2/$dirent3";
196 open my $fh, $file or die;
200 if (/^\s+\$\^X\s*=\s*(.+)/){
202 } elsif (/config_args=.*-Dprefix=(\S+)/) {
203 # config_args='-Dprefix=/home/src/perl/repoperls/installed-perls/perl/v5.17.4-160-g599f1ac/a2da -Dmyhostname=k83 -Dinstallusrbinperl=n -Uversiononly -Dusedevel -des -Ui_db -Duseithreads -Duselongdouble -DDEBUGGING=-g'
206 if ($X and $X =~ m{installed-perls/(perl|host/[^/]+)/(.+)}) {
209 $perl =~ s
|/bin/perl
||;
210 if ($host eq "perl") {
218 unless (defined $perl) {
220 warn sprintf "Found no perl in %s\n", $file;
222 printf "%-6s %s %s%s\n", $result, $ts, $perl, $host ?
" ($host)" : "";
224 my $r = $report{$vdistro} ||= [];
226 $vdistro{$vdistro} = 1;
227 $result{$vdistro}{$result}++;
230 my @vdistro = keys %vdistro;
232 VDISTRO
: for my $vdistro (@vdistro) {
234 my @results = keys %{$result{$vdistro}};
237 # only one release tested, always same result
238 $S{one_release_boring
}++;
245 $type{$vdistro} = $type;
248 for my $vdistro (keys %type) {
249 my($distro,$version,$mod) = $vdistro =~ /(\S+)-(v?\d+(?:[\.\d]*[^-]*))(-(?:TRIAL|withoutworldwriteables|fix))?$/;
250 unless (defined $version) {
252 ($distro,$version) = $vdistro =~ /(\D+)(\d+)/;
254 unless (defined $version){
255 die "could not parse version from $vdistro";
257 $version=~s/[^\d\.]+$//;
258 1 while $version=~s/([\d\.])[^\d\.]+.*/$1/;
260 # print "DEBUG: parse version[$version] of distro[$distro](vdistro[$vdistro])\n";
261 my $numversion = eval {version
->new($version)->numify};
262 if (not defined $numversion) {
263 die "ERROR: Could not parse version[$version] of distro[$distro](vdistro[$vdistro]): $@";
265 die "Panic: we have a \$\@[$@] but a numversion[$numversion] too";
267 #if ($numversion==1) {
268 # warn "numversion[$numversion] version[$version] vdistro[$vdistro]";
271 $version{$vdistro} = $numversion;
273 #$DB::single = $distro eq "savelogs";
274 my @vdistros_sorted_by_version = sort { $version{$b} <=> $version{$a} } keys %type;
275 while (@vdistros_sorted_by_version > $Opt{numversions
}) {
277 my @cldirent = @
{$report{$vdistros_sorted_by_version[-1]}};
279 ("==> Having reports from
282 %s. The oldest of those,
284 %d reports. We could remove:\n\n",
285 scalar @vdistros_sorted_by_version,
288 $vdistros_sorted_by_version[-1],
291 print $tf->format($report);
292 warn map { "$_\n" } @cldirent;
293 $S{could_delete_reports
} += @
{$report{$vdistros_sorted_by_version[-1]}};
295 if ($Opt{interactive
}) {
296 $answer = lc prompt
"x", "Shall I delete? (y/n/q)", "", "y";
300 if ($answer eq "q") {
302 } elsif ($answer eq "n") {
303 } elsif ($answer eq "y") {
304 if ($Opt{"delete-max"}) {
305 my $will_delete = @cldirent;
306 if ($total_deleted + $will_delete > $Opt{"delete-max"}) {
307 die "Delete operation would delete $will_delete files, stopping now due delete-max option. Already deleted: $total_deleted\n";
310 my $deleted = unlink map { "$cldir$_" } @cldirent or die "Could not unlink: $!";
311 $total_deleted += $deleted;
312 if ($Opt{interactive
}) {
313 warn "Deleted $deleted reports. Press ENTER to continue\n";
318 my $pop = pop @vdistros_sorted_by_version;
322 my @types = uniq
values %type;
323 if (! first
{ $_ eq "mix" } @types){
324 $S{n_releases_boring
}++;
327 for my $vdistro (sort keys %type) {
328 my $type = $type{$vdistro};
329 printf "%-50s %s\n", $vdistro, $type;
330 if ($Opt{mixedtoyaml
}) {
331 $Y->{$vdistro} = [map { "$cldir$_" } @
{$report{$vdistro}}];
337 warn YAML
::Syck
::Dump \
%S;
338 if (my $file = $Opt{mixedtoyaml
}) {
339 YAML
::Syck
::DumpFile
$file, $Y;
340 warn "Wrote yaml to '$file'\n";
345 # cperl-indent-level: 4