merge changes from dla source tree

diff --git a/Debbugs/Bugs.pm b/Debbugs/Bugs.pm
index 2399102d5e496cc2fed72e84a4483eee6b825904..bb793134b87dff9dd00f109a021689fce5d7f010 100644 (file)
--- a/Debbugs/Bugs.pm
+++ b/Debbugs/Bugs.pm
@@ -104,7 +104,8 @@ searches are performed.
 =over
 
 =item archive -- whether to search archived bugs or normal bugs;
-defaults to false.
+defaults to false. As a special case, if archive is 'both', but
+archived and unarchived bugs are returned.
 
 =item usertags -- set of usertags and the bugs they are applied to
 
@@ -180,7 +181,7 @@ sub get_bugs{
                                          bugs      => {type => SCALAR|ARRAYREF,
                                                        optional => 1,
                                                       },
-                                         archive   => {type => BOOLEAN,
+                                         archive   => {type => BOOLEAN|SCALAR,
                                                        default => 0,
                                                       },
                                          usertags  => {type => HASHREF,
@@ -192,6 +193,13 @@ sub get_bugs{
      # Normalize options
      my %options = %param;
      my @bugs;
+     if ($options{archive} eq 'both') {
+         push @bugs, get_bugs(%options,archive=>0);
+         push @bugs, get_bugs(%options,archive=>1);
+         my %bugs;
+         @bugs{@bugs} = @bugs;
+         return keys %bugs;
+     }
      # A configuration option will set an array that we'll use here instead.
      for my $routine (qw(Debbugs::Bugs::get_bugs_by_idx Debbugs::Bugs::get_bugs_flatfile)) {
          my ($package) = $routine =~ m/^(.+)\:\:/;

diff --git a/cgi/pkgreport.cgi b/cgi/pkgreport.cgi
index 8a3f300042c07beb99f125b7a220254d472a9fce..ed67c54d13ae088111975594dd8c135e03f6792b 100755 (executable)
--- a/cgi/pkgreport.cgi
+++ b/cgi/pkgreport.cgi
@@ -651,8 +651,11 @@ sub pkg_htmlindexentrystatus {
                                   days_until => 1,
                                  );
         if ($days >= 0 and defined $status{location} and $status{location} ne 'archive') {
-            $result .= ";\n<strong>Will be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "</strong>";
+            $result .= ";\n<strong>Can be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "</strong>";
         }
+       elsif (defined $status{location} and $status{location} eq 'archived') {
+            $result .= ";\n<strong>Archived.</strong>";
+       }
     }
 
     unless (length($status{done})) {

diff --git a/scripts/expire.in b/scripts/expire.in
index 2fbdcb77067beb74b23e85d3577ba70d9dddd55f..0b0391dcc662f85556cd5454334135fe8c3b300b 100755 (executable)
--- a/scripts/expire.in
+++ b/scripts/expire.in
@@ -9,7 +9,61 @@
 # Copyright 2004 by Collin Watson <cjwatson@debian.org>
 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>
 
+use Getopt::Long;
+use Pod::Usage;
 
+use warnings;
+use strict;
+
+=head1 NAME
+
+expire - Expires archiveable bugs by copying to archive or deleting
+
+=head1 SYNOPSIS
+
+ expire [options]
+
+ Options:
+  --debug, -d debugging level (Default 0)
+  --help, -h display this help
+  --man, -m display manual
+
+=head1 OPTIONS
+
+=over
+
+=item B<--debug, -d>
+
+Debug verbosity. (Default 0)
+
+=item B<--help, -h>
+
+Display brief useage information.
+
+=item B<--man, -m>
+
+Display this manual.
+
+=back
+
+=head1 EXAMPLES
+
+
+=cut
+
+my %options = (debug           => 0,
+              help            => 0,
+              man             => 0,
+              quick           => 0,
+              index_path      => undef,
+              );
+
+GetOptions(\%options,'debug|d+','help|h|?','man|m') or pod2usage(2);
+pod2usage(1) if $options{help};
+pod2usage(-verbose=>2) if $options{man};
+
+
+my $verbose = $options{debug};
 
 use Debbugs::Control qw(bug_archive);
 use Debbugs::Status qw(bug_archiveable);
@@ -23,8 +77,9 @@ chdir($config{spool_dir}) || die "chdir $config{spool_dir} failed: $!\n";
 
 #get list of bugs (ie, status files)
 opendir(DIR,"db-h") or die "Unable to open dir db-h: $!";
-@dirs = sort { $a <=> $b } grep(s,^,db-h/,, grep(m/^\d+$/,readdir(DIR)));
+my @dirs = sort { $a <=> $b } grep(s,^,db-h/,, grep(m/^\d+$/,readdir(DIR)));
 close(DIR);
+my @list;
 foreach my $dir (@dirs) {
     opendir(DIR,$dir);
     push @list, sort { $a <=> $b } grep(s/\.summary$//,grep(m/^\d+\.summary$/,readdir(DIR)));
@@ -33,17 +88,24 @@ foreach my $dir (@dirs) {
 
 my $bug;
 my $errors=0;
+our $exit_now = 0;
+$SIG{INT} = sub {$exit_now=1;};
 #process each bug (ie, status file)
 while (length($bug=shift(@list))) {
      # Weeeee.
+     print "Examining $bug\n" if $verbose;
      next unless bug_archiveable(bug=>$bug);
+     print "Bug $bug can be archived: " if $verbose;
      eval {
          bug_archive(bug=>$bug);
+         print "archived.\n" if $verbose;
      };
      if ($@) {
          $errors=1;
+         print "failed.\n" if $verbose;
          print STDERR "Unable to archive bug# $bug which I thought I could archive:\n$@\n";
      }
+     last if $exit_now;
 }
 
 exit $errors;