#!/usr/bin/perl # Test SOAP use warnings; use strict; use lib 'lib','t'; use TestTools; use Test::Deep qw/cmp_deeply/; #use Log::Report mode => 3; # debugging use Data::Dumper; $Data::Dumper::Indent = 1; use XML::Compile::WSDL11; use XML::Compile::Tester; use Test::More tests => 24; use XML::LibXML; use XML::Compile::SOAP::Util ':soap11'; use XML::Compile::SOAP11; use XML::Compile::Transport::SOAPHTTP; my $NS = 'urn:example:wsdl'; my $NSEXP = 'urn:sonae:elegibilidade:exp'; my $soapenv = SOAP11ENV; my $schema = <<_SCHEMA; _SCHEMA ### HELPER my ($server_expects, $server_answers); sub fake_server($$) { my ($request, $trace) = @_; my $content = $request->decoded_content; compare_xml($content, $server_expects, 'fake server received'); #warn "CONTENT=$content###"; HTTP::Response->new(200, 'answer manually created' , [ 'Content-Type' => 'text/xml' ], $server_answers); } # # 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'); my $wsdl = XML::Compile::WSDL11->new($schema); ok(defined $wsdl, "created object"); isa_ok($wsdl, 'XML::Compile::WSDL11'); $wsdl->prefixes(sonae => $NSEXP); # # Element part # ok(1, "** using element"); my $eop = $wsdl->operation('usingElement'); isa_ok($eop, 'XML::Compile::SOAP11::Operation'); is($eop->name, 'usingElement'); is($eop->style, 'rpc'); my $er = $eop->compileClient(transport_hook => \&fake_server); isa_ok($er, 'CODE'); $server_expects = <<_EXPECTS; 1aap 2noot 3mies _EXPECTS $server_answers = <<_ANSWER; 3 _ANSWER my %data = ( item => [ { id => 1, name => 'aap' } , { id => 2, name => 'noot' } , { id => 3, name => 'mies' } ] ); my $ea = $er->(\%data); ok(defined $ea, 'got element answer'); my $u = $ea->{usingElementResponse}; isa_ok($u, 'HASH'); cmp_ok(keys %$u, '==', 1); is($u->{result}, '3'); # # Type part # ok(1, "** using type"); my $top = $wsdl->operation('usingType'); isa_ok($top, 'XML::Compile::SOAP11::Operation', 'using type'); is($top->name, 'usingType'); is($top->style, 'rpc'); my $tr = $top->compileClient(transport_hook => \&fake_server); isa_ok($tr, 'CODE'); $server_expects = <<_REQUEST; 1aap 2noot 3mies _REQUEST $server_answers = <<_ANSWER; 5 _ANSWER my $ta = $tr->(%data); ok(defined $ta, 'got type answer'); my $r = $ta->{usingTypeResponse}; isa_ok($r, 'HASH'); cmp_ok(keys %$r, '==', 1); is($r->{result}, '5');