1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
#! /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: $!";
binmode(OLDBUGS,':encoding(UTF-8)');
print OLDBUGS <<EOF or die "can't write to oldbugs.html.new: $!";
<html><head><title>Bugs Over Two Years Old</title></head>
<body>
<h1>Bugs Over Two Years Old</h1>
<p>Report date: $date<br>
Number of bugs: $nrbugs
</p>
EOF
# TODO: sort optimization would help a lot here
while (%oldpackage) {
my $firstpackage = $oldpackage{(sort { $a <=> $b } keys %oldpackage)[0]};
print OLDBUGS "<p>Package: <a href=\"http://bugs.debian.org/$firstpackage\">$firstpackage</a><br>\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 "<a href=\"http://bugs.debian.org/%d\">%d</a> %s<br>\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: $!";
|
