#! /usr/bin/perl use warnings; use strict; use Debbugs::Config qw(:globals); use Debbugs::Bugs qw(count_bugs); use Debbugs::CGI qw(html_escape); use Debbugs::Status qw(get_bug_status); # Derived from the 'summary' script in the debbugs package, via # ~ajt/bugscan. my $startdate = time; die "failed to get time: $!" unless defined $startdate; # check the ctime of '/org/bugs.debian.org/www/stats/oldbugs.html' use File::stat; my $ob = stat '/org/bugs.debian.org/www/stats/oldbugs.html'; if (defined $ob and (time - $ob->ctime) < 60*60*12) { # If less than 12 hours have passed since we last ran this file, # don't rebuild it. exit 0; } my %excludepackage = (); for (qw(bugs.debian.org ftp.debian.org lists.debian.org)) { $excludepackage{$_} = 1; } my (%oldpackage, %olddesc, %oldage); count_bugs(function => sub { my %d = @_; # Fast checks. return () if $d{status} eq 'done' or $d{severity} eq 'fixed' or $d{severity} eq 'wishlist'; my %tags = map { $_ => 1 } split ' ', $d{tags}; return () if $tags{fixed}; my $status = get_bug_status($d{bug}); my @merged = sort split ' ', $status->{mergedwith}; return () if @merged and $merged[0] < $d{bug}; # 3600*24*30 (30 days) my $cmonths = int(($startdate - length($status->{date})?$status->{date}:0) / 2592000); if ($cmonths >= 24 && !length($status->{forwarded}) && !$excludepackage{$d{pkg}}) { $oldpackage{$d{bug}} = $d{pkg}; $olddesc{$d{bug}} = (length($d{tags}) ? "$d{tags}/" : '') . $status->{subject}; $oldage{$d{bug}} = $cmonths; } }); my $date = `date`; chomp $date; my $nrbugs = keys %oldpackage; open OLDBUGS, '> /org/bugs.debian.org/www/stats/oldbugs.html.new' or die "can't open oldbugs.html.new: $!"; print OLDBUGS <Bugs Over Two Years Old

Bugs Over Two Years Old

Report date: $date
Number of bugs: $nrbugs

EOF # TODO: sort optimization would help a lot here while (%oldpackage) { my $firstpackage = $oldpackage{(sort { $a <=> $b } keys %oldpackage)[0]}; print OLDBUGS "

Package: $firstpackage
\n" or die "can't write to oldbugs.html.new: $!"; # TODO: maintainer # TODO: comments for (sort { $a <=> $b } keys %oldpackage) { if ($oldpackage{$_} eq $firstpackage) { printf OLDBUGS "%d %s
\n", $_, $_, html_escape($olddesc{$_}) or die "can't write to oldbugs.html.new: $!";; # TODO: comments delete $oldpackage{$_}; } } print OLDBUGS "\n"; } close OLDBUGS or die "can't close oldbugs.html.new: $!"; rename '/org/bugs.debian.org/www/stats/oldbugs.html.new', '/org/bugs.debian.org/www/stats/oldbugs.html' or die "can't rename oldbugs.html.new to oldbugs.html: $!";