]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Status.pm
merge changes from dla source tree
[debbugs.git] / Debbugs / Status.pm
index c78e58559c7eca270504225ac6702d9b99a061ec..bda64abdeef4d9aeca2b0e6de1382ec116f56b73 100644 (file)
@@ -1,3 +1,11 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
 
 package Debbugs::Status;
 
@@ -31,11 +39,13 @@ 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 binarytosource);
+use Debbugs::Packages qw(makesourceversions getversions get_versions binarytosource);
 use Debbugs::Versions;
 use Debbugs::Versions::Dpkg;
 use POSIX qw(ceil);
 
+use List::Util qw(min max);
+
 
 BEGIN{
      $VERSION = 1.00;
@@ -45,10 +55,10 @@ BEGIN{
      %EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy bug_archiveable),
                                qw(isstrongseverity bug_presence),
                               ],
-                    read   => [qw(readbug read_bug lockreadbug)],
+                    read   => [qw(readbug read_bug lockreadbug lockreadbugmerge)],
                     write  => [qw(writebug makestatus unlockwritebug)],
                     versions => [qw(addfoundversions addfixedversions),
-                                 qw(removefoundversions)
+                                 qw(removefoundversions removefixedversions)
                                 ],
                     hook     => [qw(bughook bughook_archive)],
                    );
@@ -86,6 +96,7 @@ my %fields = (originator     => 'submitter',
              fixed_date     => 'fixed-date',
               blocks         => 'blocks',
               blockedby      => 'blocked-by',
+             unarchived     => 'unarchived',
              );
 
 # Fields which need to be RFC1522-decoded in format versions earlier than 3.
