bugscan now uses basename
[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 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                 # this hack is specific to britney counts, and ignores
50                 # bugs tagged ignore for the next testing release
51                 if (scanlib::check_worry_unstable($bug) and not $bug->{$bugcfg::debian_releases->{testing}.'-ignore'}) {
52                         push @{$unstablebugs{$package}}, $nr;
53                 }
54                 if (scanlib::check_worry($bug)) {
55                         push @{$testingbugs{$package}}, $nr;
56                 }
57         }
58 }
59
60 open TESTING, ">", "britney/testing.new"
61         or die "britney/testing.new: $!";
62 open TESTINGNR, ">", "britney/testing-nr.new"
63         or die "britney/testing-nr.new: $!";
64 for my $pkg (sort keys %testingbugs) {
65         print TESTING   "$pkg ", scalar @{$testingbugs{$pkg}}, "\n";
66         print TESTINGNR "$pkg ", join(',', @{$testingbugs{$pkg}}), "\n";
67 }
68 close TESTING;
69 close TESTINGNR;
70
71 open UNSTABLE, ">", "britney/unstable.new"
72         or die "britney/unstable.new: $!";
73 open UNSTABLENR, ">", "britney/unstable-nr.new"
74         or die "britney/unstable-nr.new: $!";
75 for my $pkg (sort keys %unstablebugs) {
76         print UNSTABLE   "$pkg ", scalar @{$unstablebugs{$pkg}}, "\n";
77         print UNSTABLENR "$pkg ", join(',', @{$unstablebugs{$pkg}}), "\n";
78 }
79 close UNSTABLE;
80 close UNSTABLENR;
81
82 rename "britney/testing.new", "britney/testing"
83         or die "renaming britney/testing.new to britney/testing: $!";
84 rename "britney/testing-nr.new", "britney/testing-nr"
85         or die "renaming britney/testing-nr.new to britney/testing-nr: $!";
86 rename "britney/unstable.new", "britney/unstable"
87         or die "renaming britney/unstable.new to britney/unstable: $!";
88 rename "britney/unstable-nr.new", "britney/unstable-nr"
89         or die "renaming britney/unstable-nr.new to britney/unstable-nr: $!";
90
91 exit 0;
92