#!/usr/bin/perl # Test SOAP mustUnderstand use warnings; use strict; use lib 'lib','t'; use TestTools; use Test::Deep qw/cmp_deeply/; use Data::Dumper; $Data::Dumper::Indent = 1; use XML::Compile::SOAP11::Client; use XML::Compile::Tester; use Test::More tests => 18; use XML::LibXML; #use Log::Report mode => 'DEBUG'; my $schema = <<__HELPERS; __HELPERS # # Create and interpret a message # my $soap = XML::Compile::SOAP11::Client->new; $soap->schemas->importDefinitions($schema); my @msg_struct = ( header => [ count => "{$TestNS}good" ] , mustUnderstand => 'count' ); my $sender = $soap->compileMessage(SENDER => @msg_struct); is(ref $sender, 'CODE', 'compiled a sender'); my $receiver = $soap->compileMessage(RECEIVER => @msg_struct); is(ref $receiver, 'CODE', 'compiled a receiver'); # # First, the data is present # my $msg1_soap = <<__MSG1; 3 __MSG1 # sender my $xml1a = $sender->(count => 3); isa_ok($xml1a, 'XML::LibXML::Node', 'produced XML'); compare_xml($xml1a, $msg1_soap); my $xml1b = $sender->( {count => 3} ); isa_ok($xml1b, 'XML::LibXML::Node', 'produced XML'); compare_xml($xml1b, $msg1_soap); # receiver my $hash1 = $receiver->($msg1_soap); is(ref $hash1, 'HASH', 'produced HASH'); cmp_deeply($hash1, {count => 3}, "server parsed input"); ### ### Now, the receiver does not understand the count header ### my $receiver2 = $soap->compileMessage('RECEIVER'); is(ref $receiver2, 'CODE', 'compiled unknowing receiver'); my $hash2 = $receiver2->($msg1_soap); ok(defined $hash2, 'received2 works'); is(ref $hash2, 'HASH', 'produced HASH'); ok(defined $hash2->{Fault}, 'fault'); ok(defined $hash2->{Fault}{faultcode}, 'faultcode'); ok(defined $hash2->{Fault}{faultstring}, 'faultstring'); # # any sender must accept faults # my $msg2_soap = <<__FAULT; SOAP-ENV:MustUnderstand SOAP mustUnderstand {http://test-types}good __FAULT # remove fault decoding extras delete $hash2->{header}; delete $hash2->{delete $hash2->{Fault}{_NAME}}; my $xml2 = $sender->($hash2); isa_ok($xml2, 'XML::LibXML::Node', 'produced XML fault'); compare_xml($xml2, $msg2_soap, 'correct structure'); # # and any receiver can decode them # # See XML::Compile README.todo: initial prefix problem: we need to # stringify and reparse the XML structure. my $hash3 = $receiver->($xml2->toString); ok(defined $hash3, 'received decodes fault'); is(ref $hash3, 'HASH');