+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
package Debbugs::Status;
use base qw(Exporter);
use Params::Validate qw(validate_with :types);
-use Debbugs::Common qw(:util :lock :quit);
+use Debbugs::Common qw(:util :lock :quit :misc);
use Debbugs::Config qw(:config);
use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
-use Debbugs::Packages qw(makesourceversions getversions);
+use Debbugs::Packages qw(makesourceversions getversions get_versions binarytosource);
use Debbugs::Versions;
use Debbugs::Versions::Dpkg;
use POSIX qw(ceil);
+use List::Util qw(min max);
+
BEGIN{
$VERSION = 1.00;
@EXPORT = ();
%EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy bug_archiveable),
- qw(isstrongseverity),
+ qw(isstrongseverity bug_presence),
],
- read => [qw(readbug read_bug lockreadbug)],
+ read => [qw(readbug read_bug lockreadbug lockreadbugmerge)],
write => [qw(writebug makestatus unlockwritebug)],
versions => [qw(addfoundversions addfixedversions),
- qw(removefoundversions)
+ qw(removefoundversions removefixedversions)
],
+ hook => [qw(bughook bughook_archive)],
);
@EXPORT_OK = ();
- Exporter::export_ok_tags(qw(status read write versions));
+ Exporter::export_ok_tags(qw(status read write versions hook));
$EXPORT_TAGS{all} = [@EXPORT_OK];
}
fixed_date => 'fixed-date',
blocks => 'blocks',
blockedby => 'blocked-by',
+ unarchived => 'unarchived',
);
# Fields which need to be RFC1522-decoded in format versions earlier than 3.
my %param = validate_with(params => \@_,
spec => {bug => {type => SCALAR,
optional => 1,
- regex => qr/^\d+/,
+ # something really
+ # stupid passes
+ # negative bugnumbers
+ regex => qr/^-?\d+/,
},
location => {type => SCALAR|UNDEF,
optional => 1,
die "One of bug or summary must be passed to read_bug"
if not exists $param{bug} and not exists $param{summary};
my $status;
+ my $log;
if (not defined $param{summary}) {
my ($lref, $location) = @param{qw(bug location)};
if (not defined $location) {
return undef if not defined $location;
}
$status = getbugcomponent($lref, 'summary', $location);
+ $log = getbugcomponent($lref, 'log' , $location);
return undef unless defined $status;
}
else {
$data{$field} = [split ' ', $data{$field}];
}
for my $field (qw(found fixed)) {
+ # create the found/fixed hashes which indicate when a
+ # particular version was marked found or marked fixed.
@{$data{$field}}{@{$data{"${field}_versions"}}} =
(('') x (@{$data{"${field}_date"}} - @{$data{"${field}_versions"}}),
@{$data{"${field}_date"}});
$data{$field} = decode_rfc1522($data{$field});
}
}
+ # Add log last modified time
+ $data{log_modified} = (stat($log))[9];
return \%data;
}
return $data;
}
+=head2 lockreadbugmerge
+
+ my ($locks, $data) = lockreadbugmerge($bug_num,$location);
+
+Performs a filelock, then reads the bug. If the bug is merged, locks
+the merge lock. Returns a list of the number of locks and the bug
+data.
+
+=cut
+
+sub lockreadbugmerge {
+ my ($bug_num,$location) = @_;
+ my $data = lockreadbug(@_);
+ if (not defined $data) {
+ return (0,undef);
+ }
+ if (not length $data->{mergedwith}) {
+ return (1,$data);
+ }
+ unfilelock();
+ filelock('lock/merge');
+ $data = lockreadbug(@_);
+ if (not defined $data) {
+ unfilelock();
+ return (0,undef);
+ }
+ return (2,$data);
+}
+
+
my @v1fieldorder = qw(originator date subject msgid package
keywords done forwarded mergedwith severity);
}
for my $field (qw(found_versions fixed_versions found_date fixed_date)) {
- $newdata{$field} = [split ' ', $newdata{$field}||''];
+ $newdata{$field} = join ' ', @{$newdata{$field}||[]};
}
if ($version < 3) {
my $version = shift;
my $isbinary = shift;
return unless defined $version;
- undef $package if $package =~ m[(?:\s|/)];
+ undef $package if defined $package and $package =~ m[(?:\s|/)];
my $source = $package;
if (defined $package and $isbinary) {
=cut
# This will eventually need to be fixed before we start using mod_perl
-my $version_cache = {};
+our $version_cache = {};
sub bug_archiveable{
my %param = validate_with(params => \@_,
spec => {bug => {type => SCALAR,
days_until => {type => BOOLEAN,
default => 0,
},
+ ignore_time => {type => BOOLEAN,
+ default => 0,
+ },
},
);
# This is what we return if the bug cannot be archived.
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')
+ if (not $param{days_until} and not $param{ignore_time}
+ and $config{remove_age} >
+ -M getbugcomponent($param{bug},'log')
) {
return $cannot_archive;
}
# There must be fixed_versions for us to look at the versioning
# information
+ my $min_fixed_time = time;
+ my $min_archive_days = 0;
if (@{$status->{fixed_versions}}) {
my %dist_tags;
@dist_tags{@{$config{removal_distribution_tags}}} =
(1) x @{$config{removal_distribution_tags}};
my %dists;
- @dists{@{$config{removal_default_distribution_tags}}} =
+ @dists{@{$config{removal_default_distribution_tags}}} =
(1) x @{$config{removal_default_distribution_tags}};
- for my $tag (split ' ', $status->{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;
- @versions = getversions($status->{package},
- $dist,
- undef);
- # 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;
- }
+ my @sourceversions = get_versions(package => $status->{package},
+ dist => [keys %dists],
+ source => 1,
+ );
+ @source_versions{@sourceversions} = (1) x @sourceversions;
+ # If the bug has not been fixed in the versions actually
+ # distributed, then it cannot be archived.
if ('found' eq max_buggy(bug => $param{bug},
sourceversions => [keys %source_versions],
found => $status->{found_versions},
)) {
return $cannot_archive;
}
+ # Since the bug has at least been fixed in the architectures
+ # that matters, we check to see how long it has been fixed.
+
+ # If $param{ignore_time}, then we should ignore time.
+ if ($param{ignore_time}) {
+ return $param{days_until}?0:1;
+ }
+
+ # To do this, we order the times from most recent to oldest;
+ # when we come to the first found version, we stop.
+ # If we run out of versions, we only report the time of the
+ # last one.
+ my %time_versions = get_versions(package => $status->{package},
+ dist => [keys %dists],
+ source => 1,
+ time => 1,
+ );
+ for my $version (sort {$time_versions{$b} <=> $time_versions{$a}} keys %time_versions) {
+ my $buggy = buggy(bug => $param{bug},
+ version => $version,
+ found => $status->{found_versions},
+ fixed => $status->{fixed_versions},
+ version_cache => $version_cache,
+ package => $status->{package},
+ );
+ last if $buggy eq 'found';
+ $min_fixed_time = min($time_versions{$version},$min_fixed_time);
+ }
+ $min_archive_days = max($min_archive_days,ceil((time - $min_fixed_time)/(60*60*24)));
+ }
+ # If $param{ignore_time}, then we should ignore time.
+ if ($param{ignore_time}) {
+ return $param{days_until}?0:1;
}
# 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;
+ if ($age > 0 or $min_archive_days > 0) {
+ return $param{days_until}?max($age,$min_archive_days):0;
}
else {
return $param{days_until}?0:1;
=item bug_index -- optional tied index of bug status infomration;
currently not correctly implemented.
-=item version -- optional version to check package status at
+=item version -- optional version(s) to check package status at
-=item dist -- optional distribution to check package status at
+=item dist -- optional distribution(s) to check package status at
-=item arch -- optional architecture to check package status at
+=item arch -- optional architecture(s) to check package status at
=item usertags -- optional hashref of usertags
bug_index => {type => OBJECT,
optional => 1,
},
- version => {type => SCALAR,
+ version => {type => SCALAR|ARRAYREF,
optional => 1,
},
- dist => {type => SCALAR,
+ dist => {type => SCALAR|ARRAYREF,
optional => 1,
},
- arch => {type => SCALAR,
+ arch => {type => SCALAR|ARRAYREF,
optional => 1,
},
usertags => {type => HASHREF,
$status{"pending"} = 'pending-fixed' if ($tags{pending});
$status{"pending"} = 'fixed' if ($tags{fixed});
+
+ my $presence = bug_presence(map{(exists $param{$_})?($_,$param{$_}):()}
+ qw(bug sourceversions arch dist version found fixed package)
+ );
+ if (defined $presence) {
+ if ($presence eq 'fixed') {
+ $status{pending} = 'done';
+ }
+ elsif ($presence eq 'absent') {
+ $status{pending} = 'absent';
+ }
+ }
+ return \%status;
+}
+
+=head2 bug_presence
+
+ my $precence = bug_presence(bug => nnn,
+ ...
+ );
+
+Returns 'found', 'absent', 'fixed' or undef based on whether the bug
+is found, absent, fixed, or no information is available in the
+distribution (dist) and/or architecture (arch) specified.
+
+
+=head3 Options
+
+=over
+
+=item bug -- scalar bug number
+
+=item status -- optional hashref of bug status as returned by readbug
+(can be passed to avoid rereading the bug information)
+
+=item bug_index -- optional tied index of bug status infomration;
+currently not correctly implemented.
+
+=item version -- optional version to check package status at
+
+=item dist -- optional distribution to check package status at
+
+=item arch -- optional architecture to check package status at
+
+=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
+
+=cut
+
+sub bug_presence {
+ my %param = validate_with(params => \@_,
+ spec => {bug => {type => SCALAR,
+ regex => qr/^\d+$/,
+ },
+ status => {type => HASHREF,
+ optional => 1,
+ },
+ version => {type => SCALAR|ARRAYREF,
+ optional => 1,
+ },
+ dist => {type => SCALAR|ARRAYREF,
+ optional => 1,
+ },
+ arch => {type => SCALAR|ARRAYREF,
+ optional => 1,
+ },
+ sourceversions => {type => ARRAYREF,
+ optional => 1,
+ },
+ },
+ );
+ my %status;
+ if (defined $param{status}) {
+ %status = %{$param{status}};
+ }
+ else {
+ my $location = getbuglocation($param{bug}, 'summary');
+ return {} if not length $location;
+ %status = %{ readbug( $param{bug}, $location ) };
+ }
+
my @sourceversions;
if (not exists $param{sourceversions}) {
- my @versions;
+ my %sourceversions;
if (defined $param{version}) {
- @versions = ($param{version});
+ foreach my $arch (make_list($param{arch})) {
+ my @temp = makesourceversions($status{package},
+ $arch,
+ make_list($param{version})
+ );
+ @sourceversions{@temp} = (1) x @temp;
+ }
} elsif (defined $param{dist}) {
- @versions = getversions($status{package}, $param{dist}, $param{arch});
+ foreach my $arch (make_list($param{arch})) {
+ my @versions;
+ foreach my $dist (make_list($param{dist})) {
+ push @versions, getversions($status{package}, $dist, $arch);
+ }
+ my @temp = makesourceversions($status{package},
+ $arch,
+ @versions
+ );
+ @sourceversions{@temp} = (1) x @temp;
+ }
}
# TODO: This should probably be handled further out for efficiency and
# for more ease of distinguishing between pkg= and src= queries.
- @sourceversions = makesourceversions($status{package},
- $param{arch},
- @versions);
+ @sourceversions = keys %sourceversions;
}
else {
@sourceversions = @{$param{sourceversions}};
}
+ my $maxbuggy = 'undef';
if (@sourceversions) {
- my $maxbuggy = max_buggy(bug => $param{bug},
+ $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';
- }
+ }
+ elsif (defined $param{dist}) {
+ return 'absent';
}
if (length($status{done}) and
(not @sourceversions or not @{$status{fixed_versions}})) {
- $status{"pending"} = 'done';
+ return 'fixed';
}
-
- return \%status;
+ return $maxbuggy;
}
projects / debbugs.git / blobdiff