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;
  21 eval {
  22      %config = create_debbugs_configuration(debug => exists $ENV{DEBUG}?$ENV{DEBUG}:0);
  23 };
  24 if ($@) {
  25      BAIL_OUT($@);
  26 }
  27
  28 # Output some debugging information if we're debugging
  29 END{
  30      if ($ENV{DEBUG}) {
  31           foreach my $key (keys %config) {
  32                diag("$key: $config{$key}\n");
  33           }
  34      }
  35 }
  36
  37 # create a bug
  38 send_message(to=>'submit@bugs.something',
  39              headers => [To   => 'submit@bugs.something',
  40                          From => 'foo@bugs.something',
  41                          Subject => 'Submitting a bug',
  42                         ],
  43              body => <<EOF) or fail('Unable to send message');
  44 Package: foo
  45 Severity: normal
  46
  47 This is a silly bug
  48 EOF
  49
  50
  51 # test the soap server
  52
  53 my $port = 11343;
  54
  55 # We'd like to use soap.cgi here instead of testing the module
  56 # directly, but I can't quite get it to work with
  57 # HTTP::Server::Simple.
  58 use_ok('Debbugs::SOAP');
  59 use_ok('Debbugs::SOAP::Server');
  60
  61 our $child_pid = undef;
  62
  63 END{
  64      if (defined $child_pid) {
  65           my $temp_exit = $?;
  66           kill(15,$child_pid);
  67           waitpid(-1,0);
  68           $? = $temp_exit;
  69      }
  70 }
  71
  72 my $pid = fork;
  73 die "Unable to fork child" if not defined $pid;
  74 if ($pid) {
  75      $child_pid = $pid;
  76      # Wait for two seconds to let the child start
  77      sleep 2;
  78 }
  79 else {
  80      # UGH.
  81      eval q(
  82      use Debbugs::SOAP::Server;
  83      @Debbugs::SOAP::Server::ISA = qw(SOAP::Transport::HTTP::Daemon);
  84      our $warnings = '';
  85      eval {
  86        # Ignore stupid warning because elements (hashes) can't start with
  87        # numbers
  88        local $SIG{__WARN__} = sub {$warnings .= $_[0] unless $_[0] =~ /Cannot encode unnamed element/};
  89        Debbugs::SOAP::Server
  90                ->new(LocalAddr => 'localhost', LocalPort => $port)
  91                     ->dispatch_to('/','Debbugs::SOAP')
  92                          ->handle;
  93       };
  94       die $@ if $@;
  95       warn $warnings if length $warnings;
  96
  97      );
  98 }
  99
 100 use SOAP::Lite;
 101 my $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://localhost:'.$port.'/');
 102 #ok($soap->get_soap_version->result == 1,'Version set and got correctly');
 103 my $bugs_result = $soap->get_bugs(package => 'foo');
 104 my $bugs = $bugs_result->result;
 105 use Data::Dumper;
 106 #print STDERR Dumper($bugs_result);
 107 ok(@{$bugs} == 1 && $bugs->[0] == 1, 'get_bugs returns bug number 1') or fail(Dumper($bugs));
 108 my $status_result = $soap->get_status(1);
 109 #print STDERR Dumper($status_result);
 110 my $status = $status_result->result;
 111 ok($status->{1}{package} eq 'foo','get_status thinks that bug 1 belongs in foo') or fail(Dumper($status));
 112
 113 # Test the usertags at some point