examples/debian/postpa/20impbugs

   1 #! /usr/bin/perl -w
   2
   3 use warnings;
   4 use strict;
   5
   6 use Debbugs::Config qw(:globals);
   7 use Debbugs::Common qw(splitpackages);
   8 use Debbugs::Status qw(get_bug_status);
   9 use Debbugs::Bugs qw(count_bugs);
  10
  11 my %strong = map { $_ => 1 } @gStrongSeverities;
  12
  13 my %impbugs = count_bugs(function => sub {
  14     my %d = @_;
  15
  16     # Fast checks.
  17     return () if $d{status} eq 'done' or not $strong{$d{severity}};
  18     my %tags = map { $_ => 1 } split ' ', $d{tags};
  19     return () if $tags{fixed} or $tags{'etch-ignore'};
  20     return () if ($tags{potato} or $tags{woody} or $tags{sarge} or $tags{etch} or $tags{experimental}) and not $tags{sid};
  21
  22     # Unfortunately mergedwith isn't indexed.
  23     my $status = get_bug_status(bug => $d{bug});
  24     my @merged = sort split ' ', $status->{mergedwith};
  25     return () if @merged and $merged[0] < $d{bug};
  26
  27     return splitpackages($d{pkg});
  28 });
  29
  30 open IMPBUGS, '> /org/bugs.debian.org/www/stats/impbugs.txt.new'
  31     or die "can't open impbugs.txt.new: $!";
  32 for my $pkg (reverse sort keys %impbugs) {
  33     print IMPBUGS "$pkg $impbugs{$pkg}\n" or die "can't write to impbugs.txt.new: $!";
  34 }
  35 close IMPBUGS or die "can't close impbugs.txt.new: $!";
  36 rename '/org/bugs.debian.org/www/stats/impbugs.txt.new', '/org/bugs.debian.org/www/stats/impbugs.txt'
  37     or die "can't rename impbugs.txt.new to impbugs.txt: $!";