X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FSOAP.pm;h=5cb08bb0f11eff7de6ab49dea880731a13dcb8b3;hb=e0b92922e7d92a6f1d0f6a91a5e6c3b3d174ae1c;hp=e7f159c497ad3375ce4302f32f883c1df40cd1ef;hpb=c8a3df6bfa30636dfb5e29bedd54d3a3a3df2109;p=debbugs.git diff --git a/Debbugs/SOAP.pm b/Debbugs/SOAP.pm index e7f159c..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,14 +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 @@ -73,7 +76,7 @@ sub get_usertag { delete $ut{$tag} unless exists $tags{$tag}; } } - return \%ut; + return encode_utf8_structure(\%ut); } @@ -98,6 +101,12 @@ L besides the bug number; in the 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 for details. =cut @@ -106,13 +115,24 @@ sub get_status { 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}); + next unless defined $param{bug}; + $bug = $param{bug}; $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 { @@ -123,7 +143,7 @@ sub get_status { } } # __prepare_response($self); - return \%status; + return encode_utf8_structure(\%status); } =head2 get_bugs @@ -153,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 @@ -169,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]); } @@ -206,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; @@ -236,9 +250,108 @@ sub get_bug_log{ 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 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) + +=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 + +=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