* Make soap handle arrayrefs properly for Debbugs::SOAP

[debbugs.git] / Debbugs / SOAP.pm

diff --git a/Debbugs/SOAP.pm b/Debbugs/SOAP.pm
index ed669a125f64d9c6768efedf6caa8327f384250f..ed7b274f40fb737d1837e6d83f030baa9abbf2e0 100644 (file)
--- a/Debbugs/SOAP.pm
+++ b/Debbugs/SOAP.pm
@@ -43,11 +43,10 @@ use IO::File;
 use Debbugs::Status qw(get_bug_status);
 use Debbugs::Common qw(make_list getbuglocation getbugcomponent);
 use Storable qw(nstore retrieve);
+use Scalar::Util qw(looks_like_number);
 
 
 our $CURRENT_VERSION = 1;
-our %DEBBUGS_SOAP_COOKIES;
-
 
 =head2 get_usertag
 
@@ -84,10 +83,28 @@ use Debbugs::Status;
 =head2 get_status 
 
      my @statuses = get_status(@bugs);
+     my @statuses = get_status([bug => 304234,
+                                dist => 'unstable',
+                               ],
+                               [bug => 304233,
+                                dist => 'unstable',
+                               ],
+                              )
 
 Returns an arrayref of hashrefs which output the status for specific
 sets of bugs.
 
+In the first case, no options are passed to
+L<Debbugs::Status::get_bug_status> besides the bug number; in the
+second the bug, dist, arch, bugusertags, sourceversions, and version
+parameters are passed if they are present.
+
+As a special case for suboptimal SOAP implementations, if only one
+argument is passed to get_status and it is an arrayref which either
+has a number as the first element or also contains an arrayref as the
+first element, the outer arrayref is dereferenced, and processed as
+in the examples above.
+
 See L<Debbugs::Status::get_bug_status> for details.
 
 =cut
@@ -95,11 +112,28 @@ See L<Debbugs::Status::get_bug_status> for details.
 sub get_status {
      my $VERSION = __populate_version(pop);
      my ($self,@bugs) = @_;
-     @bugs = make_list(@bugs);
 
+     if (@bugs == 1 and
+        ref($bugs[0]) and
+        @{$bugs[0]} and
+        (ref($bugs[0][0]) or
+         looks_like_number($bugs[0][0])
+        )
+       ) {
+             @bugs = @{$bugs[0]};
+     }
      my %status;
      for my $bug (@bugs) {
-         my $bug_status = get_bug_status(bug => $bug);
+         my $bug_status;
+         if (ref($bug)) {
+              my %param = __collapse_params(@{$bug});
+              $bug_status = get_bug_status(map {(exists $param{$_})?($_,$param{$_}):()}
+                                           qw(bug dist arch bugusertags sourceversions version)
+                                          );
+         }
+         else {
+              $bug_status = get_bug_status(bug => $bug);
+         }
          if (defined $bug_status and keys %{$bug_status} > 0) {
               $status{$bug}  = $bug_status;
          }
@@ -132,19 +166,7 @@ sub get_bugs{
      if (@params == 1 and ref($params[0]) eq 'ARRAY') {
          @params = @{$params[0]};
      }
-     my %params;
-     # Because some clients can't handle passing arrayrefs, we allow
-     # options to be specified multiple times
-     while (my ($key,$value) = splice @params,0,2) {
-         push @{$params{$key}}, make_list($value);
-     }
-     # However, for singly specified options, we want to pull them
-     # back out
-     for my $key (keys %params) {
-         if (@{$params{$key}} == 1) {
-              ($params{$key}) = @{$params{$key}}
-         }
-     }
+     my %params = __collapse_params(@params);
      my @bugs;
      @bugs = Debbugs::Bugs::get_bugs(%params);
      return \@bugs;
@@ -162,7 +184,7 @@ guaranteed to exist, but they should in the most common cases.]
 sub newest_bugs{
      my $VERSION = __populate_version(pop);
      my ($self,$num) = @_;
-     my $newest_bug = Debbugs::bugs::newest_bug();
+     my $newest_bug = Debbugs::Bugs::newest_bug();
      return [($newest_bug - $num + 1) .. $newest_bug];
 
 }
@@ -250,6 +272,26 @@ sub __populate_version{
      return $request->{___debbugs_soap_version};
 }
 
+sub __collapse_params{
+     my @params = @_;
+
+     my %params;
+     # Because some clients can't handle passing arrayrefs, we allow
+     # options to be specified multiple times
+     while (my ($key,$value) = splice @params,0,2) {
+         push @{$params{$key}}, make_list($value);
+     }
+     # However, for singly specified options, we want to pull them
+     # back out
+     for my $key (keys %params) {
+         if (@{$params{$key}} == 1) {
+              ($params{$key}) = @{$params{$key}}
+         }
+     }
+     return %params;
+}
+
+
 1;