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 e7f159c497ad3375ce4302f32f883c1df40cd1ef..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,14 +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);

 
 
 
 

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

 
 =head2 get_usertag
 
 
 =head2 get_usertag
 


@@ -73,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);

 }
 
 
 }
 
 


@@ -98,6 +101,12 @@ 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.
 
 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
 See L<Debbugs::Status::get_bug_status> for details.
 
 =cut


@@ -106,13 +115,24 @@ sub get_status {
      my $VERSION = __populate_version(pop);
      my ($self,@bugs) = @_;
 
      my $VERSION = __populate_version(pop);
      my ($self,@bugs) = @_;
 

+     if (@bugs == 1 and
+        ref($bugs[0]) 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;
          if (ref($bug)) {
               my %param = __collapse_params(@{$bug});
      my %status;
      for my $bug (@bugs) {
          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{$_}):()}
               $bug_status = get_bug_status(map {(exists $param{$_})?($_,$param{$_}):()}

-                                           qw(bug dist arch bugusertags sourceversions version)
+                                           qw(bug dist arch bugusertags sourceversions version indicatesource)

                                           );
          }
          else {
                                           );
          }
          else {


@@ -123,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


@@ -153,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


@@ -169,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]);

 
 }
 
 
 }
 


@@ -206,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;


@@ -236,9 +250,108 @@ sub get_bug_log{
                          msg_num => $current_msg,
                         };
      }
                          msg_num => $current_msg,
                         };
      }

-     return \@messages;
+     return encode_utf8_structure(\@messages);
+}
+
+=head2 binary_to_source
+
+     binary_to_source($binary_name,$binary_version,$binary_architecture)
+
+Returns a reference to the source package name and version pair
+corresponding to a given binary package name, version, and
+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.
+
+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) = @_;
+
+     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
+
+     source_to_binary($source_name,$source_version);
+
+Returns a reference to an array of references to binary package name,
+version, and architecture corresponding to a given source package name
+and version. In the case that the given name and version cannot be
+found, the unversioned package to source map is consulted, and the
+architecture is not returned.
+
+(This function corresponds to L<Debbugs::Packages::sourcetobinary>)
+
+=cut
+
+sub source_to_binary {
+     my $VERSION = __populate_version(pop);
+     my ($self,@params) = @_;
+
+     return encode_utf8_structure([Debbugs::Packages::sourcetobinary(@params)]);

 }
 
 }
 

+=head2 get_versions
+
+     get_version(package=>'foopkg',
+                 dist => 'unstable',
+                 arch => 'i386',
+                );
+
+Returns a list of the versions of package in the distributions and
+architectures listed. This routine only returns unique values.
+
+=over
+
+=item package -- package to return list of versions
+
+=item dist -- distribution (unstable, stable, testing); can be an
+arrayref
+
+=item arch -- architecture (i386, source, ...); can be an arrayref
+
+=item time -- returns a version=>time hash at which the newest package
+matching this version was uploaded
+
+=item source -- returns source/version instead of just versions
+
+=item no_source_arch -- discards the source architecture when arch is
+not passed. [Used for finding the versions of binary packages only.]
+Defaults to 0, which does not discard the source architecture. (This
+may change in the future, so if you care, please code accordingly.)
+
+=item return_archs -- returns a version=>[archs] hash indicating which
+architectures are at which versions.
+
+=back
+
+This function correponds to L<Debbugs::Packages::get_versions>
+
+=cut
+
+sub get_versions{
+     my $VERSION = __populate_version(pop);
+     my ($self,@params) = @_;
+
+     return encode_utf8_structure(scalar Debbugs::Packages::get_versions(@params));
+}

 
 =head1 VERSION COMPATIBILITY
 
 
 =head1 VERSION COMPATIBILITY