bin/overview-metabase.pl

   1 #!/usr/bin/perl
   2
   3 # arguments can be package names: their versions are appended to each line, space separated
   4
   5 =head1 NAME
   6
   7 ....pl -
   8
   9 =head1 SYNOPSIS
  10
  11
  12
  13 =head1 OPTIONS
  14
  15 =over 8
  16
  17 =cut
  18
  19
  20 my $optpod = <<'=back';
  21
  22 =item B<--bbc!>
  23
  24 Only output the history of projects that seem to be BBCs. NOTE DANGER:
  25 demanding that 5.13 be among the testing perl versions. Option has a
  26 Verfallsdatum.
  27
  28 =item B<--help|h!>
  29
  30 This help
  31
  32 =back
  33
  34 =head1 DESCRIPTION
  35
  36 Read the local collection from the logfile from metabase, write one line per distro.
  37
  38 =head1 TODO
  39
  40
  41 =head1 AUTHOR
  42
  43 =cut
  44
  45 use strict;
  46 use Getopt::Long;
  47 use Pod::Usage qw(pod2usage);
  48
  49 use Sort::Versions;
  50 use YAML::Syck ();
  51 use Time::HiRes qw(sleep time);
  52
  53 my @opt = $optpod =~ /B<--(\S+)>/g;
  54 our %Opt;
  55 GetOptions
  56     (
  57      \%Opt,
  58      @opt,
  59     ) or pod2usage(1);
  60
  61 pod2usage(0) if $Opt{help};
  62
  63 my $storefile = "metabase-log.txt";
  64 chdir "/home/k/sources/CPAN/andk-cpan-tools" or die;
  65 open my $fh, $storefile or die;
  66 # [2010-10-29T21:05:10Z] [Chris Williams (BINGOS)] [pass] [RIZEN/Chat-Envolve-0.0100.tar.gz] [i386-dragonfly-64int] [perl-v5.10.0] [373b43ee-e3a0-11df-9e2d-9e9e6e8696e0] [2010-10-29T21:05:10Z]
  67 my @qr = (qr/\[([^\]]+)\]/) x 8;
  68 local $" = " ";
  69 my %H;
  70 my $line = 0;
  71 LINE: while (<$fh>) {
  72     my($date,$tester,$result,$path,$arch,$perl,$uuid,$ts) = my @f = /@qr/ or next;
  73     my $h = $H{$path}{history} ||= [];
  74     $H{$path}{intro} ||= ++$line;
  75     push @$h, {result => $result, ts => $ts, perl => $perl, tester => $tester};
  76 }
  77 my $boring = 0;
  78 HISTORY: for my $path (sort { $H{$a}{intro} <=> $H{$b}{intro} } keys %H) {
  79     my %S;
  80     for my $rec (@{$H{$path}{history}}) {
  81         my $result = $rec->{result};
  82         next if $result =~ /^(na|unknown)$/;
  83         $S{$result}++;
  84     }
  85     if (keys %S <= 1){
  86         $boring++;
  87         next HISTORY;
  88     }
  89     my $distroreport = "";
  90     $distroreport .= sprintf "%s:\n", $path;
  91
  92     my $seen_fail = 0;
  93     my $maybe_bbc = 1;
  94     my $seen_513 = 0;
  95     for my $rec (sort {versioncmp($a->{perl},$b->{perl}) || $b->{result} cmp $a->{result}} @{$H{$path}{history}}) {
  96         next if $rec->{result} =~ /^(na|unknown)$/;
  97         $distroreport .= sprintf "  %-15s %s    %s\n", @$rec{"perl","result","tester"};
  98         $seen_fail = 1 if $rec->{result} eq "fail";
  99         $maybe_bbc = 0 if $seen_fail && $rec->{result} eq "pass";
 100         $seen_513 = 1 if $rec->{perl} =~ /5\.13\./;
 101     }
 102     if ($Opt{bbc}) {
 103         if ($maybe_bbc && $seen_513) {
 104             print $distroreport;
 105         }
 106     } else {
 107         print $distroreport;
 108     }
 109     # , join(" ", map {$_->{result}} );
 110 }
 111 printf "(boring distros: %d)\n", $boring;
 112