use binary_to_source cache in Debbugs::SOAP::get_status

[debbugs.git] / Debbugs / SOAP.pm

diff --git a/Debbugs/SOAP.pm b/Debbugs/SOAP.pm
index 5f0138ab209e4ca843c422075e55a9553da07236..a0c3cbf2190d06ea3f5b04dfb9d9278039929990 100644 (file)
--- a/Debbugs/SOAP.pm
+++ b/Debbugs/SOAP.pm
@@ -24,7 +24,9 @@ None known.
 use warnings;
 use strict;
 use vars qw($DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter SOAP::Server::Parameters);
+use Debbugs::SOAP::Server;
+use Exporter qw(import);
+use base qw(SOAP::Server::Parameters);
 
 BEGIN{
      $DEBUG = 0 unless defined $DEBUG;
@@ -38,16 +40,17 @@ BEGIN{
 
 }
 
-
 use IO::File;
 use Debbugs::Status qw(get_bug_status);
 use Debbugs::Common qw(make_list getbuglocation getbugcomponent);
+use Debbugs::UTF8;
 use Debbugs::Packages;
-use Storable qw(nstore retrieve);
+
+use Storable qw(nstore retrieve dclone);
 use Scalar::Util qw(looks_like_number);
 
 
-our $CURRENT_VERSION = 1;
+our $CURRENT_VERSION = 2;
 
 =head2 get_usertag
 
@@ -75,7 +78,7 @@ sub get_usertag {
               delete $ut{$tag} unless exists $tags{$tag};
          }
      }
-     return \%ut;
+     return encode_utf8_structure(\%ut);
 }
 
 
@@ -124,6 +127,7 @@ sub get_status {
              @bugs = @{$bugs[0]};
      }
      my %status;
+     my %binary_to_source_cache;
      for my $bug (@bugs) {
          my $bug_status;
          if (ref($bug)) {
@@ -131,18 +135,21 @@ sub get_status {
               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)
+                                           qw(bug dist arch bugusertags sourceversions version indicatesource),
+                                           binary_to_source_cache => \%binary_to_source_cache,
                                           );
          }
          else {
-              $bug_status = get_bug_status(bug => $bug);
+             $bug_status = get_bug_status(bug => $bug,
+                                          binary_to_source_cache => \%binary_to_source_cache,
+                                         );
          }
          if (defined $bug_status and keys %{$bug_status} > 0) {
               $status{$bug}  = $bug_status;
          }
      }
 #     __prepare_response($self);
-     return \%status;
+     return encode_utf8_structure(\%status);
 }
 
 =head2 get_bugs
@@ -172,7 +179,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
@@ -188,7 +195,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]);
 
 }
 
@@ -225,18 +232,11 @@ 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;
      my $current_msg=0;
-     my $status = {};
      my @messages;
      while (my $record = $log->read_record()) {
          $current_msg++;
@@ -255,7 +255,7 @@ sub get_bug_log{
                          msg_num => $current_msg,
                         };
      }
-     return \@messages;
+     return encode_utf8_structure(\@messages);
 }
 
 =head2 binary_to_source
@@ -268,7 +268,12 @@ 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
 
@@ -276,7 +281,15 @@ sub binary_to_source{
      my $VERSION = __populate_version(pop);
      my ($self,@params) = @_;
 
-     return [Debbugs::Packages::binarytosource(@params)];
+     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
@@ -297,7 +310,7 @@ sub source_to_binary {
      my $VERSION = __populate_version(pop);
      my ($self,@params) = @_;
 
-     return [Debbugs::Packages::sourcetobinary(@params)];
+     return encode_utf8_structure([Debbugs::Packages::sourcetobinary(@params)]);
 }
 
 =head2 get_versions
@@ -334,7 +347,7 @@ architectures are at which versions.
 
 =back
 
-This function correponds to L<Debbugs::Packages::get_versions>
+This function corresponds to L<Debbugs::Packages::get_versions>
 
 =cut
 
@@ -342,7 +355,7 @@ sub get_versions{
      my $VERSION = __populate_version(pop);
      my ($self,@params) = @_;
 
-     return scalar Debbugs::Packages::get_versions(@params);
+     return encode_utf8_structure(scalar Debbugs::Packages::get_versions(@params));
 }
 
 =head1 VERSION COMPATIBILITY