X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=Debbugs%2FSOAP.pm;h=9b14575ccdf94a7576234d2f2ded5ee97a19be7c;hb=b19d285d86390f367d7263c7bc1ec620565f451e;hp=cfe74bbf0c43cc4c5d63f7bd406b139cb6e9cab4;hpb=27c93c993127de490e641eb9bc28405485b8da00;p=debbugs.git

diff --git a/Debbugs/SOAP.pm b/Debbugs/SOAP.pm
index cfe74bb..9b14575 100644
--- a/Debbugs/SOAP.pm
+++ b/Debbugs/SOAP.pm
@@ -43,19 +43,21 @@ 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
 
      my %ut = get_usertag('don@donarmstrong.com','this-bug-sucks','eat-this-bug');
+     my %ut = get_usertag('don@donarmstrong.com');
 
 Returns a hashref of bugs which have the specified usertags for the
 user set.
 
+In the second case, returns all of the usertags for the user passed.
+
 =cut
 
 use Debbugs::User qw(read_usertags);
@@ -81,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 is
+empty, has a number as the first element, or 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
@@ -92,11 +112,29 @@ 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]} <= 1 and
+	 (@{$bugs[0]} == 0 or
+	  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;
 	  }
@@ -108,10 +146,14 @@ sub get_status {
 =head2 get_bugs
 
      my @bugs = get_bugs(...);
+     my @bugs = get_bugs([...]);
 
-Returns a list of bugs.
+Returns a list of bugs. In the second case, allows the variable
+parameters to be specified as an array reference in case your favorite
+language's SOAP implementation is craptacular.
 
-See L<Debbugs::Bugs::get_bugs> for details.
+See L<Debbugs::Bugs::get_bugs> for details on what C<...> actually
+means.
 
 =cut
 
@@ -120,24 +162,33 @@ use Debbugs::Bugs qw();
 sub get_bugs{
      my $VERSION = __populate_version(pop);
      my ($self,@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}}
-	  }
+     # Because some soap implementations suck and can't handle
+     # variable numbers of arguments we allow get_bugs([]);
+     if (@params == 1 and ref($params[0]) eq 'ARRAY') {
+	  @params = @{$params[0]};
      }
+     my %params = __collapse_params(@params);
      my @bugs;
      @bugs = Debbugs::Bugs::get_bugs(%params);
      return \@bugs;
 }
 
+=head2 newest_bugs
+
+     my @bugs = newest_bugs(5);
+
+Returns a list of the newest bugs. [Note that all bugs are *not*
+guaranteed to exist, but they should in the most common cases.]
+
+=cut
+
+sub newest_bugs{
+     my $VERSION = __populate_version(pop);
+     my ($self,$num) = @_;
+     my $newest_bug = Debbugs::Bugs::newest_bug();
+     return [($newest_bug - $num + 1) .. $newest_bug];
+
+}
 
 =head2 get_bug_log
 
@@ -161,12 +212,15 @@ the following
  ]
 
 
+Currently $msg_num is completely ignored.
+
 =cut
 
 use Debbugs::Log qw();
 use Debbugs::MIME qw(parse);
 
 sub get_bug_log{
+     my $VERSION = __populate_version(pop);
      my ($self,$bug,$msg_num) = @_;
 
      my $location = getbuglocation($bug,'log');
@@ -192,9 +246,8 @@ sub get_bug_log{
 	  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};
-	  push @messages,{html => $record->{html},
-			  header => $header,
+	       @{$message}{qw(header body)};
+	  push @messages,{header => $header,
 			  body   => $body,
 			  attachments => [],
 			  msg_num => $current_msg,
@@ -220,6 +273,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;