* Use absolute paths to locks

[debbugs.git] / Debbugs / Status.pm

diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm
index 360cf38cfe2a3e1ac01dcc12af885408991449c0..55b29d5f3acdf986353a318ad0875b5c2f798544 100644 (file)
--- a/Debbugs/Status.pm
+++ b/Debbugs/Status.pm
@@ -178,7 +178,7 @@ sub read_bug{
         $log =~ s/\.summary$/.log/;
         ($location) = $status =~ m/(db-h|db|archive)/;
     }
-    my $status_fh = new IO::File $status, 'r' or
+    my $status_fh = IO::File->new($status, 'r') or
         warn "Unable to open $status for reading: $!" and return undef;
 
     my %data;
@@ -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;
 }
@@ -244,7 +248,7 @@ See readbug above for information on what this returns
 
 sub lockreadbug {
     my ($lref, $location) = @_;
-    &filelock("lock/$lref");
+    &filelock("$config{spool_dir}/lock/$lref");
     my $data = read_bug(bug => $lref, location => $location);
     &unfilelock unless defined $data;
     return $data;
@@ -270,7 +274,7 @@ sub lockreadbugmerge {
          return (1,$data);
      }
      unfilelock();
-     filelock('lock/merge');
+     filelock("$config{spool_dir}/lock/merge");
      $data = lockreadbug(@_);
      if (not defined $data) {
          unfilelock();
@@ -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 '');
 
@@ -1217,7 +1248,7 @@ sub update_realtime {
 
 sub bughook_archive {
        my @refs = @_;
-       &filelock("debbugs.trace.lock");
+       &filelock("$config{spool_dir}/debbugs.trace.lock");
        &appendfile("debbugs.trace","archive ".join(',',@refs)."\n");
        my %bugs = update_realtime("$config{spool_dir}/index.db.realtime",
                                   map{($_,'REMOVE')} @refs);
@@ -1228,7 +1259,7 @@ sub bughook_archive {
 
 sub bughook {
        my ( $type, %bugs_temp ) = @_;
-       &filelock("debbugs.trace.lock");
+       &filelock("$config{spool_dir}/debbugs.trace.lock");
 
        my %bugs;
        for my $bug (keys %bugs_temp) {