bin/smokehistoryfocus.pl

   1 #!/usr/bin/perl
   2
   3 # use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 =head1 NAME
   8
   9
  10
  11 =head1 SYNOPSIS
  12
  13
  14
  15 =head1 OPTIONS
  16
  17 =over 8
  18
  19 =cut
  20
  21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  22
  23 =item B<--bbc!>
  24
  25 Only show potential BBCs; The algorithm for recognizing BBCs is that
  26 the oldest perl must have 100% success and from there we must face a
  27 decline. Problematic are cases where we have decline and improvements
  28 mixed in the middle. See also skipmiddle.
  29
  30 =item B<--help|h!>
  31
  32 This help
  33
  34 =item B<--matrixlink!>
  35
  36 Add a line to the output with the link to the matrix
  37
  38 =item B<--minperl=f>
  39
  40 Disregards all perls lower than that
  41
  42 =item B<--skipanno!>
  43
  44 Skip things that have a line in annotated.txt
  45
  46 =item B<--skipmiddle>
  47
  48 Only pay attention to the minimum perl and the maxium perl. Combined
  49 with bbc shows also bbc candidates that had some improvement between
  50 the oldest and newest release.
  51
  52 =item B<--skipbefore=s>
  53
  54 Defaults to C<2006>. If the relase of the distro was before this date
  55 (in iso format), then we do not display it in the list.
  56
  57 =back
  58
  59 =head1 DESCRIPTION
  60
  61 Reading a file written by smokehistory with contents such as
  62
  63   Spoon-0.24:
  64     - /home/sand/var/ctr/done/archive/S/Spoon/pass.Spoon-0.24.x86_64-linux-ld.2.6.32-5-amd64.1299821028.15026.rpt
  65     - /home/sand/var/ctr/done/archive/S/Spoon/pass.Spoon-0.24.x86_64-linux-thread-multi-ld.2.6.32-5-amd64.1295090374.3806.rpt
  66     - /home/sand/var/ctr/done/archive/S/Spoon/pass.Spoon-0.24.x86_64-linux-thread-multi.2.6.32-5-amd64.1302363043.25077.rpt
  67     - /home/sand/var/ctr/done/archive/S/Spoon/pass.Spoon-0.24.x86_64-linux-thread-multi-ld.2.6.32-5-amd64.1324424772.2901.rpt
  68
  69 which means nothing but report files per distro that already represent
  70 this filtered set: distro is the most recent one of that distroname
  71 (here: Spoon) and has mixed results.
  72
  73 Per default we just write summaries to STDOUT like this one:
  74
  75   (32) JJORE/Alien-Judy-0.26.tar.gz [20110120T014407Z]:
  76   5.015004     5:1
  77   5.015005     4:0
  78   5.015006     4:0
  79
  80 Since the default run spits out >1000 reports we often use the --bbc
  81 switch, often combined with --skipmiddle.
  82
  83 =head1 SEE ALSO
  84
  85 smokehistory.pl
  86
  87 =cut
  88
  89
  90 use FindBin;
  91 use lib "$FindBin::Bin/../lib";
  92 BEGIN {
  93     push @INC, qw(       );
  94 }
  95
  96 use Dumpvalue;
  97 use File::Basename qw(basename dirname);
  98 use File::Path qw(mkpath);
  99 use File::Spec;
 100 use File::Temp;
 101 use Getopt::Long;
 102 use Hash::Util qw(lock_keys);
 103 use YAML::Syck;
 104
 105 our %Opt;
 106 lock_keys %Opt, map { /([^=\!]+)/ } @opt;
 107 GetOptions(\%Opt,
 108            @opt,
 109           ) or pod2usage(1);
 110
 111 $Opt{skipbefore} ||= "2006";
 112
 113 my %anno;
 114 if ($Opt{skipanno}) {
 115     open my $fh, "annotate.txt" or die;
 116     while (<$fh>) {
 117         my($dist,$anno) = /^(\S+)\s+(.*)/;
 118         $anno{$dist} = $anno;
 119         $dist =~ s/_//g;
 120         $anno{$dist} = $anno; # prevent DCONWAY/List-Maker-0.003_000.tar.gz to appear
 121     }
 122 }
 123
 124 my $y = YAML::Syck::LoadFile "bin/smokehistory.pl.yml";
 125 my $i = 0;
 126 VDISTRO: for my $vdistro (sort keys %$y) { # ACME-Require-Require-v0.0.1
 127     if ($Opt{skipanno} and $anno{$vdistro}) {
 128         next VDISTRO;
 129     }
 130     my $reports = $y->{$vdistro};
 131     my %result;
 132     my $canondistro;
 133  REPORT: for my $r (@$reports) {
 134         my($result) = basename($r) =~ m{(\w+)};
 135         open my $fh, $r or die;
 136         my $v;
 137         while (<$fh>) {
 138             if (!$canondistro and /^X-Test-Reporter-Distfile:\s*(\S+)/) {
 139                 $canondistro = $1;
 140             } elsif (/^X-Test-Reporter-Perl:\s*(\S+)/) {
 141                 $v = version->new($1)->numify;
 142             }
 143             last if $canondistro && $v;
 144         }
 145         if ($Opt{minperl} && $v < $Opt{minperl}) {
 146             next REPORT;
 147         }
 148         $result{$v}{$result}++;
 149     }
 150     my $Lfail = 0;
 151     my $bbc;
 152     my @v = sort {$a<=>$b} keys %result;
 153     if ($Opt{skipmiddle}) {
 154         @v = @v[0,-1];
 155     }
 156     for my $vi (0..$#v) {
 157         my $v = $v[$vi] or next;
 158         my $results = $result{$v};
 159         for my $r (qw(pass fail)) {
 160             $results->{$r} ||= 0;
 161         }
 162         next unless $results->{fail} + $results->{pass} > 0;
 163         my $fail = $results->{fail} / ( $results->{fail} + $results->{pass} );
 164         if (!defined $bbc) {
 165             $bbc = $fail==0;
 166         }
 167         $bbc = 0 if $fail < $Lfail;
 168         $Lfail = $fail;
 169     }
 170     if ($Opt{bbc}){
 171         next VDISTRO if $Lfail < 1 || !$bbc;
 172     }
 173     my $isodate = isodate($canondistro);
 174     if (my $skb = $Opt{skipbefore}) {
 175         if ($isodate =~ /^\d/ and $skb gt $isodate) {
 176             next VDISTRO;
 177         }
 178     }
 179     $i++;
 180     printf "(%d) %s [%s]:\n", $i, $canondistro, $isodate;
 181     if ($Opt{matrixlink}) {
 182         printf "http://matrix.cpantesters.org/?dist=%s\n", $vdistro;
 183     }
 184     for my $v (@v) {
 185         my $results = $result{$v};
 186         printf "%-12s %s\n", $v, join(":",@{$results}{qw(pass fail)});
 187     }
 188 }
 189
 190 sub isodate {
 191     my($canondistro) = @_;
 192     my $path = sprintf "%s/%s/%s/%s", "/home/ftp/pub/PAUSE/authors/id",
 193         substr($canondistro,0,1),
 194             substr($canondistro,0,2),
 195                 $canondistro;
 196     my @stat = stat $path or return "N/A";
 197     my @date = gmtime $stat[9];
 198     $date[4]++;
 199     $date[5]+=1900;
 200     sprintf "%04d%02d%02dT%02d%02d%02dZ", @date[5,4,3,2,1,0];
 201 }
 202
 203 # Local Variables:
 204 # mode: cperl
 205 # cperl-indent-level: 4
 206 # End: