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