Debbugs/SOAP.pm

   1 # This module is part of debbugs, and is released
   2 # under the terms of the GPL version 2, or any later version at your option.
   3 # See the file README and COPYING for more information.
   4 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
   5
   6 package Debbugs::SOAP;
   7
   8 =head1 NAME
   9
  10 Debbugs::SOAP --
  11
  12 =head1 SYNOPSIS
  13
  14
  15 =head1 DESCRIPTION
  16
  17
  18 =head1 BUGS
  19
  20 None known.
  21
  22 =cut
  23
  24 use warnings;
  25 use strict;
  26 use vars qw($DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  27 use base qw(Exporter SOAP::Server::Parameters);
  28
  29 BEGIN{
  30      $DEBUG = 0 unless defined $DEBUG;
  31
  32      @EXPORT = ();
  33      %EXPORT_TAGS = (
  34                     );
  35      @EXPORT_OK = ();
  36      Exporter::export_ok_tags();
  37      $EXPORT_TAGS{all} = [@EXPORT_OK];
  38
  39 }
  40
  41
  42 use Debbugs::Status qw(get_bug_status);
  43 use Debbugs::Common qw(make_list);
  44 use Storable qw(nstore retrieve);
  45 use Debbugs::Cookies;
  46
  47
  48 our $CURRENT_VERSION = 1;
  49 our %DEBBUGS_SOAP_COOKIES;
  50
  51
  52 =head2 get_usertag
  53
  54      my %ut = get_usertag('don@donarmstrong.com','this-bug-sucks','eat-this-bug');
  55
  56 Returns a hashref of bugs which have the specified usertags for the
  57 user set.
  58
  59 =cut
  60
  61 use Debbugs::User qw(read_usertags);
  62
  63 sub get_usertag {
  64      my $VERSION = __populate_version(pop);
  65      my ($self,$email, @tags) = @_;
  66      my %ut = ();
  67      read_usertags(\%ut, $email);
  68      my %tags;
  69      @tags{@tags} = (1) x @tags;
  70      if (keys %tags > 0) {
  71           for my $tag (keys %ut) {
  72                delete $ut{$tag} unless exists $tags{$tag};
  73           }
  74      }
  75      return \%ut;
  76 }
  77
  78
  79 use Debbugs::Status;
  80
  81 =head2 get_status
  82
  83      my @statuses = get_status(@bugs);
  84
  85 Returns an arrayref of hashrefs which output the status for specific
  86 sets of bugs.
  87
  88 See L<Debbugs::Status::get_bug_status> for details.
  89
  90 =cut
  91
  92 sub get_status {
  93      my $VERSION = __populate_version(pop);
  94      my ($self,@bugs) = @_;
  95      @bugs = make_list(@bugs);
  96
  97      my %status;
  98      for my $bug (@bugs) {
  99           my $bug_status = get_bug_status(bug => $bug);
 100           if (defined $bug_status and keys %{$bug_status} > 0) {
 101                $status{$bug}  = $bug_status;
 102           }
 103      }
 104 #     __prepare_response($self);
 105      return \%status;
 106 }
 107
 108 =head2 get_bugs
 109
 110      my @bugs = get_bugs(...);
 111
 112 See L<Debbugs::Bugs::get_bugs> for details.
 113
 114 =cut
 115
 116 use Debbugs::Bugs qw();
 117
 118 sub get_bugs{
 119      my $VERSION = __populate_version(pop);
 120      my ($self,@params) = @_;
 121      my %params;
 122      while (my ($key,$value) = splice @params,0,2) {
 123           push @{$params{$key}}, $value;
 124      }
 125      my @bugs;
 126      @bugs = Debbugs::Bugs::get_bugs(%params);
 127      return \@bugs;
 128 }
 129
 130
 131 =head1 VERSION COMPATIBILITY
 132
 133 The functionality provided by the SOAP interface will change over time.
 134
 135 To the greatest extent possible, we will attempt to provide backwards
 136 compatibility with previous versions; however, in order to have
 137 backwards compatibility, you need to specify the version with which
 138 you are compatible.
 139
 140 =cut
 141
 142 sub __populate_version{
 143      my ($request) = @_;
 144      return $request->{___debbugs_soap_version};
 145 }
 146
 147 1;
 148
 149
 150 __END__
 151
 152
 153
 154
 155
 156