make-britney-counts

   1 #!/usr/bin/perl
   2 # vim: ts=8 sw=8 nowrap
   3
   4 # Generate a report britney can use
   5
   6 use Getopt::Std;
   7 require scanlib;
   8 require bugcfg;
   9 use strict;
  10 # use warnings;
  11
  12 my $Version             = "make-britney-count 1.0\nCopyright (C) Steinar H. Gunderson <sesse\@debian.org>\n";
  13 my $statusfile          = "status";
  14
  15 sub ShowVersion() {
  16         print "$Version\n";
  17         exit 0;
  18 }
  19
  20 sub ShowUsage() {
  21         print <<EOF;
  22 Usage:
  23   $0 [-V] [-h] [-S file]
  24 Options:
  25   -V    show version
  26   -h    show this screen
  27   -S    use a different status file
  28 EOF
  29         exit 0;
  30 }
  31
  32 our ($opt_h,$opt_V,$opt_S);
  33
  34 getopts('VhS:');
  35 ShowUsage() if ($opt_h);
  36 ShowVersion() if ($opt_V);
  37 $statusfile = $opt_S if ($opt_S);
  38
  39 scanlib::readstatus($statusfile);
  40
  41 my %testingbugs = ();
  42 my %unstablebugs = ();
  43
  44 while (my ($nr, $bug) = each %scanlib::bugs) {
  45         for my $package (split /[,\s]+/, $bug->{'package'}) {
  46                 $package =~ y/A-Z/a-z/;
  47                 $package = $` if ($package =~ /[^-+._a-z0-9]/);
  48
  49                 if (scanlib::check_worry_unstable($bug)) {
  50                         push @{$unstablebugs{$package}}, $nr;
  51                 }
  52                 if (scanlib::check_worry($bug)) {
  53                         push @{$testingbugs{$package}}, $nr;
  54                 }
  55         }
  56 }
  57
  58 open TESTING, ">", "britney/testing.new"
  59         or die "britney/testing.new: $!";
  60 open TESTINGNR, ">", "britney/testing-nr.new"
  61         or die "britney/testing-nr.new: $!";
  62 for my $pkg (sort keys %testingbugs) {
  63         print TESTING   "$pkg ", scalar @{$testingbugs{$pkg}}, "\n";
  64         print TESTINGNR "$pkg ", join(',', @{$testingbugs{$pkg}}), "\n";
  65 }
  66 close TESTING;
  67 close TESTINGNR;
  68
  69 open UNSTABLE, ">", "britney/unstable.new"
  70         or die "britney/unstable.new: $!";
  71 open UNSTABLENR, ">", "britney/unstable-nr.new"
  72         or die "britney/unstable-nr.new: $!";
  73 for my $pkg (sort keys %unstablebugs) {
  74         print UNSTABLE   "$pkg ", scalar @{$unstablebugs{$pkg}}, "\n";
  75         print UNSTABLENR "$pkg ", join(',', @{$unstablebugs{$pkg}}), "\n";
  76 }
  77 close UNSTABLE;
  78 close UNSTABLENR;
  79
  80 rename "britney/testing.new", "britney/testing"
  81         or die "renaming britney/testing.new to britney/testing: $!";
  82 rename "britney/testing-nr.new", "britney/testing-nr"
  83         or die "renaming britney/testing-nr.new to britney/testing-nr: $!";
  84 rename "britney/unstable.new", "britney/unstable"
  85         or die "renaming britney/unstable.new to britney/unstable: $!";
  86 rename "britney/unstable-nr.new", "britney/unstable-nr"
  87         or die "renaming britney/unstable-nr.new to britney/unstable-nr: $!";
  88
  89 exit 0;
  90