@@ -148,6 +159,7 @@ sub read_bug{
     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;
     if (not defined $param{summary}) {
         my ($lref, $location) = @param{qw(bug location)};
         if (not defined $location) {
@@ -155,6 +167,7 @@ sub read_bug{
              return undef if not defined $location;
         }
         $status = getbugcomponent($lref, 'summary', $location);
+        $log    = getbugcomponent($lref, 'log'    , $location);
         return undef unless defined $status;
     }
     else {
@@ -205,6 +218,8 @@ sub read_bug{
            $data{$field} = decode_rfc1522($data{$field});
        }
     }
+    # Add log last modified time
+    $data{log_modified} = (stat($log))[9];
 
     return \%data;
 }
@@ -229,6 +244,36 @@ sub lockreadbug {
     return $data;
 }
 
+=head2 lockreadbugmerge
+
+     my ($locks, $data) = lockreadbugmerge($bug_num,$location);
+
+Performs a filelock, then reads the bug. If the bug is merged, locks
+the merge lock. Returns a list of the number of locks and the bug
+data.
+
+=cut
+
+sub lockreadbugmerge {
+     my ($bug_num,$location) = @_;
+     my $data = lockreadbug(@_);
+     if (not defined $data) {
+         return (0,undef);
+     }
+     if (not length $data->{mergedwith}) {
+         return (1,$data);
+     }
+     unfilelock();
+     filelock('lock/merge');
+     $data = lockreadbug(@_);
+     if (not defined $data) {
+         unfilelock();
+         return (0,undef);
+     }
+     return (2,$data);
+}
+
+
 my @v1fieldorder = qw(originator date subject msgid package
                       keywords done forwarded mergedwith severity);
 
@@ -546,7 +591,7 @@ Returns undef on failure.
 =cut
 
 # This will eventually need to be fixed before we start using mod_perl
-my $version_cache = {};
+our $version_cache = {};
 sub bug_archiveable{
      my %param = validate_with(params => \@_,
                               spec   => {bug => {type => SCALAR,
@@ -558,6 +603,9 @@ sub bug_archiveable{
                                          days_until => {type => BOOLEAN,
                                                         default => 0,
                                                        },
+                                         ignore_time => {type => BOOLEAN,
+                                                         default => 0,
+                                                        },
                                         },
                              );
      # This is what we return if the bug cannot be archived.
@@ -573,8 +621,9 @@ sub bug_archiveable{
      return $cannot_archive if not defined $status->{done} or not length $status->{done};
      # 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.
-     if (not $param{days_until} and $config{remove_age} >
-        -M getbugcomponent($param{ref},'log')
+     if (not $param{days_until} and not $param{ignore_time}
+        and $config{remove_age} >
+        -M getbugcomponent($param{bug},'log')
        ) {
          return $cannot_archive;
      }
@@ -585,30 +634,27 @@ sub bug_archiveable{
 
      # There must be fixed_versions for us to look at the versioning
      # information
+     my $min_fixed_time = time;
+     my $min_archive_days = 0;
      if (@{$status->{fixed_versions}}) {
          my %dist_tags;
          @dist_tags{@{$config{removal_distribution_tags}}} =
               (1) x @{$config{removal_distribution_tags}};
          my %dists;
-         @dists{@{$config{removal_default_distribution_tags}}} = 
+         @dists{@{$config{removal_default_distribution_tags}}} =
               (1) x @{$config{removal_default_distribution_tags}};
-         for my $tag (split ' ', $status->{tags}) {
+         for my $tag (split ' ', ($status->{tags}||'')) {
               next unless $dist_tags{$tag};
               $dists{$tag} = 1;
          }
          my %source_versions;
-         for my $dist (keys %dists){
-              my @versions;
-              @versions = getversions($status->{package},
-                                      $dist,
-                                      undef);
-              # TODO: This should probably be handled further out for efficiency and
-              # for more ease of distinguishing between pkg= and src= queries.
-              my @sourceversions = makesourceversions($status->{package},
-                                                      $dist,
-                                                      @versions);
-              @source_versions{@sourceversions} = (1) x @sourceversions;
-         }
+         my @sourceversions = get_versions(package => $status->{package},
+                                           dist => [keys %dists],
+                                           source => 1,
+                                          );
+         @source_versions{@sourceversions} = (1) x @sourceversions;
+         # If the bug has not been fixed in the versions actually
+         # distributed, then it cannot be archived.
          if ('found' eq max_buggy(bug => $param{bug},
                                   sourceversions => [keys %source_versions],
                                   found          => $status->{found_versions},
@@ -618,13 +664,44 @@ sub bug_archiveable{
                                  )) {
               return $cannot_archive;
          }
+         # Since the bug has at least been fixed in the architectures
+         # that matters, we check to see how long it has been fixed.
+
+         # If $param{ignore_time}, then we should ignore time.
+         if ($param{ignore_time}) {
+              return $param{days_until}?0:1;
+         }
+
+         # To do this, we order the times from most recent to oldest;
+         # when we come to the first found version, we stop.
+         # If we run out of versions, we only report the time of the
+         # last one.
+         my %time_versions = get_versions(package => $status->{package},
+                                          dist    => [keys %dists],
+                                          source  => 1,
+                                          time    => 1,
+                                         );
+         for my $version (sort {$time_versions{$b} <=> $time_versions{$a}} keys %time_versions) {
+              my $buggy = buggy(bug => $param{bug},
+                                version        => $version,
+                                found          => $status->{found_versions},
+                                fixed          => $status->{fixed_versions},
+                                version_cache  => $version_cache,
+                                package        => $status->{package},
+                               );
+              last if $buggy eq 'found';
+              $min_fixed_time = min($time_versions{$version},$min_fixed_time);
+         }
+         $min_archive_days = max($min_archive_days,ceil((time - $min_fixed_time)/(60*60*24)));
+     }
+     # If $param{ignore_time}, then we should ignore time.
+     if ($param{ignore_time}) {
+         return $param{days_until}?0:1;
      }
      # 6. at least 28 days have passed since the last action has occured or the bug was closed
-     # XXX We still need some more work here before we actually can archive;
-     # we really need to track when a bug was closed in a version.
      my $age = ceil($config{remove_age} - -M getbugcomponent($param{bug},'log'));
-     if ($age > 0 ) {
-         return $param{days_until}?$age:0;
+     if ($age > 0 or $min_archive_days > 0) {
+         return $param{days_until}?max($age,$min_archive_days):0;
      }
      else {
          return $param{days_until}?0:1;