* pass on status to bug_presence

[debbugs.git] / Debbugs / Status.pm

diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm
index 360cf38cfe2a3e1ac01dcc12af885408991449c0..72b040f545a2879759d704eaa052227ee4da2c6d 100644 (file)
--- a/Debbugs/Status.pm
+++ b/Debbugs/Status.pm
@@ -193,7 +193,10 @@ sub read_bug{
     }
 
     # Version 3 is the latest format version currently supported.
-    return undef if $version > 3;
+    if ($version > 3) {
+        warn "Unsupported status version '$version'";
+        return undef;
+    }
 
     my %namemap = reverse %fields;
     for my $line (@lines) {
@@ -226,6 +229,7 @@ sub read_bug{
     # Add log last modified time
     $data{log_modified} = (stat($log))[9];
     $data{location} = $location;
+    $data{bug_num} = $param{bug};
 
     return \%data;
 }
@@ -369,17 +373,17 @@ sub writebug {
     for my $version (keys %outputs) {
         next if defined $minversion and $version < $minversion;
         my $status = getbugcomponent($ref, $outputs{$version}, $location);
-        &quit("can't find location for $ref") unless defined $status;
-        open(S,"> $status.new") || &quit("opening $status.new: $!");
+        die "can't find location for $ref" unless defined $status;
+        open(S,"> $status.new") || die "opening $status.new: $!";
         print(S makestatus($data, $version)) ||
-            &quit("writing $status.new: $!");
-        close(S) || &quit("closing $status.new: $!");
+            die "writing $status.new: $!";
+        close(S) || die "closing $status.new: $!";
         if (-e $status) {
             $change = 'change';
         } else {
             $change = 'new';
         }
-        rename("$status.new",$status) || &quit("installing new $status: $!");
+        rename("$status.new",$status) || die "installing new $status: $!";
     }
 
     # $disablebughook is a bit of a hack to let format migration scripts use
@@ -624,9 +628,19 @@ sub bug_archiveable{
      # Bugs can be archived if they are
      # 1. Closed
      if (not defined $status->{done} or not length $status->{done}) {
-         print STDERR "Cannot archive $param{bug} because it is not done\n";
+         print STDERR "Cannot archive $param{bug} because it is not done\n" if $DEBUG;
          return $cannot_archive
      }
+     # Check to make sure that the bug has none of the unremovable tags set
+     if (@{$config{removal_unremovable_tags}}) {
+         for my $tag (split ' ', ($status->{tags}||'')) {
+              if (grep {$tag eq $_} @{$config{removal_unremovable_tags}}) {
+                   print STDERR "Cannot archive $param{bug} because it has an unremovable tag '$tag'\n" if $DEBUG;
+                   return $cannot_archive;
+              }
+         }
+     }
+
      # 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.
      my $log_file = getbugcomponent($param{bug},'log');
@@ -725,7 +739,10 @@ sub bug_archiveable{
               last if $buggy eq 'found';
               $min_fixed_time = min($time_versions{$version},$min_fixed_time);
          }
-         $min_archive_days = max($min_archive_days,ceil($config{remove_age} - (time - $min_fixed_time)/(60*60*24)));
+         $min_archive_days = max($min_archive_days,ceil($config{remove_age} - (time - $min_fixed_time)/(60*60*24)))
+              # if there are no versions in the archive at all, then
+              # we can archive if enough days have passed
+              if @sourceversions;
      }
      # If $param{ignore_time}, then we should ignore time.
      if ($param{ignore_time}) {
@@ -773,6 +790,11 @@ currently not correctly implemented.
 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.]
+
 =back
 
 Note: Currently the version information is cached; this needs to be
@@ -809,6 +831,9 @@ sub get_bug_status {
                                          sourceversions => {type => ARRAYREF,
                                                             optional => 1,
                                                            },
+                                         indicatesource => {type => BOOLEAN,
+                                                            default => 0,
+                                                           },
                                         },
                              );
      my %status;
@@ -839,6 +864,12 @@ sub get_bug_status {
      my %tags = map { $_ => 1 } split ' ', $status{tags};
 
      $status{"package"} =~ s/\s*$//;
+     if ($param{indicatesource} and $status{package} ne '') {
+         $status{source} = join(', ',binarytosource($status{package}));
+     }
+     else {
+         $status{source} = 'unknown';
+     }
      $status{"package"} = 'unknown' if ($status{"package"} eq '');
      $status{"severity"} = 'normal' if ($status{"severity"} eq '');
 
@@ -848,7 +879,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) {