merge in changes from dla source tree

[debbugs.git] / Debbugs / Status.pm

diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm
index 7dedda2de548fcb8b098a20b5f4d30012004be1f..360cf38cfe2a3e1ac01dcc12af885408991449c0 100644 (file)
--- a/Debbugs/Status.pm
+++ b/Debbugs/Status.pm
@@ -529,24 +529,20 @@ sub removefixedversions {
     my $version = shift;
     my $isbinary = shift;
     return unless defined $version;
-    undef $package if $package =~ m[(?:\s|/)];
-    my $source = $package;
-
-    if (defined $package and $isbinary) {
-        my @srcinfo = binarytosource($package, $version, undef);
-        if (@srcinfo) {
-            # We know the source package(s). Use a fully-qualified version.
-            removefixedversions($data, $_->[0], $_->[1], '') foreach @srcinfo;
-            return;
-        }
-        # Otherwise, an unqualified version will have to do.
-        undef $source;
-    }
 
     foreach my $ver (split /[,\s]+/, $version) {
-        my $sver = defined($source) ? "$source/$ver" : '';
-        @{$data->{fixed_versions}} =
-            grep { $_ ne $ver and $_ ne $sver } @{$data->{fixed_versions}};
+        if ($ver =~ m{/}) {
+             # fully qualified version
+             @{$data->{fixed_versions}} =
+                  grep {$_ ne $ver}
+                       @{$data->{fixed_versions}};
+        }
+        else {
+             # non qualified version; delete all matchers
+             @{$data->{fixed_versions}} =
+                  grep {$_ !~ m[(?:^|/)\Q$ver\E$]}
+                       @{$data->{fixed_versions}};
+        }
     }
 }
 
@@ -620,20 +616,32 @@ sub bug_archiveable{
      my $status = $param{status};
      if (not exists $param{status} or not defined $status) {
          $status = read_bug(bug=>$param{bug});
-         return undef if not defined $status;
+         if (not defined $status) {
+              print STDERR "Cannot archive $param{bug} because it does not exist\n" if $DEBUG;
+              return undef;
+         }
      }
      # Bugs can be archived if they are
      # 1. Closed
-     return $cannot_archive if not defined $status->{done} or not length $status->{done};
+     if (not defined $status->{done} or not length $status->{done}) {
+         print STDERR "Cannot archive $param{bug} because it is not done\n";
+         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($_,'log');
+     my $log_file = getbugcomponent($param{bug},'log');
      if (not defined $log_file) {
-         print STDERR "Cannot archive $param{bug} because the log doesn't exists\n" if $DEBUG;
+         print STDERR "Cannot archive $param{bug} because the log doesn't exist\n" if $DEBUG;
+         return $cannot_archive;
      }
+     my $max_log_age = max(map {$config{remove_age} - -M $_}
+                          $log_file, map {my $log = getbugcomponent($_,'log');
+                                          defined $log ? ($log) : ();
+                                     }
+                          split / /, $status->{mergedwith}
+                      );
      if (not $param{days_until} and not $param{ignore_time}
-        and $config{remove_age} >
-        -M $log_file
+        and $max_log_age > 0
        ) {
          print STDERR "Cannot archive $param{bug} because of time\n" if $DEBUG;
          return $cannot_archive;
@@ -643,6 +651,10 @@ sub bug_archiveable{
      # tags set, we assume a default set, otherwise we use the tags the bug
      # has set.
 
+     # In cases where we are assuming a default set, if the severity
+     # is strong, we use the strong severity default; otherwise, we
+     # use the normal default.
+
      # There must be fixed_versions for us to look at the versioning
      # information
      my $min_fixed_time = time;
@@ -652,11 +664,20 @@ sub bug_archiveable{
          @dist_tags{@{$config{removal_distribution_tags}}} =
               (1) x @{$config{removal_distribution_tags}};
          my %dists;
-         @dists{@{$config{removal_default_distribution_tags}}} =
-              (1) x @{$config{removal_default_distribution_tags}};
          for my $tag (split ' ', ($status->{tags}||'')) {
-              next unless $dist_tags{$tag};
-              $dists{$tag} = 1;
+              next unless exists $config{distribution_aliases}{$tag};
+              next unless $dist_tags{$config{distribution_aliases}{$tag}};
+              $dists{$config{distribution_aliases}{$tag}} = 1;
+         }
+         if (not keys %dists) {
+              if (isstrongseverity($status->{severity})) {
+                   @dists{@{$config{removal_strong_severity_default_distribution_tags}}} =
+                        (1) x @{$config{removal_strong_severity_default_distribution_tags}};
+              }
+              else {
+                   @dists{@{$config{removal_default_distribution_tags}}} =
+                        (1) x @{$config{removal_default_distribution_tags}};
+              }
          }
          my %source_versions;
          my @sourceversions = get_versions(package => $status->{package},
@@ -711,11 +732,9 @@ sub bug_archiveable{
          return $param{days_until}?0:1;
      }
      # 6. at least 28 days have passed since the last action has occured or the bug was closed
-     my $age = ceil(max(map {$config{remove_age} - -M $log_file}
-                       $param{bug}, split / /, $status->{mergedwith}
-                      )
-                  );
+     my $age = ceil($max_log_age);
      if ($age > 0 or $min_archive_days > 0) {
+         print STDERR "Cannot archive $param{bug} because not enough days have passed\n" if $DEBUG;
          return $param{days_until}?max($age,$min_archive_days):0;
      }
      else {
@@ -964,7 +983,8 @@ sub bug_presence {
                                   version_cache => $version_cache,
                                  );
      }
-     elsif (defined $param{dist}) {
+     elsif (defined $param{dist} and
+           not exists $pseudo_desc->{$status{package}}) {
          return 'absent';
      }
      if (length($status{done}) and
@@ -1113,7 +1133,7 @@ sub buggy {
                    # We only want to warn if it's a package which actually has a maintainer
                    my $maints = getmaintainers();
                    next if not exists $maints->{$source};
-                   warn "Unable to open $config{version_packages_dir}/$srchash/$source: $!";
+                   warn "Bug $param{bug}: unable to open $config{version_packages_dir}/$srchash/$source: $!";
                    next;
               }
               $version->load($version_fh);