X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=t%2F09_soap.t;h=266c4c5ed26f2456de230621e417b0058d03d892;hb=0e67d0e2daba4319f2d2e6ff368a9ba3e39789ed;hp=2a04c60e07da530176262ced80b81d4150a16690;hpb=46fa42780ecb746d7bec2fb01190b05584b9283e;p=debbugs.git diff --git a/t/09_soap.t b/t/09_soap.t index 2a04c60..266c4c5 100644 --- a/t/09_soap.t +++ b/t/09_soap.t @@ -17,22 +17,8 @@ use lib qw(t/lib); use DebbugsTest qw(:configuration); use Cwd; -my %config; -eval { - %config = create_debbugs_configuration(debug => exists $ENV{DEBUG}?$ENV{DEBUG}:0); -}; -if ($@) { - BAIL_OUT($@); -} +my %config = create_debbugs_configuration(); -# Output some debugging information if we're debugging -END{ - if ($ENV{DEBUG}) { - foreach my $key (keys %config) { - diag("$key: $config{$key}\n"); - } - } -} # create a bug send_message(to=>'submit@bugs.something', @@ -81,20 +67,33 @@ else { eval q( use Debbugs::SOAP::Server; @Debbugs::SOAP::Server::ISA = qw(SOAP::Transport::HTTP::Daemon); - Debbugs::SOAP::Server + our $warnings = ''; + eval { + # Ignore stupid warning because elements (hashes) can't start with + # numbers + local $SIG{__WARN__} = sub {$warnings .= $_[0] unless $_[0] =~ /Cannot encode unnamed element/}; + Debbugs::SOAP::Server ->new(LocalAddr => 'localhost', LocalPort => $port) ->dispatch_to('/','Debbugs::SOAP') ->handle; + }; + die $@ if $@; + warn $warnings if length $warnings; + ); } use SOAP::Lite; my $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://localhost:'.$port.'/'); #ok($soap->get_soap_version->result == 1,'Version set and got correctly'); -my $bugs = $soap->get_bugs(package => 'foo')->result; +my $bugs_result = $soap->get_bugs(package => 'foo'); +my $bugs = $bugs_result->result; use Data::Dumper; +#print STDERR Dumper($bugs_result); ok(@{$bugs} == 1 && $bugs->[0] == 1, 'get_bugs returns bug number 1') or fail(Dumper($bugs)); -my $status = $soap->get_status(1)->result; +my $status_result = $soap->get_status(1); +#print STDERR Dumper($status_result); +my $status = $status_result->result; ok($status->{1}{package} eq 'foo','get_status thinks that bug 1 belongs in foo') or fail(Dumper($status)); # Test the usertags at some point