X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FSOAP.pm;h=5cb08bb0f11eff7de6ab49dea880731a13dcb8b3;hb=e0b92922e7d92a6f1d0f6a91a5e6c3b3d174ae1c;hp=6b80dae45962c925a02c2a103826841efb7e8e59;hpb=ddea6513e7cd386c033db415a4055e0694b3ad74;p=debbugs.git

diff --git a/Debbugs/SOAP.pm b/Debbugs/SOAP.pm
index 6b80dae..5cb08bb 100644
--- a/Debbugs/SOAP.pm
+++ b/Debbugs/SOAP.pm
@@ -24,6 +24,7 @@ None known.
 use warnings;
 use strict;
 use vars qw($DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
+use Debbugs::SOAP::Server;
 use base qw(Exporter SOAP::Server::Parameters);
 
 BEGIN{
@@ -38,15 +39,16 @@ BEGIN{
 
 }
 
-
 use IO::File;
 use Debbugs::Status qw(get_bug_status);
-use Debbugs::Common qw(make_list getbuglocation getbugcomponent);
-use Storable qw(nstore retrieve);
+use Debbugs::Common qw(make_list getbuglocation getbugcomponent :utf8);
+use Debbugs::Packages;
+
+use Storable qw(nstore retrieve dclone);
 use Scalar::Util qw(looks_like_number);
 
 
-our $CURRENT_VERSION = 1;
+our $CURRENT_VERSION = 2;
 
 =head2 get_usertag
 
@@ -74,7 +76,7 @@ sub get_usertag {
 	       delete $ut{$tag} unless exists $tags{$tag};
 	  }
      }
-     return \%ut;
+     return encode_utf8_structure(\%ut);
 }
 
 
@@ -127,6 +129,8 @@ sub get_status {
 	  my $bug_status;
 	  if (ref($bug)) {
 	       my %param = __collapse_params(@{$bug});
+	       next unless defined $param{bug};
+	       $bug = $param{bug};
 	       $bug_status = get_bug_status(map {(exists $param{$_})?($_,$param{$_}):()}
 					    qw(bug dist arch bugusertags sourceversions version indicatesource)
 					   );
@@ -139,7 +143,7 @@ sub get_status {
 	  }
      }
 #     __prepare_response($self);
-     return \%status;
+     return encode_utf8_structure(\%status);
 }
 
 =head2 get_bugs
@@ -169,7 +173,7 @@ sub get_bugs{
      my %params = __collapse_params(@params);
      my @bugs;
      @bugs = Debbugs::Bugs::get_bugs(%params);
-     return \@bugs;
+     return encode_utf8_structure(\@bugs);
 }
 
 =head2 newest_bugs
@@ -185,7 +189,7 @@ 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];
+     return encode_utf8_structure([($newest_bug - $num + 1) .. $newest_bug]);
 
 }
 
@@ -222,13 +226,7 @@ sub get_bug_log{
      my $VERSION = __populate_version(pop);
      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
+     my $log = Debbugs::Log->new(bug_num => $bug) or
 	  die "Debbugs::Log was unable to be initialized";
 
      my %seen_msg_ids;
@@ -252,7 +250,7 @@ sub get_bug_log{
 			  msg_num => $current_msg,
 			 };
      }
-     return \@messages;
+     return encode_utf8_structure(\@messages);
 }
 
 =head2 binary_to_source
@@ -265,14 +263,28 @@ architecture. If undef is passed as the architecture, returns a list
 of references to all possible pairs of source package names and
 versions for all architectures, with any duplicates removed.
 
-(This function corresponds to L<Debbugs::Packages::binarytosource>)
+As of comaptibility version 2, this has changed to use the more
+powerful binary_to_source routine, which allows returning source only,
+concatenated scalars, and other useful features.
+
+See the documentation of L<Debbugs::Packages::binary_to_source> for
+details.
 
 =cut
 
 sub binary_to_source{
      my $VERSION = __populate_version(pop);
+     my ($self,@params) = @_;
 
-     return [binarytosource(@_)];
+     if ($VERSION <= 1) {
+	 return encode_utf8_structure([Debbugs::Packages::binary_to_source(binary => $params[0],
+						     (@params > 1)?(version => $params[1]):(),
+						     (@params > 2)?(arch    => $params[2]):(),
+						    )]);
+     }
+     else {
+	 return encode_utf8_structure([Debbugs::Packages::binary_to_source(@params)]);
+     }
 }
 
 =head2 source_to_binary
@@ -291,8 +303,9 @@ architecture is not returned.
 
 sub source_to_binary {
      my $VERSION = __populate_version(pop);
+     my ($self,@params) = @_;
 
-     return [source_to_binary(@_)];
+     return encode_utf8_structure([Debbugs::Packages::sourcetobinary(@params)]);
 }
 
 =head2 get_versions
@@ -335,8 +348,9 @@ This function correponds to L<Debbugs::Packages::get_versions>
 
 sub get_versions{
      my $VERSION = __populate_version(pop);
+     my ($self,@params) = @_;
 
-     return scalar get_versions(@_);
+     return encode_utf8_structure(scalar Debbugs::Packages::get_versions(@params));
 }
 
 =head1 VERSION COMPATIBILITY