X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FStatus.pm;h=93b13ce51b0d793a35eba4ca81919736a2091268;hb=ece213fb252bd813a0643689242dca211638b7d5;hp=85363284caccae6ff7d146c0948bcb747d519d2b;hpb=c7c042859262e3598d3b0892f78c9088fa4ac520;p=debbugs.git diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm index 8536328..93b13ce 100644 --- a/Debbugs/Status.pm +++ b/Debbugs/Status.pm @@ -5,7 +5,7 @@ # # [Other people have contributed to this file; their copyrights should # go here too.] -# Copyright 2007 by Don Armstrong . +# Copyright 2007-9 by Don Armstrong . package Debbugs::Status; @@ -40,13 +40,15 @@ use Params::Validate qw(validate_with :types); 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 get_versions binarytosource); +use Debbugs::Packages qw(makesourceversions make_source_versions getversions get_versions binarytosource); use Debbugs::Versions; use Debbugs::Versions::Dpkg; use POSIX qw(ceil); +use Storable qw(dclone); use List::Util qw(min max); +use Carp qw(croak); BEGIN{ $VERSION = 1.00; @@ -54,17 +56,20 @@ BEGIN{ @EXPORT = (); %EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy bug_archiveable), - qw(isstrongseverity bug_presence), + qw(isstrongseverity bug_presence split_status_fields), + ], + read => [qw(readbug read_bug lockreadbug lockreadbugmerge), + qw(lock_read_all_merged_bugs), ], - read => [qw(readbug read_bug lockreadbug lockreadbugmerge)], write => [qw(writebug makestatus unlockwritebug)], versions => [qw(addfoundversions addfixedversions), qw(removefoundversions removefixedversions) ], hook => [qw(bughook bughook_archive)], + fields => [qw(%fields)], ); @EXPORT_OK = (); - Exporter::export_ok_tags(qw(status read write versions hook)); + Exporter::export_ok_tags(qw(status read write versions hook fields)); $EXPORT_TAGS{all} = [@EXPORT_OK]; } @@ -79,8 +84,9 @@ location. Valid locations are those understood by L =cut - -my %fields = (originator => 'submitter', +# these probably shouldn't be imported by most people, but +# Debbugs::Control needs them, so they're now exportable +our %fields = (originator => 'submitter', date => 'date', subject => 'subject', msgid => 'message-id', @@ -98,8 +104,11 @@ my %fields = (originator => 'submitter', blocks => 'blocks', blockedby => 'blocked-by', unarchived => 'unarchived', + summary => 'summary', + affects => 'affects', ); + # Fields which need to be RFC1522-decoded in format versions earlier than 3. my @rfc1522_fields = qw(originator subject done forwarded owner); @@ -179,6 +188,7 @@ sub read_bug{ $status = getbugcomponent($lref, 'summary', $location); $log = getbugcomponent($lref, 'log' , $location); return undef unless defined $status; + return undef if not -e $status; } else { $status = $param{summary}; @@ -246,14 +256,121 @@ sub read_bug{ $data{$field} = decode_rfc1522($data{$field}); } } + my $status_modified = (stat($status))[9]; # Add log last modified time $data{log_modified} = (stat($log))[9]; + $data{last_modified} = max($status_modified,$data{log_modified}); $data{location} = $location; + $data{archived} = (defined($location) and ($location eq 'archive'))?1:0; $data{bug_num} = $param{bug}; return \%data; } +=head2 split_status_fields + + my @data = split_status_fields(@data); + +Splits splittable status fields (like package, tags, blocks, +blockedby, etc.) into arrayrefs (use make_list on these). Keeps the +passed @data intact using dclone. + +In scalar context, returns only the first element of @data. + +=cut + +our $ditch_empty = sub{ + my @t = @_; + my $splitter = shift @t; + return grep {length $_} map {split $splitter} @t; +}; + +my $ditch_empty_space = sub {return &{$ditch_empty}(' ',@_)}; +my %split_fields = + (package => \&splitpackages, + affects => \&splitpackages, + blocks => $ditch_empty_space, + blockedby => $ditch_empty_space, + tags => sub {return &{$ditch_empty}(qr/\s*\,\s*/,@_)}, + found_versions => $ditch_empty_space, + fixed_versions => $ditch_empty_space, + mergedwith => $ditch_empty_space, + ); + +sub split_status_fields { + my @data = @{dclone(\@_)}; + for my $data (@data) { + next if not defined $data; + croak "Passed an element which is not a hashref to split_status_field".ref($data) if + not (ref($data) and ref($data) eq 'HASH'); + for my $field (keys %{$data}) { + next unless defined $data->{$field}; + if (exists $split_fields{$field}) { + next if ref($data->{$field}); + my @elements; + if (ref($split_fields{$field}) eq 'CODE') { + @elements = &{$split_fields{$field}}($data->{$field}); + } + elsif (not ref($split_fields{$field}) or + UNIVERSAL::isa($split_fields{$field},'Regex') + ) { + @elements = split $split_fields{$field}, $data->{$field}; + } + if (@elements != 1) { + $data->{$field} = \@elements; + } + else { + $data->{$field} = $elements[0]; + } + } + } + } + return wantarray?@data:$data[0]; +} + +=head2 join_status_fields + + my @data = join_status_fields(@data); + +Handles joining the splitable status fields. (Basically, the inverse +of split_status_fields. + +Primarily called from makestatus, but may be useful for other +functions after calling split_status_fields (or for legacy functions +if we transition to split fields by default). + +=cut + +sub join_status_fields { + my %join_fields = + (package => ', ', + affects => ', ', + blocks => ' ', + blockedby => ' ', + tags => ', ', + found_versions => ' ', + fixed_versions => ' ', + found_date => ' ', + fixed_date => ' ', + mergedwith => ' ', + ); + my @data = @{dclone(\@_)}; + for my $data (@data) { + next if not defined $data; + croak "Passed an element which is not a hashref to split_status_field: ". + ref($data) + if ref($data) ne 'HASH'; + for my $field (keys %{$data}) { + next unless defined $data->{$field}; + next unless ref($data->{$field}) eq 'ARRAY'; + next unless exists $join_fields{$field}; + $data->{$field} = join($join_fields{$field},@{$data->{$field}}); + } + } + return wantarray?@data:$data[0]; +} + + =head2 lockreadbug lockreadbug($bug_num,$location) @@ -316,20 +433,24 @@ even if all of the others were read properly. sub lock_read_all_merged_bugs { my ($bug_num,$location) = @_; + my $locks = 0; my @data = (lockreadbug(@_)); - if (not @data and not defined $data[0]) { - return (0,undef); + if (not @data or not defined $data[0]) { + return ($locks,()); } + $locks++; if (not length $data[0]->{mergedwith}) { - return (1,@data); + return ($locks,@data); } unfilelock(); + $locks--; filelock("$config{spool_dir}/lock/merge"); - my $locks = 0; + $locks++; @data = (lockreadbug(@_)); - if (not @data and not defined $data[0]) { + if (not @data or not defined $data[0]) { unfilelock(); #for merge lock above - return (0,undef); + $locks--; + return ($locks,()); } $locks++; my @bugs = split / /, $data[0]->{mergedwith}; @@ -343,22 +464,22 @@ sub lock_read_all_merged_bugs { } $locks = 0; warn "Unable to read bug: $bug while handling merged bug: $bug_num"; - return ($locks,undef); + return ($locks,()); } $locks++; push @data,$newdata; } # perform a sanity check to make sure that the merged bugs are # all merged with eachother - my $expectmerge= join(' ',grep($_ != $bug, sort { $a <=> $b } @bugs)); + my $expectmerge= join(' ',grep {$_ != $bug } sort { $a <=> $b } (@bugs,$bug_num)); if ($newdata->{mergedwith} ne $expectmerge) { for (1..$locks) { unfilelock(); } - die "Bug $bug_num differs from bug $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")"; + die "Bug $bug_num differs from bug $bug: ($newdata->{bug_num}: $newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")"; } } - return (2,@data); + return ($locks,@data); } @@ -394,10 +515,7 @@ sub makestatus { [map {$newdata{$field}{$_}||''} keys %{$newdata{$field}}]; } } - - for my $field (qw(found_versions fixed_versions found_date fixed_date)) { - $newdata{$field} = join ' ', @{$newdata{$field}||[]}; - } + %newdata = %{join_status_fields(\%newdata)}; if ($version < 3) { for my $field (@rfc1522_fields) { @@ -641,7 +759,7 @@ Split a package string from the status file into a list of package names. sub splitpackages { my $pkgs = shift; return unless defined $pkgs; - return map lc, split /[ \t?,()]+/, $pkgs; + return grep {length $_} map lc, split /[\s,()?]+/, $pkgs; } @@ -869,9 +987,8 @@ dist, arch, and version. [The entries in this array must be in the "source/version" format.] Eventually this can be used to for caching. =item indicatesource -- if true, indicate which source packages this -bug could belong to. Defaults to false. [Note that eventually we will -properly allow bugs that only affect a source package, and this will -become always on.] +bug could belong to (or does belong to in the case of bugs assigned to +a source package). Defaults to true. =back @@ -910,7 +1027,7 @@ sub get_bug_status { optional => 1, }, indicatesource => {type => BOOLEAN, - default => 0, + default => 1, }, }, ); @@ -941,15 +1058,30 @@ sub get_bug_status { $status{tags} = $status{keywords}; my %tags = map { $_ => 1 } split ' ', $status{tags}; + $status{package} = '' if not defined $status{package}; $status{"package"} =~ s/\s*$//; - if ($param{indicatesource} and $status{package} ne '') { - $status{source} = join(', ',binarytosource($status{package})); - } - else { - $status{source} = 'unknown'; + # if we aren't supposed to indicate the source, we'll return + # unknown here. + $status{source} = 'unknown'; + if ($param{indicatesource}) { + my @packages = split /\s*,\s*/, $status{package}; + my @source; + for my $package (@packages) { + next if $package eq ''; + if ($package =~ /^src\:$/) { + push @source,$1; + } + else { + push @source, binarytosource($package); + } + } + if (@source) { + $status{source} = join(', ',@source); + } } + $status{"package"} = 'unknown' if ($status{"package"} eq ''); - $status{"severity"} = 'normal' if ($status{"severity"} eq ''); + $status{"severity"} = 'normal' if (not defined $status{severity} or $status{"severity"} eq ''); $status{"pending"} = 'pending'; $status{"pending"} = 'forwarded' if (length($status{"forwarded"})); @@ -957,7 +1089,8 @@ sub get_bug_status { $status{"pending"} = 'fixed' if ($tags{fixed}); - my $presence = bug_presence(map{(exists $param{$_})?($_,$param{$_}):()} + my $presence = bug_presence(status => \%status, + map{(exists $param{$_})?($_,$param{$_}):()} qw(bug sourceversions arch dist version found fixed package) ); if (defined $presence) { @@ -1059,16 +1192,51 @@ sub bug_presence { } } } elsif (defined $param{dist}) { - foreach my $arch (make_list($param{arch})) { - my @versions; + my %affects_distribution_tags; + @affects_distribution_tags{@{$config{affects_distribution_tags}}} = + (1) x @{$config{affects_distribution_tags}}; + my $some_distributions_disallowed = 0; + my %allowed_distributions; + for my $tag (split ' ', ($status{tags}||'')) { + if (exists $config{distribution_aliases}{$tag} and + exists $affects_distribution_tags{$config{distribution_aliases}{$tag}}) { + $some_distributions_disallowed = 1; + $allowed_distributions{$config{distribution_aliases}{$tag}} = 1; + } + elsif (exists $affects_distribution_tags{$tag}) { + $some_distributions_disallowed = 1; + $allowed_distributions{$tag} = 1; + } + } + foreach my $arch (make_list(exists $param{arch}?$param{arch}:undef)) { for my $package (split /\s*,\s*/, $status{package}) { - foreach my $dist (make_list($param{dist})) { - push @versions, getversions($package, $dist, $arch); + my @versions = (); + my $source = 0; + if ($package =~ /^src:(.+)$/) { + $source = 1; + $package = $1; } - my @temp = makesourceversions($package, - $arch, - @versions - ); + foreach my $dist (make_list(exists $param{dist}?$param{dist}:[])) { + # if some distributions are disallowed, + # and this isn't an allowed + # distribution, then we ignore this + # distribution for the purposees of + # finding versions + if ($some_distributions_disallowed and + not exists $allowed_distributions{$dist}) { + next; + } + push @versions, get_versions(package => $package, + dist => $dist, + ($source?(arch => 'source'): + (defined $arch?(arch => $arch):())), + ); + } + next unless @versions; + my @temp = make_source_versions(package => $package, + arch => $arch, + versions => \@versions, + ); @sourceversions{@temp} = (1) x @temp; } } @@ -1085,12 +1253,12 @@ sub bug_presence { my $maxbuggy = 'undef'; if (@sourceversions) { $maxbuggy = max_buggy(bug => $param{bug}, - sourceversions => \@sourceversions, - found => $status{found_versions}, - fixed => $status{fixed_versions}, - package => $status{package}, - version_cache => $version_cache, - ); + sourceversions => \@sourceversions, + found => $status{found_versions}, + fixed => $status{fixed_versions}, + package => $status{package}, + version_cache => $version_cache, + ); } elsif (defined $param{dist} and not exists $pseudo_desc->{$status{package}}) {