X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FStatus.pm;h=9d047a40b053a6867d4b10b24d0486c88e6c8a1e;hb=53c435119200ab9b1c2538a96b8374c51a078855;hp=e880783ca87493680b3c751e32cd06df7cf54526;hpb=7794f8e5eeb42a5b99caa0c50126eac150b3750e;p=debbugs.git diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm index e880783..9d047a4 100644 --- a/Debbugs/Status.pm +++ b/Debbugs/Status.pm @@ -33,11 +33,14 @@ status of a particular bug use warnings; use strict; +use feature 'state'; + use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); -use base qw(Exporter); +use Exporter qw(import); use Params::Validate qw(validate_with :types); -use Debbugs::Common qw(:util :lock :quit :misc :utf8); +use Debbugs::Common qw(:util :lock :quit :misc); +use Debbugs::UTF8; use Debbugs::Config qw(:config); use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522); use Debbugs::Packages qw(makesourceversions make_source_versions getversions get_versions binary_to_source); @@ -48,7 +51,8 @@ use File::Copy qw(copy); use Encode qw(decode encode is_utf8); use Storable qw(dclone); -use List::Util qw(min max); +use List::AllUtils qw(min max uniq); +use DateTime::Format::Pg; use Carp qw(croak); @@ -69,6 +73,7 @@ BEGIN{ qw(removefoundversions removefixedversions) ], hook => [qw(bughook bughook_archive)], + indexdb => [qw(generate_index_db_line)], fields => [qw(%fields)], ); @EXPORT_OK = (); @@ -108,6 +113,7 @@ our %fields = (originator => 'submitter', blockedby => 'blocked-by', unarchived => 'unarchived', summary => 'summary', + outlook => 'outlook', affects => 'affects', ); @@ -161,33 +167,34 @@ sub read_bug{ if (@_ == 1) { unshift @_, 'bug'; } + state $spec = + {bug => {type => SCALAR, + optional => 1, + # something really stupid passes negative bugnumbers + regex => qr/^-?\d+/, + }, + location => {type => SCALAR|UNDEF, + optional => 1, + }, + summary => {type => SCALAR, + optional => 1, + }, + lock => {type => BOOLEAN, + optional => 1, + }, + locks => {type => HASHREF, + optional => 1, + }, + }; my %param = validate_with(params => \@_, - spec => {bug => {type => SCALAR, - optional => 1, - # something really - # stupid passes - # negative bugnumbers - regex => qr/^-?\d+/, - }, - location => {type => SCALAR|UNDEF, - optional => 1, - }, - summary => {type => SCALAR, - optional => 1, - }, - lock => {type => BOOLEAN, - optional => 1, - }, - locks => {type => HASHREF, - optional => 1, - }, - }, + spec => $spec, ); 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; my $location; + my $report; if (not defined $param{summary}) { my $lref; ($lref,$location) = @param{qw(bug location)}; @@ -197,14 +204,18 @@ sub read_bug{ } $status = getbugcomponent($lref, 'summary', $location); $log = getbugcomponent($lref, 'log' , $location); + $report = getbugcomponent($lref, 'report' , $location); return undef unless defined $status; return undef if not -e $status; } else { $status = $param{summary}; $log = $status; + $report = $status; $log =~ s/\.summary$/.log/; + $report =~ s/\.summary$/.report/; ($location) = $status =~ m/(db-h|db|archive)/; + ($param{bug}) = $status =~ m/(\d+)\.summary$/; } if ($param{lock}) { filelock("$config{spool_dir}/lock/$param{bug}",exists $param{locks}?$param{locks}:()); @@ -217,18 +228,23 @@ sub read_bug{ } return undef; } + binmode($status_fh,':encoding(UTF-8)'); my %data; my @lines; - my $version = 2; + my $version; local $_; while (<$status_fh>) { chomp; push @lines, $_; - $version = $1 if /^Format-Version: ([0-9]+)/i; + if (not defined $version and + /^Format-Version: ([0-9]+)/i + ) { + $version = $1; + } } - + $version = 2 if not defined $version; # Version 3 is the latest format version currently supported. if ($version > 3) { warn "Unsupported status version '$version'"; @@ -238,40 +254,25 @@ sub read_bug{ return undef; } - my %namemap = reverse %fields; - for my $field (keys %fields) { - $data{$field} = '' unless exists $data{$field}; - } - if ($version < 3) { - for my $field (@rfc1522_fields) { - $data{$field} = decode_rfc1522($data{$field}); - } - } + state $namemap = {reverse %fields}; for my $line (@lines) { - my @encodings_to_try = qw(utf8 iso8859-1); - if ($version >= 3) { - @encodings_to_try = qw(utf8); - } - for (@encodings_to_try) { - last if is_utf8($line); - my $temp; - eval { - $temp = decode("$_",$line,Encode::FB_CROAK); - }; - if (not $@) { # only update the line if there are no errors. - $line = $temp; - last; - } - } if ($line =~ /(\S+?): (.*)/) { my ($name, $value) = (lc $1, $2); # this is a bit of a hack; we should never, ever have \r # or \n in the fields of status. Kill them off here. # [Eventually, this should be superfluous.] $value =~ s/[\r\n]//g; - $data{$namemap{$name}} = $value if exists $namemap{$name}; + $data{$namemap->{$name}} = $value if exists $namemap->{$name}; } } + for my $field (keys %fields) { + $data{$field} = '' unless exists $data{$field}; + } + if ($version < 3) { + for my $field (@rfc1522_fields) { + $data{$field} = decode_rfc1522($data{$field}); + } + } $data{severity} = $config{default_severity} if $data{severity} eq ''; for my $field (qw(found_versions fixed_versions found_date fixed_date)) { $data{$field} = [split ' ', $data{$field}]; @@ -280,18 +281,34 @@ sub read_bug{ # 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"}}), + (('') x (@{$data{"${field}_versions"}} - @{$data{"${field}_date"}}), @{$data{"${field}_date"}}); } my $status_modified = (stat($status))[9]; # Add log last modified time - $data{log_modified} = (stat($log))[9]; + $data{log_modified} = (stat($log))[9] // (stat("${log}.gz"))[9]; + my $report_modified = (stat($report))[9] // $data{log_modified}; $data{last_modified} = max($status_modified,$data{log_modified}); + # if the date isn't set (ancient bug), use the smallest of any of the modified + if (not defined $data{date} or not length($data{date})) { + $data{date} = min($report_modified,$status_modified,$data{log_modified}); + } $data{location} = $location; $data{archived} = (defined($location) and ($location eq 'archive'))?1:0; $data{bug_num} = $param{bug}; + # mergedwith occasionally is sorted badly. Fix it to always be sorted by <=> + # and not include this bug + if (defined $data{mergedwith} and + $data{mergedwith}) { + $data{mergedwith} = + join(' ', + grep { $_ != $data{bug_num}} + sort { $a <=> $b } + split / /, $data{mergedwith} + ); + } return \%data; } @@ -313,20 +330,42 @@ our $ditch_empty = sub{ return grep {length $_} map {split $splitter} @t; }; -my $ditch_empty_space = sub {return &{$ditch_empty}(' ',@_)}; +our $sort_and_unique = sub { + my @v; + my %u; + my $all_numeric = 1; + for my $v (@_) { + if ($all_numeric and $v =~ /\D/) { + $all_numeric = 0; + } + next if exists $u{$v}; + $u{$v} = 1; + push @v, $v; + } + if ($all_numeric) { + return sort {$a <=> $b} @v; + } else { + return sort @v; + } +}; + +my $ditch_space_unique_and_sort = sub {return &{$sort_and_unique}(&{$ditch_empty}(' ',@_))}; my %split_fields = (package => \&splitpackages, affects => \&splitpackages, - blocks => $ditch_empty_space, - blockedby => $ditch_empty_space, + # Ideally we won't have to split source, but because some consumers of + # get_bug_status cannot handle arrayref, we will split it here. + source => \&splitpackages, + blocks => $ditch_space_unique_and_sort, + blockedby => $ditch_space_unique_and_sort, # this isn't strictly correct, but we'll split both of them for # the time being until we ditch all use of keywords everywhere # from the code - keywords => $ditch_empty_space, - tags => $ditch_empty_space, - found_versions => $ditch_empty_space, - fixed_versions => $ditch_empty_space, - mergedwith => $ditch_empty_space, + keywords => $ditch_space_unique_and_sort, + tags => $ditch_space_unique_and_sort, + found_versions => $ditch_space_unique_and_sort, + fixed_versions => $ditch_space_unique_and_sort, + mergedwith => $ditch_space_unique_and_sort, ); sub split_status_fields { @@ -426,7 +465,6 @@ data. =cut sub lockreadbugmerge { - my ($bug_num,$location) = @_; my $data = lockreadbug(@_); if (not defined $data) { return (0,undef); @@ -522,12 +560,17 @@ sub lock_read_all_merged_bugs { 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); + # We do a cmp sort instead of an <=> sort here, because that's + # what merge does + my $expectmerge= + join(' ',grep {$_ != $bug } + sort { $a <=> $b } + @bugs); if ($newdata->{mergedwith} ne $expectmerge) { for (1..$locks) { unfilelock(exists $param{locks}?$param{locks}:()); } - die "Bug $param{bug} differs from bug $bug: ($newdata->{bug_num}: '$newdata->{mergedwith}') vs. ('$expectmerge') (".join(' ',@bugs).")"; + die "Bug $param{bug} mergedwith differs from bug $bug: ($newdata->{bug_num}: '$newdata->{mergedwith}') vs. ('$expectmerge') (".join(' ',@bugs).")"; } } } @@ -667,7 +710,7 @@ sub makestatus { Writes the bug status and summary files out. -Skips writting out a status file if minversion is 2 +Skips writing out a status file if minversion is 2 Does not call bughook if disablebughook is true. @@ -740,9 +783,9 @@ sub addfoundversions { 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 ($package =~ s/^src://) { + if (defined $package and $package =~ s/^src://) { $isbinary = 0; $source = $package; } @@ -785,7 +828,7 @@ exactly are removed. Otherwise, all versions matching the version number are removed. Currently $package and $isbinary are entirely ignored, but accepted -for backwards compatibilty. +for backwards compatibility. =cut @@ -1121,41 +1164,106 @@ a source package). Defaults to true. Note: Currently the version information is cached; this needs to be changed before using this function in long lived programs. +=head3 Returns + +Currently returns a hashref of status with the following keys. + +=over + +=item id -- bug number + +=item bug_num -- duplicate of id + +=item keywords -- tags set on the bug, including usertags if bugusertags passed. + +=item tags -- duplicate of keywords + +=item package -- name of package that the bug is assigned to + +=item severity -- severity of the bug + +=item pending -- pending state of the bug; one of following possible +values; values listed later have precedence if multiple conditions are +satisifed: + +=over + +=item pending -- default state + +=item forwarded -- bug has been forwarded + +=item pending-fixed -- bug is tagged pending + +=item fixed -- bug is tagged fixed + +=item absent -- bug does not apply to this distribution/architecture + +=item done -- bug is resolved in this distribution/architecture + +=back + +=item location -- db-h or archive; the location in the filesystem + +=item subject -- title of the bug + +=item last_modified -- epoch that the bug was last modified + +=item date -- epoch that the bug was filed + +=item originator -- bug reporter + +=item log_modified -- epoch that the log file was last modified + +=item msgid -- Message id of the original bug report + +=back + + +Other key/value pairs are returned but are not currently documented here. + =cut sub get_bug_status { if (@_ == 1) { unshift @_, 'bug'; } + state $spec = + {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + status => {type => HASHREF, + optional => 1, + }, + bug_index => {type => OBJECT, + optional => 1, + }, + version => {type => SCALAR|ARRAYREF, + optional => 1, + }, + dist => {type => SCALAR|ARRAYREF, + optional => 1, + }, + arch => {type => SCALAR|ARRAYREF, + optional => 1, + }, + bugusertags => {type => HASHREF, + optional => 1, + }, + sourceversions => {type => ARRAYREF, + optional => 1, + }, + indicatesource => {type => BOOLEAN, + default => 1, + }, + binary_to_source_cache => {type => HASHREF, + optional => 1, + }, + schema => {type => OBJECT, + optional => 1, + }, + }; my %param = validate_with(params => \@_, - spec => {bug => {type => SCALAR, - regex => qr/^\d+$/, - }, - status => {type => HASHREF, - optional => 1, - }, - bug_index => {type => OBJECT, - optional => 1, - }, - version => {type => SCALAR|ARRAYREF, - optional => 1, - }, - dist => {type => SCALAR|ARRAYREF, - optional => 1, - }, - arch => {type => SCALAR|ARRAYREF, - optional => 1, - }, - bugusertags => {type => HASHREF, - optional => 1, - }, - sourceversions => {type => ARRAYREF, - optional => 1, - }, - indicatesource => {type => BOOLEAN, - default => 1, - }, - }, + spec => $spec, ); my %status; @@ -1167,7 +1275,64 @@ sub get_bug_status { return \%status; } if (defined $param{status}) { - %status = %{$param{status}}; + %status = %{$param{status}}; + } + elsif (defined $param{schema}) { + my $b = $param{schema}->resultset('Bug')-> + search_rs({'me.id' => $param{bug}}, + {prefetch => [{'bug_tags'=>'tag'}, + 'severity', + {'bug_binpackages'=> 'bin_pkg'}, + {'bug_srcpackages'=> 'src_pkg'}, + {'bug_user_tags'=>{'user_tag'=>'correspondent'}}, + {owner => 'correspondent_full_names'}, + {submitter => 'correspondent_full_names'}, + 'bug_merged_bugs', + 'bug_mergeds_merged', + 'bug_blocks_blocks', + 'bug_blocks_bugs', + {'bug_vers' => ['src_pkg','src_ver']}, + ], + '+columns' => [qw(subject log_modified creation last_modified)], + collapse => 1, + result_class => 'DBIx::Class::ResultClass::HashRefInflator', + })->first(); + $status{keywords} = + join(' ',map {$_->{tag}{tag}} @{$b->{bug_tags}}); + $status{tags} = $status{keywords}; + $status{subject} = $b->{subject}; + $status{bug_num} = $b->{id}; + $status{severity} = $b->{severity}{severity}; + $status{package} = + join(' ', + (map {$_->{bin_pkg}{pkg}} @{$b->{bug_binpackages}//[]}), + (map {$_->{src_pkg}{pkg}} @{$b->{bug_srcpackages}//[]})); + $status{originator} = $b->{submitter_full}; + $status{log_modified} = + DateTime::Format::Pg->parse_datetime($b->{log_modified})->epoch; + $status{date} = + DateTime::Format::Pg->parse_datetime($b->{creation})->epoch; + $status{last_modified} = + DateTime::Format::Pg->parse_datetime($b->{last_modified})->epoch; + $status{blocks} = + join(' ', + uniq(sort(map {$_->{block}} + @{$b->{bug_blocks_block}}, + ))); + $status{blockedby} = + join(' ', + uniq(sort(map {$_->{bug}} + @{$b->{bug_blocks_bug}}, + ))); + $status{mergedwith} = + join(' ',uniq(sort(map {$_->{bug},$_->{merged}} + @{$b->{bug_merged_bugs}}, + @{$b->{bug_mergeds_merged}}, + ))); + $status{fixed_versions} = + [map {$_->{found}?():$_->{ver_string}} @{$b->{bug_vers}}]; + $status{found_versions} = + [map {$_->{found}?$_->{ver_string}:()} @{$b->{bug_vers}}]; } else { my $location = getbuglocation($param{bug}, 'summary'); @@ -1189,6 +1354,8 @@ sub get_bug_status { $status{source} = binary_to_source(binary=>[split /\s*,\s*/, $status{package}], source_only => 1, + exists $param{binary_to_source_cache}? + (cache =>$param{binary_to_source_cache}):(), ); $status{"package"} = 'unknown' if ($status{"package"} eq ''); @@ -1554,6 +1721,39 @@ sub isstrongseverity { return grep { $_ eq $severity } @{$config{strong_severities}}; } +=head1 indexdb + +=head2 generate_index_db_line + + my $data = read_bug(bug => $bug, + location => $initialdir); + # generate_index_db_line hasn't been written yet at all. + my $line = generate_index_db_line($data); + +Returns a line for a bug suitable to be written out to index.db. + +=cut + +sub generate_index_db_line { + my ($data,$bug) = @_; + + # just in case someone has given us a split out data + $data = join_status_fields($data); + + my $whendone = "open"; + my $severity = $config{default_severity}; + (my $pkglist = $data->{package}) =~ s/[,\s]+/,/g; + $pkglist =~ s/^,+//; + $pkglist =~ s/,+$//; + $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}; + return sprintf "%s %d %d %s [%s] %s %s\n", + $pkglist, $data->{bug_num}//$bug, $data->{date}, $whendone, + $data->{originator}, $severity, $data->{keywords}; +} + + =head1 PRIVATE FUNCTIONS @@ -1570,6 +1770,8 @@ sub update_realtime { my $idx_new = IO::File->new($file.'.new','w') or die "Couldn't open ${file}.new: $!"; + binmode($idx_old,':raw:utf8'); + binmode($idx_new,':raw:encoding(UTF-8)'); my $min_bug = min(keys %bugs); my $line; my @line; @@ -1634,19 +1836,7 @@ sub bughook { my $data = $bugs_temp{$bug}; appendfile("$config{spool_dir}/debbugs.trace","$type $bug\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 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", - $pkglist, $bug, $data->{date}, $whendone, - $data->{originator}, $severity, $data->{keywords}; - $bugs{$bug} = $k; + $bugs{$bug} = generate_index_db_line($data,$bug); } update_realtime("$config{spool_dir}/index.db.realtime", %bugs);