bin/compare-smueller-smoke-with-annotate.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  $0 URL
  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<--state=s>
  28
  29 Defaults to 'annotated'. Possible values are C<annotated>,
  30 C<notannotated>, C<analysisized>
  31
  32 =back
  33
  34 =head1 DESCRIPTION
  35
  36 Shows the annotated/notannotated/analysisized distros in Steffen's list.
  37
  38 annotated is boring because we have done our work already
  39
  40 notannotated is has potential
  41
  42 analysisized has potential and has data at analysis
  43
  44 As primitive as it is we could first iterate through the analysisized
  45 ones and write tickets for them if possible. We could then take the
  46 notannotated ones and run some tests for them so that they end up in
  47 analysis.
  48
  49 To filter the analysisized to the pass->fail ones I use
  50
  51 % perl bin/compare-smueller-smoke-with-annotate.pl --state=analysisized 'http://users.perl5.git.perl.org/~tsee/carp_errmsg/'|perl -nale 'print if $F[0]=~/^\d/ && $F[1]eq"N" && $F[2]eq"pf"'
  52 2006-12-10         N pf http://analysis.cpantesters.org/solved?distv=CGI-Application-Plugin-CaptureIO-0.01
  53 2012-02-15         N pf http://analysis.cpantesters.org/solved?distv=CPS-0.13
  54 2008-07-17         N pf http://analysis.cpantesters.org/solved?distv=POE-Component-Server-SimpleXMLRPC-0.02
  55 2010-09-21         N pf http://analysis.cpantesters.org/solved?distv=Thread-Pool-0.33
  56
  57 The "pf" stands for pass->fail while the "N" stands for notannotated.
  58
  59 What can be done at any time without spending too much time is to run
  60 the notannotated ones through loop-over-recent without a glob.
  61
  62 I started to annotate those that I cannot grok, just so that they
  63 disappear from the list.
  64
  65 =cut
  66
  67
  68 use FindBin;
  69 use lib "$FindBin::Bin/../lib";
  70 BEGIN {
  71     push @INC, qw(       );
  72 }
  73
  74 use Dumpvalue;
  75 use File::Basename qw(dirname);
  76 use File::Path qw(mkpath);
  77 use File::Spec;
  78 use File::Temp;
  79 use Getopt::Long;
  80 use Hash::Util qw(lock_keys);
  81
  82 our %Opt;
  83 lock_keys %Opt, map { /([^=]+)/ } @opt;
  84 GetOptions(\%Opt,
  85            @opt,
  86           ) or pod2usage(1);
  87 $Opt{state} ||= "annotated";
  88 my $url = shift or pod2usage(1);
  89 use LWP::UserAgent;
  90 my $ua = LWP::UserAgent->new() or die;
  91 my $resp = $ua->get($url);
  92 my $content = $resp->content or die;
  93 my %smoked;
  94 my($s1,$s2);
  95 for (split /\n/, $content) {
  96     #   <td><a href="http://search.cpan.org/dist/Tie-RegexpHash-0.15">Tie-RegexpHash-0.15</a></td>
  97     #   <td><a href="http://search.cpan.org/dist/CGI-Application-Plugin-CaptureIO-0.01">CGI-Application-Plugin-CaptureIO-0.01</a></td>
  98     unless ($s1) {
  99         if (/class="grade (pass|na|fail|unknown)"/) {
 100             $s1 = substr($1,0,1);
 101             next;
 102         }
 103     }
 104     unless ($s2) {
 105         if (/class="grade (pass|na|fail|unknown)"/) {
 106             $s2 = substr($1,0,1);
 107             next;
 108         }
 109     }
 110     next unless m{http://search.cpan.org/dist/([^"']+)};
 111     $smoked{$1} = "$s1$s2";
 112     $s1 = $s2 = undef;
 113 }
 114 open my $fh, "annotate.txt" or die;
 115 my %anno;
 116 while (<$fh>) {
 117     my($dist,$anno) = /^(\S+)\s+(.*)/;
 118     next unless $smoked{$dist};
 119     $anno{$dist} = $anno;
 120     if ($Opt{state} eq "annotated") {
 121         if ($anno) {
 122             printf "anno: %-34s %s\n", $dist, $anno;
 123         }
 124     } elsif ($Opt{state} eq "analysisized") {
 125     } elsif ($Opt{state} eq "notannotated") {
 126     } else {
 127         die "Illegal state '$Opt{state}', cannot continue";
 128     }
 129 }
 130 if ($Opt{state} eq "notannotated") {
 131     for my $dist (sort keys %smoked) {
 132         if (!$anno{$dist}) {
 133             printf "notanno: %s http://matrix.cpantesters.org/?dist=%s\n", reldate($dist), $dist;
 134         }
 135     }
 136 } elsif ($Opt{state} eq "analysisized") {
 137     $|++;
 138     for my $dist (sort keys %smoked) {
 139         my $anaurl = sprintf "http://analysis.cpantesters.org/solved?distv=%s", $dist;
 140         my $resp = $ua->get($anaurl);
 141         my $content = $resp->content;
 142         my($state) = $content =~ /(No results|Release not found|Top Regressions|data were not sufficient)/;
 143         unless ($state) {
 144             warn "unknown state for dist[$dist]";
 145         }
 146         # "No results" has also "Distro-ID" and some more!
 147         if ($state eq "Top Regressions") {
 148             # <tr><td><b>Uploaded:</b></td><td>2007-12-12T01:48</td></tr>
 149             $state = $1 if $content =~ /Uploaded:.+?(\d\d\d\d-\d\d-\d\d)T\d\d:\d\d/;
 150         } else {
 151             $state =~ s/^(Release|data were)\s+//;
 152             $state =~ s/\s+/-/g;
 153         }
 154         printf "%-18s %s %s %s\n", $state, $anno{$dist}?"A":"N", $smoked{$dist}, $anaurl;
 155     }
 156 }
 157
 158 sub reldate {
 159     return "2000-01-01";
 160 }
 161
 162 # Local Variables:
 163 # mode: cperl
 164 # cperl-indent-level: 4
 165 # End: