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
  46
  47 our $CURRENT_VERSION = 1;
  48 our %DEBBUGS_SOAP_COOKIES;
  49
  50
  51 =head2 get_usertag
  52
  53      my %ut = get_usertag('don@donarmstrong.com','this-bug-sucks','eat-this-bug');
  54
  55 Returns a hashref of bugs which have the specified usertags for the
  56 user set.
  57
  58 =cut
  59
  60 use Debbugs::User qw(read_usertags);
  61
  62 sub get_usertag {
  63      my $VERSION = __populate_version(pop);
  64      my ($self,$email, @tags) = @_;
  65      my %ut = ();
  66      read_usertags(\%ut, $email);
  67      my %tags;
  68      @tags{@tags} = (1) x @tags;
  69      if (keys %tags > 0) {
  70           for my $tag (keys %ut) {
  71                delete $ut{$tag} unless exists $tags{$tag};
  72           }
  73      }
  74      return \%ut;
  75 }
  76
  77
  78 use Debbugs::Status;
  79
  80 =head2 get_status
  81
  82      my @statuses = get_status(@bugs);
  83
  84 Returns an arrayref of hashrefs which output the status for specific
  85 sets of bugs.
  86
  87 See L<Debbugs::Status::get_bug_status> for details.
  88
  89 =cut
  90
  91 sub get_status {
  92      my $VERSION = __populate_version(pop);
  93      my ($self,@bugs) = @_;
  94      @bugs = make_list(@bugs);
  95
  96      my %status;
  97      for my $bug (@bugs) {
  98           my $bug_status = get_bug_status(bug => $bug);
  99           if (defined $bug_status and keys %{$bug_status} > 0) {
 100                $status{$bug}  = $bug_status;
 101           }
 102      }
 103 #     __prepare_response($self);
 104      return \%status;
 105 }
 106
 107 =head2 get_bugs
 108
 109      my @bugs = get_bugs(...);
 110
 111 See L<Debbugs::Bugs::get_bugs> for details.
 112
 113 =cut
 114
 115 use Debbugs::Bugs qw();
 116
 117 sub get_bugs{
 118      my $VERSION = __populate_version(pop);
 119      my ($self,@params) = @_;
 120      my %params;
 121      while (my ($key,$value) = splice @params,0,2) {
 122           push @{$params{$key}}, $value;
 123      }
 124      my @bugs;
 125      @bugs = Debbugs::Bugs::get_bugs(%params);
 126      return \@bugs;
 127 }
 128
 129
 130 =head1 VERSION COMPATIBILITY
 131
 132 The functionality provided by the SOAP interface will change over time.
 133
 134 To the greatest extent possible, we will attempt to provide backwards
 135 compatibility with previous versions; however, in order to have
 136 backwards compatibility, you need to specify the version with which
 137 you are compatible.
 138
 139 =cut
 140
 141 sub __populate_version{
 142      my ($request) = @_;
 143      return $request->{___debbugs_soap_version};
 144 }
 145
 146 1;
 147
 148
 149 __END__
 150
 151
 152
 153
 154
 155