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>.
26 use vars qw($DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
27 use base qw(Exporter SOAP::Server::Parameters);
30 $DEBUG = 0 unless defined $DEBUG;
36 Exporter::export_ok_tags();
37 $EXPORT_TAGS{all} = [@EXPORT_OK];
43 use Debbugs::Status qw(get_bug_status);
44 use Debbugs::Common qw(make_list getbuglocation getbugcomponent);
45 use Storable qw(nstore retrieve);
48 our $CURRENT_VERSION = 1;
49 our %DEBBUGS_SOAP_COOKIES;
54 my %ut = get_usertag('don@donarmstrong.com','this-bug-sucks','eat-this-bug');
56 Returns a hashref of bugs which have the specified usertags for the
61 use Debbugs::User qw(read_usertags);
64 my $VERSION = __populate_version(pop);
65 my ($self,$email, @tags) = @_;
67 read_usertags(\%ut, $email);
69 @tags{@tags} = (1) x @tags;
71 for my $tag (keys %ut) {
72 delete $ut{$tag} unless exists $tags{$tag};
83 my @statuses = get_status(@bugs);
85 Returns an arrayref of hashrefs which output the status for specific
88 See L<Debbugs::Status::get_bug_status> for details.
93 my $VERSION = __populate_version(pop);
94 my ($self,@bugs) = @_;
95 @bugs = make_list(@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;
104 # __prepare_response($self);
110 my @bugs = get_bugs(...);
112 See L<Debbugs::Bugs::get_bugs> for details.
116 use Debbugs::Bugs qw();
119 my $VERSION = __populate_version(pop);
120 my ($self,@params) = @_;
122 # Because some clients can't handle passing arrayrefs, we allow
123 # options to be specified multiple times
124 while (my ($key,$value) = splice @params,0,2) {
125 push @{$params{$key}}, make_list($value);
127 # However, for singly specified options, we want to pull them
129 for my $key (keys %params) {
130 if (@{$params{$key}} == 1) {
131 ($params{$key}) = @{$params{$key}}
135 @bugs = Debbugs::Bugs::get_bugs(%params);
142 my $bug_log = get_bug_log($bug);
143 my $bug_log = get_bug_log($bug,$msg_num);
145 Retuns a parsed set of the bug log; this is an array of hashes with
164 use Debbugs::Log qw();
165 use Debbugs::MIME qw(parse);
168 my ($self,$bug,$msg_num) = @_;
170 my $location = getbuglocation($bug,'log');
171 my $bug_log = getbugcomponent($bug,'log',$location);
173 my $log_fh = IO::File->new($bug_log, 'r') or
174 die "Unable to open bug log $bug_log for reading: $!";
176 my $log = Debbugs::Log->new($log_fh) or
177 die "Debbugs::Log was unable to be initialized";
183 while (my $record = $log->read_record()) {
185 print STDERR "message $current_msg\n";
186 #next if defined $msg_num and ($current_msg ne $msg_num);
187 print STDERR "still message $current_msg\n";
188 next unless $record->{type} eq 'incoming-recv';
189 my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im;
190 next if defined $msg_id and exists $seen_msg_ids{$msg_id};
191 $seen_msg_ids{$msg_id} = 1 if defined $msg_id;
192 next if defined $msg_id and $msg_id =~ /handler\..+\.ack(?:info)?\@/;
193 my $message = parse($record->{text});
194 my ($header,$body) = map {join("\n",make_list($_))}
196 print STDERR "still still message $current_msg\n";
197 push @messages,{html => $record->{html},
201 msg_num => $current_msg,
208 =head1 VERSION COMPATIBILITY
210 The functionality provided by the SOAP interface will change over time.
212 To the greatest extent possible, we will attempt to provide backwards
213 compatibility with previous versions; however, in order to have
214 backwards compatibility, you need to specify the version with which
219 sub __populate_version{
221 return $request->{___debbugs_soap_version};