t/09_soap.t

   1 # -*- mode: cperl;-*-
   2
   3
   4 use Test::More tests => 4;
   5
   6 use warnings;
   7 use strict;
   8
   9 # Here, we're going to shoot messages through a set of things that can
  10 # happen.
  11
  12 # First, we're going to send mesages to receive.
  13 # To do so, we'll first send a message to submit,
  14 # then send messages to the newly created bugnumber.
  15
  16 use IO::File;
  17 use File::Temp qw(tempdir);
  18 use Cwd qw(getcwd);
  19 use Debbugs::MIME qw(create_mime_message);
  20 use File::Basename qw(dirname basename);
  21 use Test::WWW::Mechanize;
  22 # The test functions are placed here to make things easier
  23 use lib qw(t/lib);
  24 use DebbugsTest qw(:configuration);
  25 use Cwd;
  26
  27 my %config;
  28 eval {
  29      %config = create_debbugs_configuration(debug => exists $ENV{DEBUG}?$ENV{DEBUG}:0);
  30 };
  31 if ($@) {
  32      BAIL_OUT($@);
  33 }
  34
  35 # Output some debugging information if there's an error
  36 END{
  37      if ($ENV{DEBUG}) {
  38           foreach my $key (keys %config) {
  39                diag("$key: $config{$key}\n");
  40           }
  41      }
  42 }
  43
  44 # create a bug
  45 send_message(to=>'submit@bugs.something',
  46              headers => [To   => 'submit@bugs.something',
  47                          From => 'foo@bugs.something',
  48                          Subject => 'Submitting a bug',
  49                         ],
  50              body => <<EOF) or fail('Unable to send message');
  51 Package: foo
  52 Severity: normal
  53
  54 This is a silly bug
  55 EOF
  56
  57
  58 # test bugreport.cgi
  59
  60 my $port = 11343;
  61
  62 # We'd like to use soap.cgi here instead of testing the module
  63 # directly, but I can't quite get it to work with
  64 # HTTP::Server::Simple.
  65 use_ok('Debbugs::SOAP');
  66 use_ok('Debbugs::SOAP::Server');
  67
  68 our $child_pid = undef;
  69
  70 END{
  71      if (defined $child_pid) {
  72           kill(15,$child_pid);
  73           waitpid(-1,0);
  74      }
  75 }
  76
  77 my $pid = fork;
  78 die "Unable to fork child" if not defined $pid;
  79 if ($pid) {
  80      $child_pid = $pid;
  81      # Wait for two seconds to let the child start
  82      sleep 2;
  83 }
  84 else {
  85      # UGH.
  86      eval q(
  87      use Debbugs::SOAP::Server;
  88      @Debbugs::SOAP::Server::ISA = qw(SOAP::Transport::HTTP::Daemon);
  89      Debbugs::SOAP::Server
  90                ->new(LocalAddr => 'localhost', LocalPort => $port)
  91                     ->dispatch_to('/','Debbugs::SOAP')
  92                          ->handle;
  93      );
  94 }
  95
  96 use SOAP::Lite;
  97 my $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://localhost:'.$port.'/');
  98 #ok($soap->get_soap_version->result == 1,'Version set and got correctly');
  99 my $bugs = $soap->get_bugs(package => 'foo')->result;
 100 use Data::Dumper;
 101 ok(@{$bugs} == 1 && $bugs->[0] == 1, 'get_bugs returns bug number 1') or fail(Dumper($bugs));
 102 my $status = $soap->get_status(1)->result;
 103 ok($status->{1}{package} eq 'foo','get_status thinks that bug 1 belongs in foo') or fail(Dumper($status));
 104
 105 # Test the usertags at some point