Debbugs::SOAP uses encode_utf8_structure from Debbugs::Common

[debbugs.git] / Debbugs / SOAP.pm

diff --git a/Debbugs/SOAP.pm b/Debbugs/SOAP.pm
index 2ca5b21261e4d355a699493c1dcccddc3561c4fe..5cb08bb0f11eff7de6ab49dea880731a13dcb8b3 100644 (file)
--- 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 warnings;
 use strict;
 use vars qw($DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);

+use Debbugs::SOAP::Server;

 use base qw(Exporter SOAP::Server::Parameters);
 
 BEGIN{
 use base qw(Exporter SOAP::Server::Parameters);
 
 BEGIN{


@@ -38,15 +39,16 @@ BEGIN{
 
 }
 
 
 }
 

-

 use IO::File;
 use Debbugs::Status qw(get_bug_status);
 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);
 
 
 use Scalar::Util qw(looks_like_number);
 
 

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

 
 =head2 get_usertag
 
 
 =head2 get_usertag
 


@@ -74,7 +76,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);

 }
 
 
 }
 
 


@@ -141,7 +143,7 @@ sub get_status {
          }
      }
 #     __prepare_response($self);
          }
      }
 #     __prepare_response($self);

-     return \%status;
+     return encode_utf8_structure(\%status);

 }
 
 =head2 get_bugs
 }
 
 =head2 get_bugs


@@ -171,7 +173,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


@@ -187,7 +189,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]);

 
 }
 
 
 }
 


@@ -224,13 +226,7 @@ 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;
          die "Debbugs::Log was unable to be initialized";
 
      my %seen_msg_ids;


@@ -254,7 +250,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


@@ -267,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.
 
 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);
 
 =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
 }
 
 =head2 source_to_binary


@@ -293,8 +303,9 @@ architecture is not returned.
 
 sub source_to_binary {
      my $VERSION = __populate_version(pop);
 
 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
 }
 
 =head2 get_versions


@@ -337,8 +348,9 @@ This function correponds to L<Debbugs::Packages::get_versions>
 
 sub get_versions{
      my $VERSION = __populate_version(pop);
 
 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
 }
 
 =head1 VERSION COMPATIBILITY