Merge branch 'patch-1' into 'master'
[bugscan.git] / 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         or die "close britney/testing.new: $!";
72 close TESTINGNR
73         or die "close britney/testing-nr.new: $!";
74
75 open UNSTABLE, ">", "britney/unstable.new"
76         or die "britney/unstable.new: $!";
77 open UNSTABLENR, ">", "britney/unstable-nr.new"
78         or die "britney/unstable-nr.new: $!";
79 for my $pkg (sort keys %unstablebugs) {
80         print UNSTABLE   "$pkg ", scalar @{$unstablebugs{$pkg}}, "\n";
81         print UNSTABLENR "$pkg ", join(',', @{$unstablebugs{$pkg}}), "\n";
82 }
83 close UNSTABLE
84         or die "close britney/unstable.new: $!";
85 close UNSTABLENR
86         or die "close britney/unstable-nr.new: $!";
87
88 rename "britney/testing.new", "britney/testing"
89         or die "renaming britney/testing.new to britney/testing: $!";
90 rename "britney/testing-nr.new", "britney/testing-nr"
91         or die "renaming britney/testing-nr.new to britney/testing-nr: $!";
92 rename "britney/unstable.new", "britney/unstable"
93         or die "renaming britney/unstable.new to britney/unstable: $!";
94 rename "britney/unstable-nr.new", "britney/unstable-nr"
95         or die "renaming britney/unstable-nr.new to britney/unstable-nr: $!";
96
97 exit 0;
98