use base qw(Exporter);
use Params::Validate qw(validate_with :types);
-use Debbugs::Common qw(:util :lock);
+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 binarytosource);
use Debbugs::Versions;
use Debbugs::Versions::Dpkg;
use POSIX qw(ceil);
@EXPORT = ();
%EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy bug_archiveable),
- qw(isstrongseverity),
+ qw(isstrongseverity bug_presence),
],
read => [qw(readbug read_bug lockreadbug)],
write => [qw(writebug makestatus unlockwritebug)],
- versions => [qw(addfoundversion addfixedversion),
- qw(removefoundversions)
+ versions => [qw(addfoundversions addfixedversions),
+ 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];
}
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,
+ location => {type => SCALAR|UNDEF,
optional => 1,
},
summary => {type => SCALAR,
$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"}});
}
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) {
if ($version == 1) {
for my $field (@v1fieldorder) {
- if (exists $newdata{$field}) {
+ if (exists $newdata{$field} and defined $newdata{$field}) {
$contents .= "$newdata{$field}\n";
} else {
$contents .= "\n";
# further extensibility in the future.
$contents .= "Format-Version: $version\n";
for my $field (keys %fields) {
- if (exists $newdata{$field} and $newdata{$field} ne '') {
+ if (exists $newdata{$field} and defined $newdata{$field}
+ and $newdata{$field} ne '') {
# Output field names in proper case, e.g. 'Merged-With'.
my $properfield = $fields{$field};
$properfield =~ s/(?:^|(?<=-))([a-z])/\u$1/g;
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,
=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;
}
}
if ($new eq "NOCHANGE") {
- print IDXNEW $line if ($line ne "" && $line[1] == $bug);
+ print IDXNEW $line if ($line ne "" and $line[1] == $bug);
} elsif ($new eq "REMOVE") {
0;
} else {
print IDXNEW $new;
}
- if ($line ne "" && $line[1] > $bug) {
+ if (defined $line and $line ne "" and @line and $line[1] > $bug) {
print IDXNEW $line;
$line = "";
}
(my $pkglist = $data->{package}) =~ s/[,\s]+/,/g;
$pkglist =~ s/^,+//;
$pkglist =~ s/,+$//;
- $whendone = "forwarded" if length $data->{forwarded};
- $whendone = "done" if length $data->{done};
+ $whendone = "forwarded" if defined $data->{forwarded} and length $data->{forwarded};
+ $whendone = "done" if defined $data->{done} and length $data->{done};
$severity = $data->{severity} if length $data->{severity};
my $k = sprintf "%s %d %d %s [%s] %s %s\n",