bin/wanna-build-statistics

   1 #!/usr/bin/perl
   2 #
   3 # wanna-build-statistics: print statistics for wanna-build databases
   4 # Copyright (C) 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
   5 #
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License as
   8 # published by the Free Software Foundation; either version 2 of the
   9 # License, or (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 # General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19 #
  20 # $Id: wanna-build-statistics 43 2005-06-01 09:28:43Z rmurray $
  21 #
  22 # $Log: wanna-build-statistics,v $
  23 # Revision 1.4  2000/10/19 09:15:37  rnhodek
  24 # percent: handle $total == 0 case.
  25 #
  26 # Revision 1.3  1999/01/13 09:57:17  rnhodek
  27 # If wanna-build returns error status, also print last message from it.
  28 #
  29 # Revision 1.2  1998/12/16 10:51:34  rnhodek
  30 # Print nothing at all if wanna-build says that the db doesn't exist.
  31 # Remove debugging stuff.
  32 #
  33 # Revision 1.1  1998/12/16 10:29:09  rnhodek
  34 # Initial writing.
  35 #
  36
  37 use strict;
  38 use vars qw($verbose $dist $database);
  39
  40 $verbose = 0;
  41 $dist = "unstable";
  42 $database = "build-db";
  43
  44 while( @ARGV && $ARGV[0] =~ /^-/ ) {
  45         $_ = shift @ARGV;
  46         if (/^-v$/ || /^--verbose$/) {
  47                 $verbose++;
  48         }
  49         elsif (/^-d/ || /^--dist/) {
  50                 if (/^-d(.)/ || /^--dist=(.)/) {
  51                         $dist = $1.$';
  52                 }
  53                 elsif (!@ARGV) {
  54                         die "$_ option missing argument\n";
  55                 }
  56                 else {
  57                         $dist = shift @ARGV;
  58                 }
  59                 $dist = "oldstable"   if $dist eq "o";
  60                 $dist = "stable"   if $dist eq "s";
  61                 $dist = "testing"  if $dist eq "t";
  62                 $dist = "unstable" if $dist eq "u";
  63                 die "Bad distribution\n" if !isin($dist, qw(stable testing unstable stable-security testing-security oldstable oldstable-security));
  64         }
  65         elsif (/^--$/) {
  66                 last;
  67         }
  68         elsif (/^--database=(.*)$/) {
  69                 $database = $1;
  70         }
  71         else {
  72                 die "Unknown option: $_\n";
  73         }
  74 }
  75
  76 my($lastmsg, %n_state, $total, %n_builder);
  77 open( PIPE, "wanna-build --database=$database --dist=$dist --list=all 2>&1 |" )
  78         or die "Cannot spawn wanna-build: $!\n";
  79 while( <PIPE> ) {
  80         if (/^Database for $dist doesn't exist$/) {
  81                 exit 1;
  82         }
  83         elsif (/^Total (\d+) package\(s\) in state (\S+)\.$/) {
  84                 $n_state{$2} = $1;
  85         }
  86         elsif (/^Total (\d+) package\(s\)$/) {
  87                 $total = $1;
  88         }
  89         elsif (/^\S+: (\S+) by (\S+)/) {
  90                 $n_builder{$1}->{$2}++;
  91         }
  92         $lastmsg = $_;
  93 }
  94 close( PIPE );
  95 if ($?) {
  96         print "$lastmsg";
  97         die "Bad exit status $? from wanna-build\n";
  98 }
  99
 100 print "Distribution $dist:\n";
 101 print "--------------", "-" x length($dist), "\n";
 102
 103 my $total_width = 78;
 104 my @state_list = qw(Installed Needs-Build Building Built Build-Attempted Uploaded Failed Dep-Wait
 105                                         Failed-Removed Dep-Wait-Removed BD-Uninstallable
 106                                         Not-For-Us);
 107 my $statewidth = 0;
 108 grep { $statewidth = length($_) if length($_) > $statewidth } @state_list;
 109 my $startcol = $statewidth + 9;
 110
 111 my($state, $builder);
 112 foreach $state (@state_list) {
 113         printf "%-${statewidth}s: %5d", $state, $n_state{$state};
 114         if (!keys %{$n_builder{$state}}) {
 115                 print "\n";
 116                 next;
 117         }
 118         my $sum = 0;
 119         foreach $builder (keys %{$n_builder{$state}}) {
 120                 $sum += $n_builder{$state}->{$builder};
 121         }
 122         $n_builder{$state}->{"unknown"} = $n_state{$state} - $sum;
 123         print " (";
 124         my $is_first = 1;
 125         my $pos = $startcol;
 126         foreach $builder (sort keys %{$n_builder{$state}}) {
 127                 next if !$n_builder{$state}->{$builder};
 128                 my $str = "$builder: $n_builder{$state}->{$builder}";
 129                 $str = ", $str" if !$is_first;
 130                 $is_first = 0;
 131                 if ($pos + length($str) > $total_width) {
 132                         print ",\n", " " x $startcol;
 133                         $pos = $startcol;
 134                         $str =~ s/^, //;
 135                 }
 136                 print $str;
 137                 $pos += length($str);
 138         }
 139         print ")\n";
 140 }
 141 printf "%-${statewidth}s: %5d\n", "total", $total;
 142 print "\n";
 143
 144 $total -= $n_state{"Not-For-Us"};
 145 print percent(qw(Installed)), " up-to-date, ";
 146 print percent(qw(Installed Uploaded)), " if also counting uploaded pkgs\n";
 147 print percent(qw(Built Installed Uploaded)), " if also counting built pkgs\n";
 148 print percent(qw(Needs-Build)), " uncompiled\n";
 149 print percent(qw(Building)), " currently building (short-term delay)\n";
 150 print percent(qw(Build-Attempted)), " currently failed building (short-term delay)\n";
 151 print percent(qw(Failed BD-Uninstallable Dep-Wait)), " failed or waiting (long-term delay)\n";
 152
 153 exit 0;
 154
 155 sub percent {
 156         my $n = 0;
 157         foreach (@_) {
 158                 $n += $n_state{$_};
 159         }
 160
 161         return sprintf "%6.2f%%", $n*100/$total if $total;
 162         return sprintf "%6.2f%%", 0;
 163 }
 164
 165 sub isin {
 166         my $val = shift;
 167         return grep( $_ eq $val, @_ );
 168 }