From: Don Armstrong <don@volo>
Date: Sat, 18 Nov 2006 09:20:24 +0000 (-0800)
Subject: * Add versioning archival/removal support to the configuration file
X-Git-Tag: release/2.6.0~585^2^2~67
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=324369ad0c974793b3addc064856f63f637fdbd2;p=debbugs.git
* Add versioning archival/removal support to the configuration file
* Write out the bug_archiveable function
* Move the private functions to the bottom of Debbugs::Status where
they belong
* Call bug_archiveable from pkgreport.cgi for display of the current
archival status.
---
diff --git a/Debbugs/Config.pm b/Debbugs/Config.pm
index fe845f52..f31253ec 100644
--- a/Debbugs/Config.pm
+++ b/Debbugs/Config.pm
@@ -261,15 +261,59 @@ set_default(\%config, 'mirror_list', 'bug-mirror-list');
=head2 Misc Options
+=over
+
=cut
set_default(\%config,'mailer','exim');
set_default(\%config,'bug','bug');
set_default(\%config,'bugs','bugs');
+
+=item remove_age
+
+Age at which bugs are archived/removed
+
+Default: 28
+
+=cut
+
set_default(\%config,'remove_age',28);
+=item save_old_bugs
+
+Whether old bugs are saved or deleted
+
+Default: 1
+
+=cut
+
set_default(\%config,'save_old_bugs',1);
+=item removal_distribution_tags
+
+Tags which specifiy distributions to check
+
+Default: qw(experimental unstable testing stable oldstable);
+
+=cut
+
+set_default(\%config,'removal_distribution_tags',
+ [qw(experimental unstable testing stable oldstable)]);
+
+=item removal_default_distribution_tags
+
+For removal/archival purposes, all bugs are assumed to have these tags
+set.
+
+Default: qw(unstable testing);
+
+=cut
+
+set_default(\%config,'removal_default_distribution_tags',
+ [qw(unstable testing)]
+ );
+
+
set_default(\%config,'default_severity','normal');
set_default(\%config,'show_severities','critical, grave, normal, minor, wishlist');
set_default(\%config,'strong_severities',[qw(critical grave)]);
@@ -300,6 +344,9 @@ set_default(\%config,'package_source',$config{config_dir}.'/indices/sources');
set_default(\%config,'version_packages_dir',$config{spool_dir}.'/../versions/pkg');
#set_default(\%config,'version_packages_dir',$config{spool_dir}'/../versions/pkg');
+=back
+
+
=head2 Text Fields
The following are the only text fields in general use in the scripts;
diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm
index 6c555c76..58a7e65a 100644
--- a/Debbugs/Status.pm
+++ b/Debbugs/Status.pm
@@ -34,6 +34,7 @@ use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
use Debbugs::Packages qw(makesourceversions getversions);
use Debbugs::Versions;
use Debbugs::Versions::Dpkg;
+use POSIX qw(ceil);
BEGIN{
@@ -41,7 +42,7 @@ BEGIN{
$DEBUG = 0 unless defined $DEBUG;
@EXPORT = ();
- %EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy)],
+ %EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy bug_archiveable)],
read => [qw(readbug read_bug lockreadbug)],
write => [qw(writebug makestatus unlockwritebug)],
versions => [qw(addfoundversion addfixedversion),
@@ -495,15 +496,15 @@ sub splitpackages {
=head2 bug_archiveable
- bug_archiveable(ref => $bug_num);
+ bug_archiveable(bug => $bug_num);
Options
=over
-=item ref -- bug number (required)
+=item bug -- bug number (required)
-=item status -- Status hashref (optional)
+=item status -- Status hashref returned by read_bug or get_bug_status (optional)
=item version -- Debbugs::Version information (optional)
@@ -515,13 +516,18 @@ Returns 1 if the bug can be archived
Returns 0 if the bug cannot be archived
If days_until is true, returns the number of days until the bug can be
-archived, -1 if it cannot be archived.
+archived, -1 if it cannot be archived. 0 means that the bug can be
+archived the next time the archiver runs.
+
+Returns undef on failure.
=cut
+# This will eventually need to be fixed before we start using mod_perl
+my $version_cache = {};
sub bug_archiveable{
my %param = validate_with(params => \@_,
- spec => {ref => {type => SCALAR,
+ spec => {bug => {type => SCALAR,
regex => qr/^\d+$/,
},
status => {type => HASHREF,
@@ -535,95 +541,76 @@ sub bug_archiveable{
},
},
);
+ # This is what we return if the bug cannot be archived.
+ my $cannot_archive = $param{days_until}?-1:0;
# read the status information
- # read the version information
+ my $status = $param{status};
+ if (not exists $param{status} or not defined $status) {
+ $status = read_bug(bug=>$param{bug});
+ return undef if not defined $status;
+ }
# Bugs can be archived if they are
# 1. Closed
- # 2. Fixed in unstable if tagged unstable
- # 3. Fixed in stable if tagged stable
- # 4. Fixed in testing if tagged testing
- # 5. Fixed in experimental if tagged experimental
- # 6. at least 28 days have passed since the last action has occured or the bug was closed
-}
-
-=head1 PRIVATE FUNCTIONS
-
-=cut
-
-sub update_realtime {
- my ($file, $bug, $new) = @_;
-
- # update realtime index.db
-
- open(IDXDB, "<$file") or die "Couldn't open $file";
- open(IDXNEW, ">$file.new");
-
- my $line;
- my @line;
- while($line = <IDXDB>) {
- @line = split /\s/, $line;
- last if ($line[1] >= $bug);
- print IDXNEW $line;
- $line = "";
- }
-
- if ($new eq "NOCHANGE") {
- print IDXNEW $line if ($line ne "" && $line[1] == $bug);
- } elsif ($new eq "REMOVE") {
- 0;
- } else {
- print IDXNEW $new;
- }
- if ($line ne "" && $line[1] > $bug) {
- print IDXNEW $line;
- $line = "";
- }
-
- print IDXNEW while(<IDXDB>);
-
- close(IDXNEW);
- close(IDXDB);
-
- rename("$file.new", $file);
-
- return $line;
-}
-
-sub bughook_archive {
- my $ref = shift;
- &filelock("debbugs.trace.lock");
- &appendfile("debbugs.trace","archive $ref\n");
- my $line = update_realtime(
- "$config{spool_dir}/index.db.realtime",
- $ref,
- "REMOVE");
- update_realtime("$config{spool_dir}/index.archive.realtime",
- $ref, $line);
- &unfilelock;
-}
-
-sub bughook {
- my ( $type, $ref, $data ) = @_;
- &filelock("debbugs.trace.lock");
-
- &appendfile("debbugs.trace","$type $ref\n",makestatus($data, 1));
-
- my $whendone = "open";
- my $severity = $config{default_severity};
- (my $pkglist = $data->{package}) =~ s/[,\s]+/,/g;
- $pkglist =~ s/^,+//;
- $pkglist =~ s/,+$//;
- $whendone = "forwarded" if length $data->{forwarded};
- $whendone = "done" if length $data->{done};
- $severity = $data->{severity} if length $data->{severity};
-
- my $k = sprintf "%s %d %d %s [%s] %s %s\n",
- $pkglist, $ref, $data->{date}, $whendone,
- $data->{originator}, $severity, $data->{keywords};
-
- update_realtime("$config{spool_dir}/index.db.realtime", $ref, $k);
+ return $cannot_archive if not defined $status->{done} or not length $status->{done};
+ # If we just are checking if the bug can be archived, we'll not even bother
+ # checking the versioning information if the bug has been -done for less than 28 days.
+ if (not $param{days_until} and $config{remove_age} >
+ -M getbugcomponent($param{ref},'log')
+ ) {
+ return $cannot_archive;
+ }
+ # At this point, we have to get the versioning information for this bug.
+
+ # We examine the set of distribution tags. If a bug has no distribution
+ # tags set, we assume a default set, otherwise we use the tags the bug
+ # has set.
+ my %dist_tags;
+ @dist_tags{@{$config{removal_distribution_tags}}} =
+ (1) x @{$config{removal_distribution_tags}};
+ my %dists;
+ @dists{@{$config{removal_default_distribution_tags}}} =
+ (1) x @{$config{removal_default_distribution_tags}};
+ for my $tag (split ' ', $status->{tags}) {
+ next unless $dist_tags{$tag};
+ $dists{$tag} = 1;
+ }
+ my %source_versions;
+ for my $dist (keys %dists){
+ my @versions;
+ if (defined $param{version}) {
+ @versions = ($param{version});
+ } elsif (defined $param{dist}) {
+ @versions = getversions($status->{package},
+ $dist,
+ undef);
+ }
- &unfilelock;
+ # TODO: This should probably be handled further out for efficiency and
+ # for more ease of distinguishing between pkg= and src= queries.
+ my @sourceversions = makesourceversions($status->{package},
+ $dist,
+ @versions);
+ @source_versions{@sourceversions} = (1) x @sourceversions;
+ }
+ if ('found' eq max_buggy(bug => $param{bug},
+ sourceversions => [keys %source_versions],
+ found => $status->{found_versions},
+ fixed => $status->{fixed_versions},
+ version_cache => $version_cache,
+ package => $status->{package},
+ )) {
+ return $cannot_archive;
+ }
+ # 6. at least 28 days have passed since the last action has occured or the bug was closed
+ # XXX We still need some more work here before we actually can archive;
+ # we really need to track when a bug was closed in a version.
+ my $age = ceil($config{remove_age} - -M getbugcomponent($param{bug},'log'));
+ if ($age > 0 ) {
+ return $param{days_until}?$age:0;
+ }
+ else {
+ return $param{days_until}?0:1;
+ }
}
@@ -664,8 +651,6 @@ changed before using this function in long lived programs.
=cut
-# This will eventually need to be fixed before we start using mod_perl
-my $version_cache = {};
sub get_bug_status {
if (@_ == 1) {
unshift @_, 'bug';
@@ -751,33 +736,21 @@ sub get_bug_status {
else {
@sourceversions = @{$param{sourceversions}};
}
-
if (@sourceversions) {
- # Resolve bugginess states (we might be looking at multiple
- # architectures, say). Found wins, then fixed, then absent.
- my $maxbuggy = 'absent';
- for my $version (@sourceversions) {
- my $buggy = buggy(bug => $param{bug},
- version => $version,
- found => $status{found_versions},
- fixed => $status{fixed_versions},
- version_cache => $version_cache,
- package => $status{package},
- );
- if ($buggy eq 'found') {
- $maxbuggy = 'found';
- last;
- } elsif ($buggy eq 'fixed' and $maxbuggy ne 'found') {
- $maxbuggy = 'fixed';
- }
- }
+ my $maxbuggy = max_buggy(bug => $param{bug},
+ sourceversions => \@sourceversions,
+ found => $status{found_versions},
+ fixed => $status{fixed_versions}.
+ package => $status{package},
+ version_cache => $version_cache,
+ );
if ($maxbuggy eq 'absent') {
- $status{"pending"} = 'absent';
- } elsif ($maxbuggy eq 'fixed') {
- $status{"pending"} = 'done';
+ $status{pending} = 'absent';
+ }
+ elsif ($maxbuggy eq 'fixed' ) {
+ $status{pending} = 'done';
}
}
-
if (length($status{done}) and
(not @sourceversions or not @{$status{fixed_versions}})) {
$status{"pending"} = 'done';
@@ -786,6 +759,70 @@ sub get_bug_status {
return \%status;
}
+
+=head2 max_buggy
+
+ max_buggy()
+
+=head3 Options
+
+=over
+
+=item bug -- scalar bug number
+
+=item sourceversion -- optional arrayref of source/version; overrides
+dist, arch, and version. [The entries in this array must be in the
+"source/version" format.] Eventually this can be used to for caching.
+
+=back
+
+Note: Currently the version information is cached; this needs to be
+changed before using this function in long lived programs.
+
+
+=cut
+sub max_buggy{
+ my %param = validate_with(params => \@_,
+ spec => {bug => {type => SCALAR,
+ regex => qr/^\d+$/,
+ },
+ sourceversions => {type => ARRAYREF,
+ default => [],
+ },
+ found => {type => ARRAYREF,
+ default => [],
+ },
+ fixed => {type => ARRAYREF,
+ default => [],
+ },
+ package => {type => SCALAR,
+ },
+ version_cache => {type => HASHREF,
+ default => {},
+ },
+ },
+ );
+ # Resolve bugginess states (we might be looking at multiple
+ # architectures, say). Found wins, then fixed, then absent.
+ my $maxbuggy = 'absent';
+ for my $version (@{$param{sourceversions}}) {
+ my $buggy = buggy(bug => $param{bug},
+ version => $version,
+ found => $param{found},
+ fixed => $param{fixed},
+ version_cache => $param{version_cache},
+ package => $param{package},
+ );
+ if ($buggy eq 'found') {
+ return 'found';
+ } elsif ($buggy eq 'fixed') {
+ $maxbuggy = 'fixed';
+ }
+ }
+ return $maxbuggy;
+}
+
+
=head2 buggy
buggy(bug => nnn,
@@ -865,6 +902,86 @@ sub buggy {
return $version->buggy($param{version},\@found,\@fixed);
}
+=head1 PRIVATE FUNCTIONS
+
+=cut
+
+sub update_realtime {
+ my ($file, $bug, $new) = @_;
+
+ # update realtime index.db
+
+ open(IDXDB, "<$file") or die "Couldn't open $file";
+ open(IDXNEW, ">$file.new");
+
+ my $line;
+ my @line;
+ while($line = <IDXDB>) {
+ @line = split /\s/, $line;
+ last if ($line[1] >= $bug);
+ print IDXNEW $line;
+ $line = "";
+ }
+
+ if ($new eq "NOCHANGE") {
+ print IDXNEW $line if ($line ne "" && $line[1] == $bug);
+ } elsif ($new eq "REMOVE") {
+ 0;
+ } else {
+ print IDXNEW $new;
+ }
+ if ($line ne "" && $line[1] > $bug) {
+ print IDXNEW $line;
+ $line = "";
+ }
+
+ print IDXNEW while(<IDXDB>);
+
+ close(IDXNEW);
+ close(IDXDB);
+
+ rename("$file.new", $file);
+
+ return $line;
+}
+
+sub bughook_archive {
+ my $ref = shift;
+ &filelock("debbugs.trace.lock");
+ &appendfile("debbugs.trace","archive $ref\n");
+ my $line = update_realtime(
+ "$config{spool_dir}/index.db.realtime",
+ $ref,
+ "REMOVE");
+ update_realtime("$config{spool_dir}/index.archive.realtime",
+ $ref, $line);
+ &unfilelock;
+}
+
+sub bughook {
+ my ( $type, $ref, $data ) = @_;
+ &filelock("debbugs.trace.lock");
+
+ &appendfile("debbugs.trace","$type $ref\n",makestatus($data, 1));
+
+ my $whendone = "open";
+ my $severity = $config{default_severity};
+ (my $pkglist = $data->{package}) =~ s/[,\s]+/,/g;
+ $pkglist =~ s/^,+//;
+ $pkglist =~ s/,+$//;
+ $whendone = "forwarded" if length $data->{forwarded};
+ $whendone = "done" if length $data->{done};
+ $severity = $data->{severity} if length $data->{severity};
+
+ my $k = sprintf "%s %d %d %s [%s] %s %s\n",
+ $pkglist, $ref, $data->{date}, $whendone,
+ $data->{originator}, $severity, $data->{keywords};
+
+ update_realtime("$config{spool_dir}/index.db.realtime", $ref, $k);
+
+ &unfilelock;
+}
+
1;
diff --git a/cgi/pkgreport.cgi b/cgi/pkgreport.cgi
index 4ae9efbf..1bf969fe 100755
--- a/cgi/pkgreport.cgi
+++ b/cgi/pkgreport.cgi
@@ -640,16 +640,15 @@ sub pkg_htmlindexentrystatus {
$result .= buglinklist(";\nBlocks ", ", ",
split(/ /,$status{blocks}));
- my $days = 0;
if (length($status{done})) {
$result .= "<br><strong>Done:</strong> " . htmlsanit($status{done});
-# Disabled until archiving actually works again
-# $days = ceil($gRemoveAge - -M buglog($status{id}));
-# if ($days >= 0) {
-# $result .= ";\n<strong>Will be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "</strong>";
-# } else {
-# $result .= ";\n<strong>Archived</strong>";
-# }
+ my $days = bug_archiveable(bug => $status{id},
+ status => \%status,
+ days_until => 1,
+ );
+ if ($days >= 0) {
+ $result .= ";\n<strong>Will be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "</strong>";
+ }
}
unless (length($status{done})) {