#!/usr/bin/perl # Test SOAP 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::SOAP::Util qw/SOAP11ENV/; use XML::Compile::Tester; use Test::More tests => 35; use XML::LibXML; my $soap11_env = SOAP11ENV; my $schema = <<__HELPERS; __HELPERS # # Create and interpret a message # my $soap = XML::Compile::SOAP11::Client->new; isa_ok($soap, 'XML::Compile::SOAP11::Client'); isa_ok($soap, 'XML::Compile::SOAP11'); $soap->schemas->importDefinitions($schema); #warn "$_\n" for sort $soap->schemas->elements; my @msg_struct = ( body => [ request => "{$TestNS}good" ] , faults => [ fault1 => "{$TestNS}fault_one" ] ); 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'); # # Message 1 is ok # # sender my $msg1_soap = <<__MSG1; 3 __MSG1 my $xml1a = $sender->(request => 3); isa_ok($xml1a, 'XML::LibXML::Node', 'produced XML'); compare_xml($xml1a, $msg1_soap); my $xml1b = $sender->( {request => 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, {request => 3}, "server parsed input"); # # Message 2 is fault1 # my $msg2_soap = <<__MSG2; SOAP-ENV:Server.first my mistake http://schemas.xmlsoap.org/soap/actor/next please ignore __MSG2 my %fault1 = ( fault1 => { faultcode => "{$soap11_env}Server.first" , faultstring => 'my mistake' , faultactor => 'NEXT' , detail => { help => 'please ignore' } } ); my $xml2 = $sender->(%fault1); ok(defined $xml2, 'send message 2: fault1'); compare_xml($xml2, $msg2_soap); my $hash2 = $receiver->($msg2_soap); is(ref $hash2, 'HASH', 'produced HASH'); ### test Fault ok(exists $hash2->{Fault}, 'encoded fault present'); my $fault = $hash2->{Fault}; ok(defined $fault); like($fault->{faultcode}, qr/^\{.*\}Server.first$/, 'faultcode'); like($fault->{faultactor}, qr/^http:/, 'faultactor'); is($fault->{faultstring}, 'my mistake', 'faultstring'); ok(defined $fault->{detail}, 'detail'); is(ref $fault->{detail}, 'HASH'); my @keys = keys %{$fault->{detail}}; cmp_ok(scalar @keys, '==', 1); my $key = $keys[0]; is($key, "fault_one"); my $one = $fault->{detail}{$key}; ok(defined $one, 'has one'); is(ref $one, 'HASH'); cmp_ok(keys(%$one), '==', 1); is($one->{help}, 'please ignore'); ### test fault1 ok(exists $hash2->{fault1}, 'decoded fault present'); my $fault1 = $hash2->{fault1}; ok(defined $fault1); is($fault1->{reason}, 'my mistake', 'reason'); like($fault1->{code}, qr/^\{.*\}Server.first$/, 'code'); is($fault1->{role}, 'NEXT', 'role'); my $class = $fault1->{class}; ok(defined $class, "class"); is($class->[1], 'Receiver'); is($class->[2], 'first'); ok(defined $fault1->{help});