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 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;
 
 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 IO::File;
 use Debbugs::Status qw(get_bug_status);
 use Debbugs::Common qw(make_list getbuglocation getbugcomponent);

+use Debbugs::UTF8;

 use Debbugs::Packages;
 use Debbugs::Packages;

-use Storable qw(nstore retrieve);
+
+use Storable qw(nstore retrieve dclone);

 use Scalar::Util qw(looks_like_number);
 
 
 use Scalar::Util qw(looks_like_number);
 
 

-our $CURRENT_VERSION = 1;
+our $CURRENT_VERSION = 2;

 
 =head2 get_usertag
 
 
 =head2 get_usertag
 


@@ -75,7 +78,7 @@ sub get_usertag {
               delete $ut{$tag} unless exists $tags{$tag};
          }
      }
               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;
              @bugs = @{$bugs[0]};
      }
      my %status;

+     my %binary_to_source_cache;

      for my $bug (@bugs) {
          my $bug_status;
          if (ref($bug)) {
      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{$_}):()}
               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 {
                                           );
          }
          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);
          }
          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
 }
 
 =head2 get_bugs


@@ -172,7 +179,7 @@ sub get_bugs{
      my %params = __collapse_params(@params);
      my @bugs;
      @bugs = Debbugs::Bugs::get_bugs(%params);
      my %params = __collapse_params(@params);
      my @bugs;
      @bugs = Debbugs::Bugs::get_bugs(%params);

-     return \@bugs;
+     return encode_utf8_structure(\@bugs);

 }
 
 =head2 newest_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();
      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 $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;
          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++;
      my @messages;
      while (my $record = $log->read_record()) {
          $current_msg++;


@@ -255,7 +255,7 @@ sub get_bug_log{
                          msg_num => $current_msg,
                         };
      }
                          msg_num => $current_msg,
                         };
      }

-     return \@messages;
+     return encode_utf8_structure(\@messages);

 }
 
 =head2 binary_to_source
 }
 
 =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.
 
 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
 
 
 =cut
 


@@ -276,7 +281,15 @@ sub binary_to_source{
      my $VERSION = __populate_version(pop);
      my ($self,@params) = @_;
 
      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
 }
 
 =head2 source_to_binary


@@ -297,7 +310,7 @@ sub source_to_binary {
      my $VERSION = __populate_version(pop);
      my ($self,@params) = @_;
 
      my $VERSION = __populate_version(pop);
      my ($self,@params) = @_;
 

-     return [Debbugs::Packages::sourcetobinary(@params)];
+     return encode_utf8_structure([Debbugs::Packages::sourcetobinary(@params)]);

 }
 
 =head2 get_versions
 }
 
 =head2 get_versions


@@ -334,7 +347,7 @@ architectures are at which versions.
 
 =back
 
 
 =back
 

-This function correponds to L<Debbugs::Packages::get_versions>
+This function corresponds to L<Debbugs::Packages::get_versions>

 
 =cut
 
 
 =cut
 


@@ -342,7 +355,7 @@ sub get_versions{
      my $VERSION = __populate_version(pop);
      my ($self,@params) = @_;
 
      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
 }
 
 =head1 VERSION COMPATIBILITY