merge changes from dla source tree

diff --git a/Debbugs/SOAP.pm b/Debbugs/SOAP.pm
index 89d0dd0fb4d5d23330a7cb8ab9c8f971fcd0eb79..7ab55e2b04255561f089b0a2061385b4303f818c 100644 (file)
--- a/Debbugs/SOAP.pm
+++ b/Debbugs/SOAP.pm
@@ -39,8 +39,9 @@ BEGIN{
 }
 
 
+use IO::File;
 use Debbugs::Status qw(get_bug_status);
-use Debbugs::Common qw(make_list);
+use Debbugs::Common qw(make_list getbuglocation getbugcomponent);
 use Storable qw(nstore retrieve);
 
 
@@ -119,7 +120,7 @@ sub get_bugs{
      my ($self,@params) = @_;
      my %params;
      while (my ($key,$value) = splice @params,0,2) {
-         push @{$params{$key}}, $value;
+         push @{$params{$key}}, make_list($value);
      }
      my @bugs;
      @bugs = Debbugs::Bugs::get_bugs(%params);
@@ -127,6 +128,74 @@ sub get_bugs{
 }
 
 
+=head2 get_bug_log
+
+     my $bug_log = get_bug_log($bug);
+     my $bug_log = get_bug_log($bug,$msg_num);
+
+Retuns a parsed set of the bug log; this is an array of hashes with
+the following
+
+ [{html => '',
+   header => '',
+   body    => '',
+   attachments => [],
+   msg_num     => 5,
+  },
+  {html => '',
+   header => '',
+   body    => '',
+   attachments => [],
+  },
+ ]
+
+
+=cut
+
+use Debbugs::Log qw();
+use Debbugs::MIME qw(parse);
+
+sub get_bug_log{
+     my ($self,$bug,$msg_num) = @_;
+
+     my $location = getbuglocation($bug,'log');
+     my $bug_log = getbugcomponent($bug,'log',$location);
+
+     my $log_fh = IO::File->new($bug_log, 'r') or
+         die "Unable to open bug log $bug_log for reading: $!";
+
+     my $log = Debbugs::Log->new($log_fh) or
+         die "Debbugs::Log was unable to be initialized";
+
+     my %seen_msg_ids;
+     my $current_msg=0;
+     my $status = {};
+     my @messages;
+     while (my $record = $log->read_record()) {
+         $current_msg++;
+         print STDERR "message $current_msg\n";
+         #next if defined $msg_num and ($current_msg ne $msg_num);
+         print STDERR "still message $current_msg\n";
+         next unless $record->{type} eq 'incoming-recv';
+         my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im;
+         next if defined $msg_id and exists $seen_msg_ids{$msg_id};
+         $seen_msg_ids{$msg_id} = 1 if defined $msg_id;
+         next if defined $msg_id and $msg_id =~ /handler\..+\.ack(?:info)?\@/;
+         my $message = parse($record->{text});
+         my ($header,$body) = map {join("\n",make_list($_))}
+              values %{$message};
+         print STDERR "still still message $current_msg\n";
+         push @messages,{html => $record->{html},
+                         header => $header,
+                         body   => $body,
+                         attachments => [],
+                         msg_num => $current_msg,
+                        };
+     }
+     return \@messages;
+}
+
+
 =head1 VERSION COMPATIBILITY
 
 The functionality provided by the SOAP interface will change over time.

diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm
index 55ed9354da6f659a9f66b8a6e730e3d3570296fa..2dc7440217ee20926c7eaf2c33f01b54597489df 100644 (file)
--- a/Debbugs/Status.pm
+++ b/Debbugs/Status.pm
@@ -1005,18 +1005,20 @@ sub max_buggy{
      # Resolve bugginess states (we might be looking at multiple
      # architectures, say). Found wins, then fixed, then absent.
      my $maxbuggy = 'absent';
-     for my $version (@{$param{sourceversions}}) {
-         my $buggy = buggy(bug => $param{bug},
-                           version => $version,
-                           found => $param{found},
-                           fixed => $param{fixed},
-                           version_cache => $param{version_cache},
-                           package => $param{package},
-                          );
-         if ($buggy eq 'found') {
-              return 'found';
-         } elsif ($buggy eq 'fixed') {
-              $maxbuggy = 'fixed';
+     for my $package (split /\s*,\s*/, $param{package}) {
+         for my $version (@{$param{sourceversions}}) {
+              my $buggy = buggy(bug => $param{bug},
+                                version => $version,
+                                found => $param{found},
+                                fixed => $param{fixed},
+                                version_cache => $param{version_cache},
+                                package => $package,
+                               );
+              if ($buggy eq 'found') {
+                   return 'found';
+              } elsif ($buggy eq 'fixed') {
+                   $maxbuggy = 'fixed';
+              }
          }
      }
      return $maxbuggy;

diff --git a/cgi/soap.cgi b/cgi/soap.cgi
index c914b0121aa3a1caef09455888ef18775acecd83..b5766d7a52108e25c606f5f1885109daed217a38 100755 (executable)
--- a/cgi/soap.cgi
+++ b/cgi/soap.cgi
@@ -15,5 +15,6 @@ my $soap = Debbugs::SOAP::Server
 #$soap->serializer()->soapversion(1.2);
 # soapy is stupid, and is using the 1999 schema; override it.
 *SOAP::XMLSchema1999::Serializer::as_base64Binary = \&SOAP::XMLSchema2001::Serializer::as_base64Binary;
+*SOAP::Serializer::as_anyURI       = \&SOAP::XMLSchema2001::Serializer::as_string;
 $soap-> handle;
 

diff --git a/cgi/version.cgi b/cgi/version.cgi
index b5967be6ef778f7a5c0af453698cba9a96caf0fc..294f1027f4bb14fdc2387a3fcf7abee88f4dec67 100755 (executable)
--- a/cgi/version.cgi
+++ b/cgi/version.cgi
@@ -103,8 +103,8 @@ END
 
 # then figure out which are affected.
 # turn found and fixed into full versions
-@{$cgi_var{found}} = makesourceversions($cgi_var{package},undef,@{$cgi_var{found}});
-@{$cgi_var{fixed}} = makesourceversions($cgi_var{package},undef,@{$cgi_var{fixed}});
+@{$cgi_var{found}} = map {makesourceversions($_,undef,@{$cgi_var{found}})} split/\s*,\s*/, $cgi_var{package};
+@{$cgi_var{fixed}} = map {makesourceversions($_,undef,@{$cgi_var{fixed}})} split/\s*,\s*/, $cgi_var{package};
 my @interesting_versions = makesourceversions($cgi_var{package},undef,keys %version_to_dist);
 
 # We need to be able to rip out leaves which the versions that do not affect the current versions of unstable/testing

diff --git a/scripts/expire.in b/scripts/expire.in
index 1b27dcee8afded75927b27c61d0903b0fe79d5ee..d5149e945021220b5860e3535062ef5e9c78cb3f 100755 (executable)
--- a/scripts/expire.in
+++ b/scripts/expire.in
@@ -78,7 +78,7 @@ 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: $!";
-my @dirs = sort { $a <=> $b } grep(s,^,db-h/,, grep(m/^\d+$/,readdir(DIR)));
+my @dirs = sort { $a cmp $b } grep(s,^,db-h/,, grep(m/^\d+$/,readdir(DIR)));
 close(DIR);
 my @list;
 foreach my $dir (@dirs) {

diff --git a/scripts/gen-indices.in b/scripts/gen-indices.in
index 73243b8e5119b0d6cc9ee3a6432c36d88abe6157..c7abe97b043deb7e8bf3f9d156e19066316d7187 100755 (executable)
--- a/scripts/gen-indices.in
+++ b/scripts/gen-indices.in
@@ -76,7 +76,7 @@ pod2usage(1) if $options{help};
 pod2usage(-verbose=>2) if $options{man};
 
 use Debbugs::Config qw(:config);
-use Debbugs::Common qw(getparsedaddrs getbugcomponent);
+use Debbugs::Common qw(getparsedaddrs getbugcomponent lockpid);
 use Debbugs::Status qw(readbug);
 
 chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!";
@@ -92,6 +92,16 @@ if (defined $ARGV[0] and $ARGV[0] eq "archive") {
     $suffix = "-arc";
 }
 
+if (not lockpid($config{spool_dir}.'/lock/gen-indices')) {
+     if ($options{quick}) {
+         # If this is a quick run, just exit
+         print STDERR "Another gen-indices is running; stopping\n" if $verbose;
+         exit 0;
+     }
+     print STDERR "Another gen-indices is running; stopping\n";
+     exit 1;
+}
+
 # NB: The reverse index is special; it's used to clean up during updates to bugs
 my @indexes = ('package', 'tag', 'severity','owner','submitter-email','reverse');
 my $indexes;
@@ -211,3 +221,4 @@ for my $i (@indexes) {
        system('touch','-d',"1/1/1970 UTC + ${start_time}secs","$indexdest/by-$i$suffix.idx");
 }
 
+unlink($config{spool_dir}.'/lock/gen-indices')

diff --git a/t/09_soap.t b/t/09_soap.t
index 2ffd45c2dc15add62f083f3dde3c4facbdca250a..3154a0835aa11fcfefca31bef29b2541eaefdd2e 100644 (file)
--- a/t/09_soap.t
+++ b/t/09_soap.t
@@ -57,7 +57,7 @@ EOF
 
 # test bugreport.cgi
 
-my $port = 11342;
+my $port = 11343;
 
 # We'd like to use soap.cgi here instead of testing the module
 # directly, but I can't quite get it to work with
@@ -78,8 +78,8 @@ my $pid = fork;
 die "Unable to fork child" if not defined $pid;
 if ($pid) {
      $child_pid = $pid;
-     # Wait for a second to let the child start
-     sleep 1;
+     # Wait for two seconds to let the child start
+     sleep 2;
 }
 else {
      # UGH.