examples/debian/postpa/20impbugs-versioned

   1 #! /usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use Debbugs::Config qw(:globals);
   6 use Debbugs::Status qw(splitpackages buggy);
   7 use Debbugs::Packages qw(getversions makesourceversions);
   8 use Debbugs::Bugs qw(count_bugs);
   9
  10 my %strong = map { $_ => 1 } @gStrongSeverities;
  11 my $pkgsrc = getpkgsrc();
  12 my $version_cache = {};
  13 # love my do nothing warn handler?
  14 $SIG{__WARN__} = sub {};
  15 for my $dist ('testing', 'unstable') {
  16   # no locking, so don't run this multiple times mmkay
  17   open IMPBUGS, "> /org/bugs.debian.org/www/stats/impbugs.$dist.txt.new"
  18     or die "can't open impbugs.$dist.txt.new: $!";
  19
  20   my @merged;
  21   my %impbugs = count_bugs(function => sub {
  22     my %d = @_;
  23
  24     # Fast checks.
  25     return () if $d{status} eq 'done' or not $strong{$d{severity}};
  26     my %tags = map { $_ => 1 } split ' ', $d{tags};
  27     return () if $tags{fixed} or $tags{'etch-ignore'};
  28     return () if (grep /^$d{bug}$/, @merged);
  29
  30     # Unfortunately mergedwith isn't indexed.
  31     my $status = getbugstatus($d{bug});
  32     push(@merged, split(' ', $status->{'mergedwith'}));
  33
  34     #set_option('dist', $dist);
  35     my %affected=();
  36
  37     foreach my $pkg (splitpackages($d{pkg})) {
  38         my @versions = getversions($pkg, $dist, 'source');
  39         if (defined $versions[0]) {
  40             if (not $pkgsrc->{$pkg} or $pkg eq $pkgsrc->{$pkg}) { # if it has source and is source-only, the makesourceversions fails ...
  41                @versions = map { "$pkg/$_" unless /^\//} @versions;
  42             } else {
  43                @versions = makesourceversions($pkg, 'source', @versions);
  44             }
  45         } else {
  46             @versions = getversions($pkg, $dist, 'i386');
  47             ## ^ buggy! fix me!
  48             @versions = makesourceversions($pkg, 'i386', @versions);
  49         }
  50         for my $version (@versions) {
  51            my $buggy = buggy(bug => $d{bug}, version => $version,
  52                              found => $status->{found_versions},
  53                              fixed => $status->{fixed_versions},
  54                              version_cache => $version_cache,
  55                              package => $pkg);
  56            if ($buggy eq 'found') {
  57                $affected{$pkg}=1;
  58                last;
  59            }
  60         }
  61     }
  62     return keys %affected;
  63   });
  64
  65   print "warnings/errors: $@" if $@;
  66   for my $pkg (reverse sort keys %impbugs) {
  67     print IMPBUGS "$pkg $impbugs{$pkg}\n" or die "can't write to impbugs.$dist.txt.new: $!";
  68   }
  69   close IMPBUGS or die "can't close impbugs.$dist.txt.new: $!";
  70   rename "/org/bugs.debian.org/www/stats/impbugs.$dist.txt.new", "/org/bugs.debian.org/www/stats/impbugs.$dist.txt"
  71     or die "can't rename impbugs.$dist.txt.new to impbugs.$dist.txt: $!";
  72 }