[Xml-compile] FW: XML::Compile::WSDL11 and SOAP calls that return faults

Jamie Lentin Jamie.Lentin at bbc.co.uk
Thu Jul 31 17:26:11 BST 2008


Hi, I'm using XML::Compile::WSDL11 to talk SOAP to a system that has
operations that can return faults.

XML::Compile v0.85 (Tried 0.89, same behaviour)
XML::Compile::SOAP v0.73 (Tried 0.75, same behaviour)
XML::LibXML v1.65

It mostly works, however upon compiling clients, like the one in the
attached unit test[1] I get the following warning:-

Pseudo-hashes are deprecated at
/usr/local/perl5.8.8/site_perl/XML/Compile/WSDL11/Operation.pm line 433.

Delving deeper, XML::Compile::WSDL11::Operation::collectFaultParts()
seems to be getting a different data structure to what the code expects.
The following patch adjusts what the code expects until the attached
unit test is happy:-

---
/home/jamiel/scratch/XML-Compile-SOAP-0.75/lib/XML/Compile/WSDL11/Operat
ion.pm      Mon Jul 21 08:17:24 2008
+++ lib/XML/Compile/WSDL11/Operation.pm       Wed Jul 30 16:31:13 2008
@@ -430,14 +430,14 @@
     my (%parts, %encodings);

     my $soapns       = $self->soapNameSpace;
-    my $bind_faults  = $bind->{"{$soapns}fault"}
+    my $bind_faults  = [map { $_->{"{$soapns}fault"} } @$bind]
         or return ({}, {});

-    my $port_faults  = $portop->{fault} || [];
+    my $port_faults  = $portop || [];
     my $fault_reader = $self->schemas->compile(READER =>
"{$soapns}fault");

     foreach my $bind_fault (@$bind_faults)
-    {   my $fault = ($fault_reader->($bind_fault))[1];
+    {   my $fault = ($fault_reader->($bind_fault->[0]));
         my $name  = $fault->{name};

         my $port  = first {$_->{name} eq $name} @$port_faults;
@@ -450,12 +450,12 @@
         my $message = $self->wsdl->find(message => $msgname)
             or error __x"cannot find fault message {name}", name =>
$msgname;

-        defined $message->{parts} && @{$message->{parts}}==1
+        defined $message->{part} && @{$message->{part}}==1
             or error __x"fault message {name} must have one part
exactly"
                   , name => $msgname;
-        my $part    = $message->{parts}[0];
+        my $part    = $message->{part}[0];

-        push @{$parts{fault}}, $name => $part;
+        push @{$parts{faults}}, $name => $part->{element};
         $encodings{$name} = $part;
     }

Is this a genuine bug, or a dependency that needs updating, or is my
unit test completely broken?  Any ideas appreciated.

Cheers,

== [1] 53wsdl11fault.t

#!/usr/bin/perl
# Test interpretation of WSDL faults.

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::Util       qw/SCHEMA2001/;
use XML::Compile::SOAP::Util qw/WSDL11 WSDL11SOAP SOAP11HTTP/;
use XML::Compile::Tester;

use Test::More tests => 12;
use Test::Deep;

my $testNS     = 'http://any-ns';
my $schema2001 = SCHEMA2001;
my $wsdl11     = WSDL11;
my $wsdl11soap = WSDL11SOAP;
my $soap11http = SOAP11HTTP;

my $xml_wsdl = <<"__WSDL";
<?xml version="1.0"?>
<definitions name="two-way-test"
   targetNamespace="$testNS"
   xmlns:tns="$testNS"
   xmlns:soap="$wsdl11soap"
   xmlns="$wsdl11">

   <types>
     <schema targetNamespace="$testNS" xmlns:tns="$testNS"
       xmlns="$schema2001">
       <element name="Send" type="int" />
       <element name="Response" type="int" />
       <element name="Broken" type="tns:Broken" />
       <complexType name="Broken">
         <sequence>
           <element name="message" type="string" minOccurs="0" />
         </sequence>
       </complexType>
     </schema>
   </types>

   <message name="SendInput">
     <part name="body" element="tns:Send"/>
   </message>

   <message name="SendResponse">
     <part name="body" element="tns:Response"/>
   </message>

   <message name="WentWrong">
     <part name="fault" element="tns:Broken"/>
   </message>

   <portType name="ProcessorPort">
     <operation name="doSend">
       <input message="tns:SendInput"/>
       <output message="tns:SendResponse"/>
       <fault message="tns:WentWrong" name="WentWrong"/>
     </operation>
   </portType>

   <binding name="ProcessorBinding" type="tns:ProcessorPort">
     <soap:binding style="document" transport="$soap11http"/>
     <operation name="doSend">
        <soap:operation soapAction="http://any-action" />
        <input><soap:body use="literal"/></input>
        <output><soap:body use="literal"/></output>
        <fault name="WentWrong"><soap:fault name="WentWrong"
use="literal"/></fault>
     </operation>
   </binding>

   <service name="MyService">
     <documentation>My two-way service</documentation>
     <port name="pleaseProcess" binding="tns:ProcessorBinding">
       <soap:address location="fake-location"/>
     </port>
   </service>
</definitions>
__WSDL

###
### BEGIN OF TESTS
###

my $wsdl = XML::Compile::WSDL11->new($xml_wsdl);

ok(defined $wsdl, "created object");
isa_ok($wsdl, 'XML::Compile::WSDL11');
is($wsdl->wsdlNamespace, WSDL11);

my $op = eval { $wsdl->operation('doSend') };
my $err = $@ || '';
ok(defined $op, 'existing operation');
is($@, '', 'no errors');
isa_ok($op, 'XML::Compile::WSDL11::Operation');
is($op->kind, 'request-response');

my $client = $op->compileClient(transport_hook => \&fake_server);
ok(defined $client, 'compiled client');
isa_ok($client, 'CODE');

my ($answer, $trace) = $client->(body => 999);

ok(defined $answer, 'got answer');
is($answer->{Fault}->{faultstring}, 'any-ns.WentWrong', 'got fault
string');
is($answer->{WentWrong}->{detail}->{message}, 'Oh noes', 'parsed
response XML');

sub fake_server($$)
{  my ($request, $trace) = @_;
   my $content = $request->decoded_content;

   if($content =~ m!<x0:Send>999</x0:Send>!) {
      return HTTP::Response->new(500, 'Internal Server Error'
      , [ 'Content-Type' => 'text/xml;charset=utf-8' ], <<__RESPONSE);
<?xml version="1.0" encoding="UTF-8"?>
<env:Envelope xmlns:env="http://schemas.xmlsoap.org/soap/envelope/"
              xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
              xmlns:ns0="$testNS"
              >
  <env:Body>
    <env:Fault xsi:type="env:Fault">
      <faultcode>env:Server</faultcode>
      <faultstring>any-ns.WentWrong</faultstring>
      <detail><ns0:Broken><ns0:message>Oh
noes</ns0:message></ns0:Broken></detail>
    </env:Fault>
  </env:Body>
</env:Envelope>
__RESPONSE
   } else {
      return HTTP::Response->new(202, 'accepted'
      , [ 'Content-Type' => 'text/plain' ], 'there is no body');
   }
}

http://www.bbc.co.uk/
This e-mail (and any attachments) is confidential and may contain personal views which are not the views of the BBC unless specifically stated.
If you have received it in error, please delete it from your system.
Do not use, copy or disclose the information in any way nor act in reliance on it and notify the sender immediately.
Please note that the BBC monitors e-mails sent or received.
Further communication will signify your consent to this.
					



More information about the Xml-compile mailing list