#!/usr/bin/env 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;
<schema targetNamespace="$TestNS"
xmlns="$SchemaNS">
<element name="good" type="int"/>
<element name="fault_one">
<complexType>
<sequence>
<element name="help" type="string" />
</sequence>
</complexType>
</element>
<element name="fault_two" nillable="true">
<complexType>
<sequence/>
</complexType>
</element>
</schema>
__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;
<?xml version="1.0" encoding="UTF-8"?>
<SOAP-ENV:Envelope xmlns:SOAP-ENV="$soap11_env">
<SOAP-ENV:Body>
<x0:good xmlns:x0="$TestNS">3</x0:good>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
__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;
<?xml version="1.0" encoding="UTF-8"?>
<SOAP-ENV:Envelope xmlns:SOAP-ENV="$soap11_env">
<SOAP-ENV:Body>
<SOAP-ENV:Fault
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
<faultcode>SOAP-ENV:Server.first</faultcode>
<faultstring>my mistake</faultstring>
<faultactor>http://schemas.xmlsoap.org/soap/actor/next</faultactor>
<detail>
<x0:fault_one xmlns:x0="$TestNS">
<help>please ignore</help>
</x0:fault_one>
</detail>
</SOAP-ENV:Fault>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
__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, 'compare sent');
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, "{$TestNS}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
#use Data::Dumper;
#warn Dumper $hash2;
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});