#!/usr/bin/perl # Test interpretation of WSDL faults. use warnings; use strict; use lib 'lib','t'; use TestTools; use Data::Dumper; $Data::Dumper::Indent = 1; use XML::Compile::WSDL11; use XML::Compile::Transport::SOAPHTTP; use XML::Compile::Util qw/SCHEMA2001/; use XML::Compile::SOAP::Util qw/WSDL11 WSDL11SOAP SOAP11HTTP/; use XML::Compile::Tester; use XML::Compile::SOAP11; use Test::More tests => 12; use Test::Deep; #use Log::Report mode => 'DEBUG'; my $testNS = 'http://any-ns'; my $schema2001 = SCHEMA2001; my $wsdl11 = WSDL11; my $wsdl11soap = WSDL11SOAP; my $soap11http = SOAP11HTTP; my $xml_wsdl = <<"__WSDL"; My two-way service __WSDL ### ### BEGIN OF TESTS ### my $wsdl = XML::Compile::WSDL11->new($xml_wsdl); ok(defined $wsdl, "created object"); isa_ok($wsdl, 'XML::Compile::WSDL11'); my $op = eval { $wsdl->operation('doSend') }; my $err = $@ || ''; ok(defined $op, 'existing operation'); is($@, '', 'no errors'); isa_ok($op, 'XML::Compile::Operation'); isa_ok($op, 'XML::Compile::SOAP11::Operation'); is($op->kind, 'request-response'); my $client = $op->compileClient(transport_hook => \&fake_server); ok(defined $client, 'compiled client'); isa_ok($client, 'CODE'); my ($answer, $trace) = $client->(body => 999); ok(defined $answer, 'got answer'); is($answer->{Fault}->{faultstring}, 'any-ns.WentWrong', 'got fault string'); is($answer->{WentWrong}{message}, 'Oh noes', 'parsed response XML'); sub fake_server($$) { my ($request, $trace) = @_; my $content = $request->decoded_content; if($content =~ m!]*>999!) { return HTTP::Response->new(500, 'Internal Server Error' , [ 'Content-Type' => 'text/xml;charset=utf-8' ], <<__RESPONSE); env:Server any-ns.WentWrong Oh noes __RESPONSE } else { return HTTP::Response->new(202, 'accepted' , [ 'Content-Type' => 'text/plain' ], 'there is no body'); } }