#!/usr/bin/perl # Test interpretation of WSDL. # The definitions are copied frm the the WSDL 1.1 technical report, # available from http://www.w3.org/TR/wsdl/ # with bugfix: # - # + 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::SOAP::Util qw/WSDL11 SOAP11HTTP/; use XML::Compile::Tester; use XML::Compile::SOAP11; use Test::More tests => 39; use Test::Deep; #use Log::Report mode => 'DEBUG'; my $xml_xsd = <<__STOCKQUOTE_XSD; __STOCKQUOTE_XSD my $xml_wsdl = <<'__STOCKQUOTE_WSDL'; __STOCKQUOTE_WSDL my $servns = 'http://example.com/stockquote/service'; my $servlocal = 'StockQuoteService'; my $servname = "{$servns}$servlocal"; my $xml_service = <<'__STOCKQUOTESERVICE_WSDL'; My first service __STOCKQUOTESERVICE_WSDL ### ### BEGIN OF TESTS ### my $wsdl = XML::Compile::WSDL11->new($xml_service); ok(defined $wsdl, "created object"); isa_ok($wsdl, 'XML::Compile::WSDL11'); is($wsdl->findName('wsdl:'), WSDL11); my @services = $wsdl->findDef('service'); cmp_ok(scalar(@services), '==', 1, 'find service list context'); is($services[0]->{name}, $servlocal); my $s = eval { $wsdl->findDef(service => 'aap') }; my $err = $@; $err =~ s! at t/80.*\n$!!; ok(!defined $s, 'find non-existing service'); is($err, <<'__ERR'); error: no definition for `aap' as service, pick from: {http://example.com/stockquote/service}StockQuoteService __ERR $s = eval { $wsdl->findDef(service => $servname) }; $err = $@; ok(defined $s, "request existing service $servlocal"); is($@, '', 'no errors'); ok(UNIVERSAL::isa($s, 'HASH')); my $s2 = eval { $wsdl->findDef('service') }; $err = $@; ok(defined $s, "request only service, not by name"); is($@, '', 'no errors'); cmp_ok($s, '==', $s2, 'twice same definition'); #warn Dumper $s; $wsdl->importDefinitions($xml_xsd); $wsdl->addWSDL($xml_wsdl); my $op = eval { $wsdl->operation('noot') }; $err = $@; $err =~ s!\sat t/80.*\n$!\n!; ok(!defined $op, "non-existing operation"); is($err, <<'__ERR'); error: no operation `noot' for portType {http://example.com/stockquote/definitions}StockQuotePortType, pick from GetLastTradePrice __ERR $op = eval { $wsdl->operation('GetLastTradePrice') }; $err = $@ || ''; ok(defined $op, 'existing operation'); is($@, '', 'no errors'); isa_ok($op, 'XML::Compile::SOAP11::Operation'); is($op->kind, 'request-response'); #delete $op->{schemas}; # far too much to dump #warn Dumper $op; exit 1; # # collect some basic facts # my @addrs = $op->endPoints; cmp_ok(scalar @addrs, '==', 1, 'get endpoint address'); is($addrs[0], 'http://example.com/stockquote'); my $http1 = 'http://schemas.xmlsoap.org/soap/http'; is($op->action, 'http://example.com/GetLastTradePrice', 'action'); is($op->style, 'document'); is($op->transport, SOAP11HTTP); # # test $wsdl->operations # my @ops = $wsdl->operations; cmp_ok(scalar @ops, '==', 1, 'one op hash listed'); $op = shift @ops; isa_ok($op, 'XML::Compile::Operation'); isa_ok($op, 'XML::Compile::SOAP11::Operation'); is($op->name, 'GetLastTradePrice', 'got name'); is($op->action, 'http://example.com/GetLastTradePrice', 'got action'); is($op->serviceName, 'StockQuoteService'); is($op->bindingName, 'StockQuoteSoapBinding'); is($op->portName, 'StockQuotePort'); is($op->portTypeName, 'StockQuotePortType'); # # test $wsdl->printIndex # my $x = ''; open my($out), '>', \$x; $wsdl->printIndex($out); close $out; is($x, <<_INDEX); service StockQuoteService port StockQuotePort (binding StockQuoteSoapBinding) GetLastTradePrice _INDEX ### 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'); HTTP::Response->new(200, 'answer manually created' , [ 'Content-Type' => 'text/xml' ], $server_answers); } # # create client # my $client = $op->compileClient ( transport_hook => \&fake_server , sloppy_floats => 1 ); ok(defined $client, 'compiled client'); isa_ok($client, 'CODE'); $server_expects = <<__EXPECTED; IBM __EXPECTED $server_answers = <<__ANSWER; 3.14 __ANSWER my $answer = $client->(tickerSymbol => 'IBM'); ok(defined $answer, 'got answer'); cmp_deeply($answer, {body => {price => 3.14}}); # body is the name of the part