]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Status.pm
Only search for the first Format-Version: and use it
[debbugs.git] / Debbugs / Status.pm
index 9c9551b3ca262b419743021f58291ad49d408707..2c6ce209e9c07dccbcde3335e0da25803c5dc544 100644 (file)
@@ -33,8 +33,10 @@ 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);
@@ -49,7 +51,7 @@ 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);
 
 use Carp qw(croak);
 
@@ -70,6 +72,7 @@ BEGIN{
                                  qw(removefoundversions removefixedversions)
                                 ],
                     hook     => [qw(bughook bughook_archive)],
+                     indexdb  => [qw(generate_index_db_line)],
                     fields   => [qw(%fields)],
                    );
      @EXPORT_OK = ();
@@ -163,27 +166,27 @@ 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};
@@ -207,6 +210,7 @@ sub read_bug{
         $log = $status;
         $log =~ s/\.summary$/.log/;
         ($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}:());
@@ -223,15 +227,19 @@ sub read_bug{
 
     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'";
@@ -241,7 +249,7 @@ sub read_bug{
         return undef;
     }
 
-    my %namemap = reverse %fields;
+    state $namemap = {reverse %fields};
     for my $line (@lines) {
         if ($line =~ /(\S+?): (.*)/) {
             my ($name, $value) = (lc $1, $2);
@@ -249,7 +257,7 @@ sub read_bug{
            # 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) {
@@ -268,18 +276,29 @@ 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];
     $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};
 
+    # 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;
 }
 
@@ -305,6 +324,9 @@ my $ditch_empty_space = sub {return &{$ditch_empty}(' ',@_)};
 my %split_fields =
     (package        => \&splitpackages,
      affects        => \&splitpackages,
+     # 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_empty_space,
      blockedby      => $ditch_empty_space,
      # this isn't strictly correct, but we'll split both of them for
@@ -414,7 +436,6 @@ data.
 =cut
 
 sub lockreadbugmerge {
-     my ($bug_num,$location) = @_;
      my $data = lockreadbug(@_);
      if (not defined $data) {
          return (0,undef);
@@ -510,12 +531,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).")";
            }
        }
     }
@@ -655,7 +681,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.
 
@@ -728,9 +754,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;
     }
@@ -773,7 +799,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
 
@@ -1172,35 +1198,40 @@ 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,
+                                  },
+       };
      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;
 
@@ -1234,6 +1265,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 '');
@@ -1599,6 +1632,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
 
@@ -1681,19 +1747,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);