]> git.donarmstrong.com Git - debbugs.git/blob - t/09_soap.t
Use PT|passthrough redirects for ^/([0-9]+)$ for bugreport.cgi & ^/([^/]+)$ for pkgre...
[debbugs.git] / t / 09_soap.t
1 # -*- mode: cperl;-*-
2
3
4 use Test::More tests => 4;
5
6 use warnings;
7 use strict;
8
9 use IO::File;
10 use File::Temp qw(tempdir);
11 use Cwd qw(getcwd);
12 use Debbugs::MIME qw(create_mime_message);
13 use File::Basename qw(dirname basename);
14 use Test::WWW::Mechanize;
15 # The test functions are placed here to make things easier
16 use lib qw(t/lib);
17 use DebbugsTest qw(:configuration);
18 use Cwd;
19
20 my %config = create_debbugs_configuration();
21
22
23 # create a bug
24 send_message(to=>'submit@bugs.something',
25              headers => [To   => 'submit@bugs.something',
26                          From => 'foo@bugs.something',
27                          Subject => 'Submitting a bug',
28                         ],
29              body => <<EOF) or fail('Unable to send message');
30 Package: foo
31 Severity: normal
32
33 This is a silly bug
34 EOF
35
36
37 # test the soap server
38
39 my $port = 11343;
40
41 # We'd like to use soap.cgi here instead of testing the module
42 # directly, but I can't quite get it to work with
43 # HTTP::Server::Simple.
44 use_ok('Debbugs::SOAP');
45 use_ok('Debbugs::SOAP::Server');
46
47 our $child_pid = undef;
48
49 END{
50      if (defined $child_pid) {
51           my $temp_exit = $?;
52           kill(15,$child_pid);
53           waitpid(-1,0);
54           $? = $temp_exit;
55      }
56 }
57
58 my $pid = fork;
59 die "Unable to fork child" if not defined $pid;
60 if ($pid) {
61      $child_pid = $pid;
62      # Wait for two seconds to let the child start
63      sleep 2;
64 }
65 else {
66      # UGH.
67      eval q(
68      use Debbugs::SOAP::Server;
69      @Debbugs::SOAP::Server::ISA = qw(SOAP::Transport::HTTP::Daemon);
70      our $warnings = '';
71      eval {
72        # Ignore stupid warning because elements (hashes) can't start with
73        # numbers
74        local $SIG{__WARN__} = sub {$warnings .= $_[0] unless $_[0] =~ /Cannot encode unnamed element/};
75        Debbugs::SOAP::Server
76                ->new(LocalAddr => 'localhost', LocalPort => $port)
77                     ->dispatch_to('/','Debbugs::SOAP')
78                          ->handle;
79       };
80       die $@ if $@;
81       warn $warnings if length $warnings;
82
83      );
84 }
85
86 use SOAP::Lite;
87 my $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://localhost:'.$port.'/');
88 #ok($soap->get_soap_version->result == 1,'Version set and got correctly');
89 my $bugs_result = $soap->get_bugs(package => 'foo');
90 my $bugs = $bugs_result->result;
91 use Data::Dumper;
92 #print STDERR Dumper($bugs_result);
93 ok(@{$bugs} == 1 && $bugs->[0] == 1, 'get_bugs returns bug number 1') or fail(Dumper($bugs));
94 my $status_result = $soap->get_status(1);
95 #print STDERR Dumper($status_result);
96 my $status = $status_result->result;
97 ok($status->{1}{package} eq 'foo','get_status thinks that bug 1 belongs in foo') or fail(Dumper($status));
98
99 # Test the usertags at some point