[Xml-compile] XML::Compile::SOAP 2.37 and SOAPaction

[Patrick Powell]

I updated to the latest versions of the XML::Compile packages and found =

that the
SOAPaction selection was failing.  In fact,  none of the handlers were =

chosen
and I got this error message in the server log:

info: Fault: SOAP11 body element errorReportMsg (soapAction =

GetFaultRequest) not recognized,
available ports are GenerateUpdateDataRequest GetDataRequest =

GetFaultRequest GetMetaRequest G
etOPLDSRequest GetStatusRequest OPLDSMsg UpdateDataRequest)


In the XML::Compile::SOAP::Daemon::process() routine, the SOAPAction =

header is used to look up
the corresponding SOAP request. Here is the output from the Perl =

debugger showing the
critical steps:

   DB<3> c
XML::Compile::SOAP::Server::CODE(0x86ba0768)(/usr/local/lib/perl5/site_perl=
/5.14/XML/Compile/SOAP/Server.pm:59):
59:             $selector->($xmlin, $info) or return;
   DB<3> s
XML::Compile::SOAP::Server::CODE(0x86b42138)(/usr/local/lib/perl5/site_perl=
/5.14/XML/Compile/SOAP/Server.pm:116):
116:        ? sub { my $f =3D  $_[1]->{body}[0]; defined $f && $f eq =

$nodetype }
   DB<3> s
XML::Compile::SOAP::Server::CODE(0x86b42138)(/usr/local/lib/perl5/site_perl=
/5.14/XML/Compile/SOAP/Server.pm:116):
116:        ? sub { my $f =3D  $_[1]->{body}[0]; defined $f && $f eq =

$nodetype }
   DB<3> print $f <<<<<<<<<<<<<<<< message type
errorReportMsg
   DB<4> print $nodetype
{http://www.specsol.com/rmisatmsdata}errorReportMsg <<<<<<<<<<<<<<< =

namespace + message type

It appears that the $nodetype value is getting the namespace prefixed to =

it.  The following
changes fix this:

sub compileFilter(@)
{   my ($self, %args) =3D @_;
     my $nodetype;
     if(my $first    =3D $args{body}{parts}[0])
     {   $nodetype =3D $first->{element}
#           or panic "cannot handle type parameter in server filter";
             || $args{body}{procedure};  # rpc-literal "type"
     }

     my( $ns, $id ) =3D unpack_type( $nodetype ) if $nodetype; <<<<<<  =

remove the namespace

     # called with (XML, INFO)
       defined $id
     ? sub { my $f =3D  $_[1]->{body}[0]; defined $f && $f eq $id }
     : sub { !defined $_[1]->{body}[0] };  # empty body
}





-------------- next part --------------
diff -rc ./SOAP/Server.pm /usr/local/lib/perl5/site_perl/5.14/XML/Compile/S=
OAP/Server.pm
*** ./SOAP/Server.pm	Tue Jul  9 09:01:11 2013
--- /usr/local/lib/perl5/site_perl/5.14/XML/Compile/SOAP/Server.pm	Mon Sep =
 2 06:34:50 2013
***************
*** 13,18 ****
--- 13,19 ----
  use Log::Report 'xml-compile-soap', syntax =3D> 'SHORT';
  =

  use XML::Compile::SOAP::Util qw/:soap11/;
+ use XML::Compile::Util;
  use HTTP::Status qw/RC_OK RC_BAD_REQUEST RC_NOT_ACCEPTABLE
     RC_INTERNAL_SERVER_ERROR/;
  =

***************
*** 105,113 ****
              || $args{body}{procedure};  # rpc-literal "type"
      }
  =

      # called with (XML, INFO)
!       defined $nodetype
!     ? sub { my $f =3D  $_[1]->{body}[0]; defined $f && $f eq $nodetype }
      : sub { !defined $_[1]->{body}[0] };  # empty body
  }
  =

--- 106,115 ----
              || $args{body}{procedure};  # rpc-literal "type"
      }
  =

+ 	my( $ns, $id ) =3D unpack_type( $nodetype ) if $nodetype;
      # called with (XML, INFO)
!       defined $id
!     ? sub { my $f =3D  $_[1]->{body}[0]; defined $f && $f eq $id }
      : sub { !defined $_[1]->{body}[0] };  # empty body
  }
 =20