Compare commits
@@ -1,12 +1,25 @@
|
|||||||
|
#!/usr/bin/perl -w
|
||||||
use Module::Build;
|
use Module::Build;
|
||||||
|
|
||||||
Module::Build->new(
|
Module::Build->new(
|
||||||
|
create_makefile_pl => 'passthrough',
|
||||||
|
dist_name => 'SOAP-WSDL',
|
||||||
|
dist_version => '1.26',
|
||||||
dist_abstract => 'WSDL support for SOAP::Lite',
|
dist_abstract => 'WSDL support for SOAP::Lite',
|
||||||
module_name => 'SOAP::WSDL',
|
module_name => 'SOAP::WSDL',
|
||||||
license => 'artistic',
|
license => 'artistic',
|
||||||
requires => {
|
requires => {
|
||||||
'SOAP::Lite' => 0.,
|
'SOAP::Lite' => 0,
|
||||||
'XML::XPath' => 0
|
'XML::XPath' => 0,
|
||||||
},
|
},
|
||||||
buildrequires => { 'Test::More' => 0 },
|
buildrequires => {
|
||||||
|
'Test::More' => 0,
|
||||||
|
'SOAP::Lite' => 0,
|
||||||
|
'XML::XPath' => 0,
|
||||||
|
'Time::HiRes' => 0,
|
||||||
|
'File::Spec' => 0,
|
||||||
|
'File::Basename' => 0,
|
||||||
|
'Cwd' => 0,
|
||||||
|
},
|
||||||
|
|
||||||
)->create_build_script;
|
)->create_build_script;
|
||||||
|
|||||||
@@ -1,3 +1,17 @@
|
|||||||
|
* v1.26 2007/10/05 - bugfix
|
||||||
|
- fixed issue reported by T Alex Beamish: tests fail when unwrapped into /tmp
|
||||||
|
* v1.25 2007/09/24 - maintenance
|
||||||
|
- added Makefile.PL to ease installation
|
||||||
|
|
||||||
|
* v1.24 2007/09/22 - bugfix
|
||||||
|
- fixes issue reported by David Bussenschutt: wsdlinit always uses new SOAP::Schema instance.
|
||||||
|
|
||||||
|
* v1.23 2007/06/05 - bugfixes and optimizations
|
||||||
|
- fixes #27426: missing prereq XML::XPath
|
||||||
|
- fixed build_requires
|
||||||
|
- some doc fixes
|
||||||
|
- now performs some initializations on calling portname()
|
||||||
|
|
||||||
* v1.22 2007/05/30 - auto-discover service and port again
|
* v1.22 2007/05/30 - auto-discover service and port again
|
||||||
- re-introduces auto-detecting of servicename and portname
|
- re-introduces auto-detecting of servicename and portname
|
||||||
- fixes #27325: Test fails with Test::Pod::Coverage v 1.06.
|
- fixes #27325: Test fails with Test::Pod::Coverage v 1.06.
|
||||||
|
|||||||
@@ -2,12 +2,15 @@ Build.PL
|
|||||||
CHANGES
|
CHANGES
|
||||||
HACKING
|
HACKING
|
||||||
lib/SOAP/WSDL.pm
|
lib/SOAP/WSDL.pm
|
||||||
|
Makefile.PL
|
||||||
MANIFEST This list of files
|
MANIFEST This list of files
|
||||||
META.yml
|
META.yml
|
||||||
README
|
README
|
||||||
t/1_performance.t
|
t/1_performance.t
|
||||||
t/2_helloworld.NET.t
|
t/2_helloworld.NET.t
|
||||||
t/3_various.t
|
t/3_various.t
|
||||||
|
t/4_auto_set_port.t
|
||||||
|
t/5_same_transport.t
|
||||||
t/97_pod.t
|
t/97_pod.t
|
||||||
t/98_pod_coverage.t
|
t/98_pod_coverage.t
|
||||||
t/acceptance/helloworld.asmx.xml
|
t/acceptance/helloworld.asmx.xml
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
---
|
---
|
||||||
name: SOAP-WSDL
|
name: SOAP-WSDL
|
||||||
version: 1.22
|
version: 1.26
|
||||||
author: []
|
author: []
|
||||||
abstract: WSDL support for SOAP::Lite
|
abstract: WSDL support for SOAP::Lite
|
||||||
license: artistic
|
license: artistic
|
||||||
@@ -12,8 +12,8 @@ requires:
|
|||||||
provides:
|
provides:
|
||||||
SOAP::WSDL:
|
SOAP::WSDL:
|
||||||
file: lib/SOAP/WSDL.pm
|
file: lib/SOAP/WSDL.pm
|
||||||
version: 1.22
|
version: 1.25
|
||||||
generated_by: Module::Build version 0.28
|
generated_by: Module::Build version 0.2808
|
||||||
meta-spec:
|
meta-spec:
|
||||||
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
||||||
version: 1.2
|
version: 1.2
|
||||||
|
|||||||
+31
@@ -0,0 +1,31 @@
|
|||||||
|
# Note: this file was auto-generated by Module::Build::Compat version 0.03
|
||||||
|
|
||||||
|
unless (eval "use Module::Build::Compat 0.02; 1" ) {
|
||||||
|
print "This module requires Module::Build to install itself.\n";
|
||||||
|
|
||||||
|
require ExtUtils::MakeMaker;
|
||||||
|
my $yn = ExtUtils::MakeMaker::prompt
|
||||||
|
(' Install Module::Build now from CPAN?', 'y');
|
||||||
|
|
||||||
|
unless ($yn =~ /^y/i) {
|
||||||
|
die " *** Cannot install without Module::Build. Exiting ...\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
require Cwd;
|
||||||
|
require File::Spec;
|
||||||
|
require CPAN;
|
||||||
|
|
||||||
|
# Save this 'cause CPAN will chdir all over the place.
|
||||||
|
my $cwd = Cwd::cwd();
|
||||||
|
|
||||||
|
CPAN::Shell->install('Module::Build::Compat');
|
||||||
|
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
|
||||||
|
or die "Couldn't install Module::Build, giving up.\n";
|
||||||
|
|
||||||
|
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
|
||||||
|
}
|
||||||
|
eval "use Module::Build::Compat 0.02; 1" or die $@;
|
||||||
|
|
||||||
|
Module::Build::Compat->run_build_pl(args => \@ARGV);
|
||||||
|
require Module::Build;
|
||||||
|
Module::Build::Compat->write_makefile(build_class => 'Module::Build');
|
||||||
+251
-156
@@ -4,15 +4,23 @@ package SOAP::WSDL;
|
|||||||
use SOAP::Lite;
|
use SOAP::Lite;
|
||||||
use vars qw($VERSION @ISA);
|
use vars qw($VERSION @ISA);
|
||||||
use XML::XPath;
|
use XML::XPath;
|
||||||
|
use Data::Dumper;
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
use Data::Dumper;
|
|
||||||
|
|
||||||
@ISA = qw(SOAP::Lite);
|
@ISA = qw(SOAP::Lite);
|
||||||
|
|
||||||
$VERSION = "1.22";
|
$VERSION = "1.25";
|
||||||
|
|
||||||
|
# SOAP::Lite has changed the name for speciying a schema in 0.6?
|
||||||
|
# method before: schema
|
||||||
|
# method name after: schema_url
|
||||||
|
#
|
||||||
|
# Actually, we don't care which SOAP::Lite version there is, so we
|
||||||
|
# try to support whatever we find...
|
||||||
|
#
|
||||||
|
my $SCHEMA_URL = $SOAP::Lite::VERSION >= 0.6 ? 'schema_url' : 'schema';
|
||||||
|
|
||||||
sub wsdlinit
|
sub wsdlinit
|
||||||
{
|
{
|
||||||
@@ -51,9 +59,9 @@ sub wsdlinit
|
|||||||
} ## end if ( $self->{ _WSDL }->...
|
} ## end if ( $self->{ _WSDL }->...
|
||||||
unless ( $xpath )
|
unless ( $xpath )
|
||||||
{
|
{
|
||||||
$xpath =
|
no strict qw(refs);
|
||||||
XML::XPath->new(
|
$xpath = XML::XPath->new(
|
||||||
xml => SOAP::Schema->new( schema_url => $self->wsdl )->access );
|
xml => $self->schema->$SCHEMA_URL( $self->wsdl() )->access );
|
||||||
} ## end unless ( $xpath )
|
} ## end unless ( $xpath )
|
||||||
|
|
||||||
( $xpath )
|
( $xpath )
|
||||||
@@ -137,9 +145,6 @@ sub wsdlinit
|
|||||||
$nsHash->{ 'http://xml.apache.org/xml-soap' } . "|";
|
$nsHash->{ 'http://xml.apache.org/xml-soap' } . "|";
|
||||||
chop $self->{ _WSDL }->{ _type_ns };
|
chop $self->{ _WSDL }->{ _type_ns };
|
||||||
|
|
||||||
# TODO make _get_first_port conditional...
|
|
||||||
$self->_get_first_port();
|
|
||||||
|
|
||||||
$self->servicename( $opt{ servicename } ) if ( $opt{ servicename } );
|
$self->servicename( $opt{ servicename } ) if ( $opt{ servicename } );
|
||||||
$self->portname( $opt{ portname } ) if ( $opt{ portname } );
|
$self->portname( $opt{ portname } ) if ( $opt{ portname } );
|
||||||
|
|
||||||
@@ -148,6 +153,81 @@ sub wsdlinit
|
|||||||
|
|
||||||
} ## end sub wsdlinit
|
} ## end sub wsdlinit
|
||||||
|
|
||||||
|
sub _wsdl_init_port
|
||||||
|
{
|
||||||
|
my $self = shift;
|
||||||
|
my $name = shift;
|
||||||
|
my $opt = shift;
|
||||||
|
my $xpath = $self->_wsdl_xpath;
|
||||||
|
my $tns = $self->_wsdl_tns;
|
||||||
|
|
||||||
|
# Step one: get <service><port...> element
|
||||||
|
#
|
||||||
|
# This provides us with the address (enpoint/proxy), which we set here
|
||||||
|
# and the binding name.
|
||||||
|
|
||||||
|
# Fetch <soap:address from inside <wsdl:port -
|
||||||
|
# so we get both with one xpath query...
|
||||||
|
my $path = '/' . $self->_wsdl_wsdlns()
|
||||||
|
. 'definitions/'
|
||||||
|
. $self->_wsdl_wsdlns() .'service[@name="' . $self->servicename()
|
||||||
|
. '"]/'
|
||||||
|
. $self->_wsdl_wsdlns() . 'port[@name="' . $name . '"]/'
|
||||||
|
. $self->_wsdl_soapns() . 'address';
|
||||||
|
|
||||||
|
my $address = $xpath->find( $path )->shift
|
||||||
|
|| die "Error processing WSDL file - no such port ($path)";
|
||||||
|
my $endpoint = $address->getAttribute( 'location' )
|
||||||
|
or die "No endpoint address found ($path)";
|
||||||
|
|
||||||
|
$self->proxy( $endpoint );
|
||||||
|
|
||||||
|
my $port = $address->getParentNode();
|
||||||
|
my $binding_name = $port->getAttribute( 'binding' );
|
||||||
|
|
||||||
|
# Step two: get the correct <binding...> element.
|
||||||
|
# This provides us with the portType name.
|
||||||
|
# Remember binding for later usage (in call() ) and
|
||||||
|
#
|
||||||
|
|
||||||
|
# remove the default targetNamespace from messageName
|
||||||
|
$binding_name =~ s/^($tns)\:*//;
|
||||||
|
|
||||||
|
$path = join(
|
||||||
|
$self->_wsdl_wsdlns,
|
||||||
|
(
|
||||||
|
'/',
|
||||||
|
'definitions/',
|
||||||
|
'binding[@name="' . $binding_name . '"]',
|
||||||
|
)
|
||||||
|
);
|
||||||
|
|
||||||
|
my $binding = $xpath->find( $path )->shift()
|
||||||
|
or die "no binding found ($path)";
|
||||||
|
|
||||||
|
$self->{ _WSDL }->{ binding } = $binding;
|
||||||
|
|
||||||
|
my $portType_name = $binding->getAttribute( 'type' );
|
||||||
|
|
||||||
|
# remove the default targetNamespace from messageName
|
||||||
|
$portType_name =~ s/^($tns)\:*//;
|
||||||
|
|
||||||
|
$path = join(
|
||||||
|
$self->_wsdl_wsdlns,
|
||||||
|
(
|
||||||
|
'/',
|
||||||
|
'definitions/',
|
||||||
|
'portType[@name="' . $portType_name . '"]',
|
||||||
|
)
|
||||||
|
);
|
||||||
|
|
||||||
|
# warn("looking for $path");
|
||||||
|
my $portType = $xpath->find( $path )->shift()
|
||||||
|
or die "No portType found ($path)";
|
||||||
|
$self->{ _WSDL }->{ portType } = $portType;
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
sub call
|
sub call
|
||||||
{
|
{
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
@@ -170,63 +250,22 @@ sub call
|
|||||||
|| die "Error processing WSDL: no wsdl object";
|
|| die "Error processing WSDL: no wsdl object";
|
||||||
};
|
};
|
||||||
|
|
||||||
my $portType = "";
|
# get the first port if none has been set...
|
||||||
my $binding = "";
|
$self->_get_first_port() if (not $self->portname() );
|
||||||
|
|
||||||
my $portName = "";
|
# initialize port if not done yet
|
||||||
|
$self->_wsdl_init_port( $self->portname() )
|
||||||
|
if ( not $self->_wsdl_portType() );
|
||||||
|
|
||||||
$portName = $self->portname;
|
my $portType = $self->_wsdl_portType();
|
||||||
$portName or die "Error processing the call: no port found";
|
my $binding = $self->_wsdl_binding();
|
||||||
|
|
||||||
#look for the binding
|
|
||||||
$path = join(
|
|
||||||
$self->_wsdl_wsdlns,
|
|
||||||
(
|
|
||||||
"/", "definitions/",
|
|
||||||
"service[\@name='" . ( $self->servicename ) . "']/",
|
|
||||||
"port[\@name='" . $portName . "']"
|
|
||||||
)
|
|
||||||
);
|
|
||||||
|
|
||||||
my $port = $xpath->find( $path )->shift
|
|
||||||
|| die "Error processing WSDL file - no such port ($path)";
|
|
||||||
|
|
||||||
$binding = $port->findvalue( '@binding' )
|
|
||||||
|| die
|
|
||||||
"Error processing WSDL: Cannot find the binding for the service $path";
|
|
||||||
|
|
||||||
#look for the location
|
|
||||||
$path .= "/" . $self->_wsdl_soapns . "address";
|
|
||||||
|
|
||||||
my $address = $xpath->find( $path )->shift
|
|
||||||
|| die "Error processing WSDL file - no such address ($path)";
|
|
||||||
|
|
||||||
$location = $address->findvalue( '@location' )->value
|
|
||||||
|| die
|
|
||||||
"Error processing WSDL: Cannot find the port for the location in service $path";
|
|
||||||
$self->proxy( $location );
|
|
||||||
|
|
||||||
# remove the default targetNamespace from messageName
|
|
||||||
$binding =~ s/^($tns)\:*//;
|
|
||||||
$binding =~ s/^($tns)\:*//;
|
|
||||||
|
|
||||||
$path = join(
|
|
||||||
$self->_wsdl_wsdlns,
|
|
||||||
( '/', 'definitions/', "binding[\@name='$binding']/\@type" )
|
|
||||||
);
|
|
||||||
|
|
||||||
$portType = $self->_wsdl_findvalue( $path, "dieIfError" );
|
|
||||||
$portType =~ s/^(.*?)\://;
|
|
||||||
|
|
||||||
#Now we need to find the operation, in the binding.
|
|
||||||
#After that we can extract the SoapAction and the
|
|
||||||
#input name, if defined
|
|
||||||
|
|
||||||
$path = join(
|
$path = join(
|
||||||
$self->_wsdl_wsdlns,
|
$self->_wsdl_wsdlns,
|
||||||
(
|
(
|
||||||
'/', 'definitions/', "binding[\@name='$binding']/",
|
# '/',
|
||||||
"operation[\@name='$method']/", $mode
|
'operation[@name="' . $method . '"]/',
|
||||||
|
$mode
|
||||||
)
|
)
|
||||||
);
|
);
|
||||||
|
|
||||||
@@ -234,58 +273,75 @@ sub call
|
|||||||
$data{ "wsdl_${mode}_name" }
|
$data{ "wsdl_${mode}_name" }
|
||||||
and $path .= "[\@name='" . $data{ "wsdl_${mode}_name" } . "']";
|
and $path .= "[\@name='" . $data{ "wsdl_${mode}_name" } . "']";
|
||||||
|
|
||||||
#now we can get the soapaction
|
# warn "Looking for operation $path";
|
||||||
my $soapActionPath =
|
my $inputMessageName;
|
||||||
"$path/../" . $self->_wsdl_soapns . "operation/\@soapAction";
|
my $binding_operation_message = $binding->find( $path )->shift();
|
||||||
my $soapAction = $self->_wsdl_findvalue( $soapActionPath, "" );
|
if ($binding_operation_message)
|
||||||
$soapAction and $self->on_action( sub { sprintf "$soapAction" } );
|
{
|
||||||
|
my $binding_operation = $binding_operation_message->getParentNode();
|
||||||
|
my $soapAction = $binding_operation->getAttribute( 'soapAction' );
|
||||||
|
$self->on_action( sub { return "$soapAction" } ) if ($soapAction);
|
||||||
|
# warn "soapAction set to $soapAction\n";
|
||||||
|
|
||||||
#if defined, the input message name has to be the leading item
|
#if defined, the input message name has to be the leading item
|
||||||
#in the SOAP call. If not defined, it has to be the operation
|
#in the SOAP call. If not defined, it has to be the operation
|
||||||
#name. In the case of overloaded calls, it *IS* the parameter passed
|
#name. In the case of overloaded calls, it *IS* the parameter passed
|
||||||
#by the calling script. So
|
#by the calling script. So
|
||||||
my $inputMessageName;
|
|
||||||
if ( $data{ "wsdl_${mode}_name" } )
|
if ( $data{ "wsdl_${mode}_name" } )
|
||||||
{
|
{
|
||||||
$inputMessageName = $data{ "wsdl_${mode}_name" };
|
$inputMessageName = $data{ "wsdl_${mode}_name" };
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
$inputMessageName = $self->_wsdl_findvalue( "$path/\@name", "" );
|
$inputMessageName = $binding_operation_message->getAttribute('name');
|
||||||
}
|
}
|
||||||
$inputMessageName or $inputMessageName = $method;
|
|
||||||
|
}
|
||||||
|
# just set it right if not set before:
|
||||||
|
$inputMessageName ||= $method;
|
||||||
|
|
||||||
$path = join(
|
$path = join(
|
||||||
$self->_wsdl_wsdlns,
|
$self->_wsdl_wsdlns,
|
||||||
(
|
(
|
||||||
'/', 'definitions/',
|
'/',
|
||||||
"binding[\@name='$binding']/", "operation[\@name='$method']/",
|
'definitions/',
|
||||||
|
'binding[@name="' . $binding->getAttribute('name') . '"]/',
|
||||||
|
'operation[@name="' . $method . '"]/',
|
||||||
"$mode/"
|
"$mode/"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
. $self->_wsdl_soapns . "body/";
|
. $self->_wsdl_soapns . "body";
|
||||||
|
|
||||||
#a call can have an associated, namespace
|
# warn "looking for $path...";
|
||||||
my $callNamespace = $self->_wsdl_findvalue( "$path\@namespace", "" );
|
my $callNamespace;
|
||||||
$callNamespace or $callNamespace = $self->_wsdl_tns_uri;
|
my $encodingStyle = q{};
|
||||||
|
if (my $operation = $self->_wsdl_find( $path )->shift)
|
||||||
|
{
|
||||||
|
# warn "found operation:" . Dumper $operation;
|
||||||
|
#a call can have an associated, namespace
|
||||||
|
$callNamespace = $operation->getAttribute('namespace');
|
||||||
|
#the encoding style is required when handling restricted complextypes
|
||||||
|
$encodingStyle = $operation->getAttribute( 'encodingStyle' );
|
||||||
|
}
|
||||||
|
$callNamespace ||= $self->_wsdl_tns_uri;
|
||||||
|
|
||||||
#the encoding style is required when handling restricted complextypes
|
$self->wsdl_encoding( $self->_wsdl_ns->{ $encodingStyle } )
|
||||||
my $encodingStyle = "";
|
if ($encodingStyle);
|
||||||
$encodingStyle = $self->_wsdl_findvalue( "$path\@encodingStyle", "" );
|
|
||||||
$encodingStyle
|
|
||||||
and $self->wsdl_encoding( $self->_wsdl_ns->{ $encodingStyle } );
|
|
||||||
|
|
||||||
$path = join(
|
$path = join(
|
||||||
$self->_wsdl_wsdlns,
|
$self->_wsdl_wsdlns,
|
||||||
(
|
(
|
||||||
'/', 'definitions/',
|
'/', 'definitions/',
|
||||||
"portType[\@name='$portType']/",
|
'portType[@name="' . $portType->getAttribute('name') . '"]/',
|
||||||
"operation[\@name='$method']/", $mode
|
'operation[@name="' . $method . '"]/',
|
||||||
|
$mode
|
||||||
)
|
)
|
||||||
);
|
);
|
||||||
|
|
||||||
#overload: the calling script has to say wich overloading
|
# overload: the calling script has to say wich overloading
|
||||||
#procedure call has to be encoded and forwarded to the server
|
# procedure call has to be encoded and forwarded to the server
|
||||||
|
|
||||||
$data{ "wsdl_${mode}_name" }
|
$data{ "wsdl_${mode}_name" }
|
||||||
and $path .= "[\@name='" . $data{ "wsdl_${mode}_name" } . "']";
|
and $path .= "[\@name='" . $data{ "wsdl_${mode}_name" } . "']";
|
||||||
|
|
||||||
@@ -296,10 +352,15 @@ sub call
|
|||||||
|
|
||||||
$path = join(
|
$path = join(
|
||||||
$self->_wsdl_wsdlns,
|
$self->_wsdl_wsdlns,
|
||||||
( '/', 'definitions/', "message[\@name='$messageName']/", 'part' )
|
( '/', 'definitions/', 'message[@name="' . $messageName . '"]/'
|
||||||
|
, 'part' )
|
||||||
);
|
);
|
||||||
|
|
||||||
#An operation without parts is equivalent to a procedure call without parameters
|
# warn "looking for $path...";
|
||||||
|
|
||||||
|
# An operation without parts is equivalent to a procedure
|
||||||
|
# call without parameters
|
||||||
|
# Though not very common, messages may have more than one part...
|
||||||
my $parts = $self->_wsdl_find( $path );
|
my $parts = $self->_wsdl_find( $path );
|
||||||
|
|
||||||
my @param = ();
|
my @param = ();
|
||||||
@@ -325,9 +386,7 @@ sub call
|
|||||||
}
|
}
|
||||||
} ## end sub call
|
} ## end sub call
|
||||||
|
|
||||||
# find the first servie and port for convenience - mai go wrong,
|
# find the first servie and port for convenience
|
||||||
# as it assomes the <port> section in the <service>
|
|
||||||
# is named equally to the <porttype> section
|
|
||||||
|
|
||||||
sub _get_first_port
|
sub _get_first_port
|
||||||
{
|
{
|
||||||
@@ -335,8 +394,18 @@ sub _get_first_port
|
|||||||
my $url = shift;
|
my $url = shift;
|
||||||
my $xpath = $self->_wsdl_xpath();
|
my $xpath = $self->_wsdl_xpath();
|
||||||
|
|
||||||
my $path =
|
# find /wsdl:definitions/wsdl:service/wsdl:port/soap:address
|
||||||
'/definitions/service' . '/port/' . $self->_wsdl_soapns . 'address';
|
# use namespace prefixes from WSDL - they may differ...
|
||||||
|
#
|
||||||
|
# We head right for the address instead of just fetching the first
|
||||||
|
# port - we want to set the SOAP::Lite proxy, and accessing
|
||||||
|
# our parent is easier than running repeated XPath queries...
|
||||||
|
#
|
||||||
|
my $path = '/' . $self->_wsdl_wsdlns() .
|
||||||
|
'definitions/'
|
||||||
|
. $self->_wsdl_wsdlns() .'service/'
|
||||||
|
. $self->_wsdl_wsdlns() . 'port/'
|
||||||
|
. $self->_wsdl_soapns() . 'address';
|
||||||
|
|
||||||
my @ports = $xpath->findnodes( $path );
|
my @ports = $xpath->findnodes( $path );
|
||||||
|
|
||||||
@@ -372,11 +441,30 @@ sub _load_method
|
|||||||
};
|
};
|
||||||
} ## end sub _load_method
|
} ## end sub _load_method
|
||||||
|
|
||||||
|
sub portname {
|
||||||
|
my $self = shift;
|
||||||
|
if ( @_ )
|
||||||
|
{
|
||||||
|
my $portname = shift;
|
||||||
|
if ( not defined($self->{ _WSDL }->{ portname })
|
||||||
|
or ($portname ne ($self->{ _WSDL }->{ portname }) ) )
|
||||||
|
{
|
||||||
|
$self->{ _WSDL }->{ portname } = $portname;
|
||||||
|
$self->_wsdl_init_port( $portname );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if ($self->{ _WSDL }->{ 'portname' })
|
||||||
|
{
|
||||||
|
return $self->{ _WSDL }->{ 'portname' }
|
||||||
|
};
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
&_load_method( "no_dispatch", "no_dispatch" );
|
&_load_method( "no_dispatch", "no_dispatch" );
|
||||||
&_load_method( "wsdl", "wsdl" );
|
&_load_method( "wsdl", "wsdl" );
|
||||||
&_load_method( "wsdl_checkoccurs", "checkoccurs" );
|
&_load_method( "wsdl_checkoccurs", "checkoccurs" );
|
||||||
&_load_method( "servicename", "servicename" );
|
&_load_method( "servicename", "servicename" );
|
||||||
&_load_method( "portname", "portname" );
|
#&_load_method( "portname", "portname" );
|
||||||
&_load_method( "wsdl_cache_directory", "cache_directory" );
|
&_load_method( "wsdl_cache_directory", "cache_directory" );
|
||||||
&_load_method( "wsdl_encoding", "wsdl_encoding" );
|
&_load_method( "wsdl_encoding", "wsdl_encoding" );
|
||||||
&_load_method( "_wsdl_ns", "namespaces" );
|
&_load_method( "_wsdl_ns", "namespaces" );
|
||||||
@@ -387,6 +475,8 @@ sub _load_method
|
|||||||
&_load_method( "_wsdl_schemans", "schemans" );
|
&_load_method( "_wsdl_schemans", "schemans" );
|
||||||
&_load_method( "_wsdl_soapns", "soapns" );
|
&_load_method( "_wsdl_soapns", "soapns" );
|
||||||
&_load_method( "_wsdl_wsdlExplicitNS", "wsdl_wsdlExplicitNS" );
|
&_load_method( "_wsdl_wsdlExplicitNS", "wsdl_wsdlExplicitNS" );
|
||||||
|
&_load_method( "_wsdl_binding", "binding" );
|
||||||
|
&_load_method( "_wsdl_portType", "portType" );
|
||||||
|
|
||||||
#each call to make finder returns a wrapped version of the xpath calls.
|
#each call to make finder returns a wrapped version of the xpath calls.
|
||||||
#find, findvalue, findnodes and so on
|
#find, findvalue, findnodes and so on
|
||||||
@@ -443,7 +533,6 @@ sub wsdl_cache_init
|
|||||||
eval { require Cache::FileCache; };
|
eval { require Cache::FileCache; };
|
||||||
if ( $@ )
|
if ( $@ )
|
||||||
{
|
{
|
||||||
|
|
||||||
# warn about missing Cache::FileCache and set cache hadnle to undef
|
# warn about missing Cache::FileCache and set cache hadnle to undef
|
||||||
warn "File caching is enabled, but you do not have the "
|
warn "File caching is enabled, but you do not have the "
|
||||||
. "Cache::FileCache module. Disabling Filesystem caching."
|
. "Cache::FileCache module. Disabling Filesystem caching."
|
||||||
@@ -452,7 +541,6 @@ sub wsdl_cache_init
|
|||||||
} ## end if ( $@ )
|
} ## end if ( $@ )
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
|
||||||
# initialize cache from custom parameters if given
|
# initialize cache from custom parameters if given
|
||||||
$p->{ cache_root } ||= $self->{ _WSDL }->{ cache_directory };
|
$p->{ cache_root } ||= $self->{ _WSDL }->{ cache_directory };
|
||||||
$cache = Cache::FileCache->new( $p );
|
$cache = Cache::FileCache->new( $p );
|
||||||
@@ -916,7 +1004,7 @@ __END__
|
|||||||
|
|
||||||
=head1 NAME
|
=head1 NAME
|
||||||
|
|
||||||
SOAP::WSDL
|
SOAP::WSDL - SOAP with WSDL support
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
@@ -934,7 +1022,8 @@ SOAP::WSDL
|
|||||||
|
|
||||||
=head1 DESCRIPTION
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
This is a small update to 1.21 - autodetection of servicename and portname
|
This is mainly a bugfix update to 1.22, which was a small update to 1.21
|
||||||
|
- autodetection of servicename and portname have been
|
||||||
are re-introduced, so users of 1.20 have no need to change their scripts.
|
are re-introduced, so users of 1.20 have no need to change their scripts.
|
||||||
|
|
||||||
1.21 was a new version of SOAP::WSDL, mainly based on the work of
|
1.21 was a new version of SOAP::WSDL, mainly based on the work of
|
||||||
@@ -1009,10 +1098,8 @@ WSDL definition.
|
|||||||
# soap message elements to be typed
|
# soap message elements to be typed
|
||||||
$soap->autotype(0);
|
$soap->autotype(0);
|
||||||
|
|
||||||
|
# you may specify a service and port - if not, SOAP::WSDL will search for
|
||||||
# before calling you *must* specify which service use and which port call
|
# the first one appearing in the WSDL
|
||||||
# you must call it after wsdlinit
|
|
||||||
# you can call it multiple times, one for each call
|
|
||||||
$soap->servicename('myservice');
|
$soap->servicename('myservice');
|
||||||
$soap->portname('myport');
|
$soap->portname('myport');
|
||||||
|
|
||||||
@@ -1029,20 +1116,22 @@ WSDL definition.
|
|||||||
|
|
||||||
# with headers (see the SOAP documentation)
|
# with headers (see the SOAP documentation)
|
||||||
|
|
||||||
#first define your headers
|
#first define your headers
|
||||||
@header = (SOAP::Header->name("FirstHeader")->value("FirstValue"),
|
@header = (SOAP::Header->name("FirstHeader")->value("FirstValue"),
|
||||||
SOAP::Header->name("SecontHeader")->value("SecondValue"));
|
SOAP::Header->name("SecontHeader")->value("SecondValue"));
|
||||||
|
|
||||||
#and then do the call. please note the backslash
|
#and then do the call. please note the backslash
|
||||||
my $som=$soap->call( 'method' ,
|
my $som=$soap->call( 'method' ,
|
||||||
name => 'value' ,
|
name => 'value' ,
|
||||||
name => 'value' ,
|
name => 'value' ,
|
||||||
"soap_headers",\@header);
|
"soap_headers" => \@header);
|
||||||
|
|
||||||
|
|
||||||
=head1 How it works
|
=head1 How it works
|
||||||
|
|
||||||
SOAP::WSDL takes the wsdl file specified and looks up the service and the specified port.
|
SOAP::WSDL takes the wsdl file specified and looks up the service and the
|
||||||
|
specified port.
|
||||||
|
|
||||||
On calling a SOAP method, it looks up the message encoding and wraps all the
|
On calling a SOAP method, it looks up the message encoding and wraps all the
|
||||||
stuff around your data accordingly.
|
stuff around your data accordingly.
|
||||||
|
|
||||||
@@ -1066,23 +1155,23 @@ If you want to chose a different one, you can specify the service by calling
|
|||||||
|
|
||||||
The call method examines the wsdl file to find out how to encode the SOAP
|
The call method examines the wsdl file to find out how to encode the SOAP
|
||||||
message for your method. Lookups are done in real-time using XPath, so this
|
message for your method. Lookups are done in real-time using XPath, so this
|
||||||
incorporates a small delay to your calls (see L</Memory consumption and performance>
|
incorporates a small delay to your calls (see
|
||||||
below.
|
L</Memory consumption and performance> below.
|
||||||
|
|
||||||
The SOAP message will include the types for each element, unless you have
|
The SOAP message will include the types for each element, unless you have
|
||||||
set autotype to a false value by calling
|
set autotype to a false value by calling
|
||||||
|
|
||||||
$soap->autotype(0);
|
$soap->autotype(0);
|
||||||
|
|
||||||
After wrapping your call into what is appropriate, SOAP::WSDL uses the I<call()>
|
After wrapping your call into what is appropriate, SOAP::WSDL uses the
|
||||||
method from SOAP::Lite to dispatch your call.
|
I<call()> method from SOAP::Lite to dispatch your call.
|
||||||
|
|
||||||
call takes the method name as first argument, and the parameters passed to that
|
call takes the method name as first argument, and the parameters passed to
|
||||||
method as following arguments.
|
that method as following arguments.
|
||||||
|
|
||||||
B<Example:>
|
B<Example:>
|
||||||
|
|
||||||
$som=$soap->call( "SomeMethod" => "test" => "testvalue" );
|
$som=$soap->call( "SomeMethod" , "test" => "testvalue" );
|
||||||
|
|
||||||
$som=$soap->call( "SomeMethod" => %args );
|
$som=$soap->call( "SomeMethod" => %args );
|
||||||
|
|
||||||
@@ -1090,14 +1179,17 @@ B<Example:>
|
|||||||
|
|
||||||
SOAP::WSDL uses a two-stage caching mechanism to achieve best performance.
|
SOAP::WSDL uses a two-stage caching mechanism to achieve best performance.
|
||||||
|
|
||||||
First, there's a pretty simple caching mechanisms for storing XPath query results.
|
First, there's a pretty simple caching mechanisms for storing XPath query
|
||||||
They are just stored in a hash with the XPath path as key (until recently, only
|
results.
|
||||||
results of "find" or "findnodes" are cached). I did not use the obvious
|
|
||||||
|
They are just stored in a hash with the XPath path as key (until recently,
|
||||||
|
only results of "find" or "findnodes" are cached). I did not use the obvious
|
||||||
L<Cache|Cache> or L<Cache::Cache|Cache::Cache> module here, because these
|
L<Cache|Cache> or L<Cache::Cache|Cache::Cache> module here, because these
|
||||||
use L<Storable|Storable> to store complex objects and thus incorporate a performance
|
use L<Storable|Storable> to store complex objects and thus incorporate a
|
||||||
loss heavier than using no cache at all.
|
performance loss heavier than using no cache at all.
|
||||||
Second, the XPath object and the XPath results cache are be stored on disk using
|
|
||||||
the L<Cache::FileCache|Cache::FileCache> implementation.
|
Second, the XPath object and the XPath results cache are be stored on disk
|
||||||
|
using the L<Cache::FileCache|Cache::FileCache> implementation.
|
||||||
|
|
||||||
A filesystem cache is only used if you
|
A filesystem cache is only used if you
|
||||||
|
|
||||||
@@ -1106,36 +1198,39 @@ A filesystem cache is only used if you
|
|||||||
|
|
||||||
The cache directory must be, of course, read- and writeable.
|
The cache directory must be, of course, read- and writeable.
|
||||||
|
|
||||||
XPath result caching doubles performance, but increases memory consumption - if you lack of
|
XPath result caching doubles performance, but increases memory consumption
|
||||||
memory, you should not enable caching (disabled by default).
|
- if you lack of memory, you should not enable caching (disabled by default).
|
||||||
|
|
||||||
Filesystem caching triples performance for wsdlinit and doubles performance for the first
|
Filesystem caching triples performance for wsdlinit and doubles performance
|
||||||
method call.
|
for the first method call.
|
||||||
|
|
||||||
The file system cache is written to disk when the SOAP::WSDL object is destroyed.
|
The file system cache is written to disk when the SOAP::WSDL object is
|
||||||
It may be written to disk any time by calling the L</wsdl_cache_store> method
|
destroyed.
|
||||||
|
|
||||||
Using both filesystem and in-memory caching is recommended for best performance and
|
It may be written to disk any time by calling the L</wsdl_cache_store> method.
|
||||||
smallest startup costs.
|
|
||||||
|
Using both filesystem and in-memory caching is recommended for best
|
||||||
|
performance and smallest startup costs.
|
||||||
|
|
||||||
=head2 Sharing cache between applications
|
=head2 Sharing cache between applications
|
||||||
|
|
||||||
Sharing a file system cache among applications accessing the same web service is
|
Sharing a file system cache among applications accessing the same web
|
||||||
generally possible, but may under some circumstances reduce performance, and under
|
service is generally possible, but may under some circumstances reduce
|
||||||
some special circumstances even lead to errors.
|
performance, and under some special circumstances even lead to errors.
|
||||||
This is due to the cache key algorithm used.
|
This is due to the cache key algorithm used.
|
||||||
|
|
||||||
SOAP::WSDL uses the SOAP endpoint URL to store the XML::XPath object of the wsdl file.
|
SOAP::WSDL uses the WSDL's URL to store the XML::XPath object of the
|
||||||
In the rare case of a web service listening on one particular endpoint (URL) but using
|
wsdl file. If you're using more than one WSDL definition on the same URL,
|
||||||
more than one WSDL definition, this may lead to errors when applications using
|
this may lead to errors when two or more applications using SOAP::WSDL
|
||||||
SOAP::WSDL share a file system cache.
|
share a file system cache.
|
||||||
|
|
||||||
SOAP::WSDL stores the XPath results in-memory-cache in the filesystem cache, using the
|
SOAP::WSDL stores the XPath results in-memory-cache in the filesystem cache,
|
||||||
key of the wsdl file with C<_cache> appended. Two applications sharing the file system
|
using the URL wsdl file with C<_cache> appended. Two applications sharing the
|
||||||
cache and accessing different methods of one web service could overwrite each others
|
file system cache and accessing different methods of one web service could
|
||||||
in-memory-caches when dumping the XPath results to disk, resulting in a slight performance
|
overwrite each others in-memory-caches when dumping the XPath results to
|
||||||
drawback (even though this only happens in the rare case of one app being started before
|
disk, resulting in a slight performance drawback (even though this only
|
||||||
the other one has had a chance to write its cache to disk).
|
happens in the rare case of one app being started before the other one has
|
||||||
|
had a chance to write its cache to disk).
|
||||||
|
|
||||||
=head2 Controlling the file system cache
|
=head2 Controlling the file system cache
|
||||||
|
|
||||||
@@ -1352,9 +1447,9 @@ It imposes a slight delay for initialization, and for every SOAP method call, to
|
|||||||
On my 1.4 GHz Pentium mobile notebook, the init delay with a simple
|
On my 1.4 GHz Pentium mobile notebook, the init delay with a simple
|
||||||
WSDL file (containing just one operation and some complex types and elements)
|
WSDL file (containing just one operation and some complex types and elements)
|
||||||
was around 50 ms, the delay for the first call around 25 ms and for subsequent
|
was around 50 ms, the delay for the first call around 25 ms and for subsequent
|
||||||
calls to the same method around 7 ms without and around 6 ms with XPath result caching
|
calls to the same method around 7 ms without and around 6 ms with XPath result
|
||||||
(on caching, see above). XML::XPath must do some caching, too - don't know where
|
caching (on caching, see above). XML::XPath must do some caching, too -
|
||||||
else the speedup should come from.
|
don't know where else the speedup should come from.
|
||||||
|
|
||||||
Calling a method of a more complex WSDL file (defining around 10 methods and
|
Calling a method of a more complex WSDL file (defining around 10 methods and
|
||||||
numerous complex types on around 500 lines of XML), the delay for the first
|
numerous complex types on around 500 lines of XML), the delay for the first
|
||||||
@@ -1471,8 +1566,8 @@ Replace whitespace by '@' in E-Mail addresses.
|
|||||||
|
|
||||||
=head1 SVN information
|
=head1 SVN information
|
||||||
|
|
||||||
$LastChangedBy: kutterma $
|
$LastChangedBy: kutterma $
|
||||||
$HeadURL: https://svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/branches/1.21/lib/SOAP/WSDL.pm $
|
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/branches/1.21/lib/SOAP/WSDL.pm $
|
||||||
$Rev: 16 $
|
$Rev: 278 $
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|||||||
+5
-5
@@ -21,7 +21,7 @@ my $data = { name => 'Mein Name',
|
|||||||
my $dir = cwd;
|
my $dir = cwd;
|
||||||
|
|
||||||
# chomp /t/ to allow running the script from t/ directory
|
# chomp /t/ to allow running the script from t/ directory
|
||||||
$dir=~s|/t/?||;
|
$dir=~s|/t/?$||;
|
||||||
|
|
||||||
my $t0 = [gettimeofday];
|
my $t0 = [gettimeofday];
|
||||||
|
|
||||||
@@ -59,11 +59,11 @@ my $t0 = [gettimeofday];
|
|||||||
print "# NO cache second call (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
|
print "# NO cache second call (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
|
||||||
|
|
||||||
$t0 = [gettimeofday];
|
$t0 = [gettimeofday];
|
||||||
for (my $i=1; $i<100; $i++) {
|
for (1..10) {
|
||||||
$soap->call(sayHello => %{ $data });
|
$soap->call(sayHello => %{ $data });
|
||||||
}
|
}
|
||||||
ok(1);
|
ok(1);
|
||||||
print "# NO cache: 100 x call (".tv_interval ( $t0, [gettimeofday]) ."s)\n";
|
print "# NO cache: 10 x call (".tv_interval ( $t0, [gettimeofday]) ."s)\n";
|
||||||
}
|
}
|
||||||
{
|
{
|
||||||
print "# Test with caching ENABLED\n";
|
print "# Test with caching ENABLED\n";
|
||||||
@@ -98,10 +98,10 @@ my $t0 = [gettimeofday];
|
|||||||
print "# CACHE second call: (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
|
print "# CACHE second call: (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
|
||||||
|
|
||||||
$t0 = [gettimeofday];
|
$t0 = [gettimeofday];
|
||||||
for (my $i=1; $i<100; $i++) {
|
for (1..10) {
|
||||||
$soap->call(sayHello => %{ $data });
|
$soap->call(sayHello => %{ $data });
|
||||||
}
|
}
|
||||||
ok(1);
|
ok(1);
|
||||||
print "# CACHE: 100 x call (".tv_interval ( $t0, [gettimeofday]) ."s)\n";
|
print "# CACHE: 10 x call (".tv_interval ( $t0, [gettimeofday]) ."s)\n";
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -34,7 +34,7 @@ my $data = {
|
|||||||
|
|
||||||
|
|
||||||
my $dir= cwd;
|
my $dir= cwd;
|
||||||
$dir=~s/\/t\/?//;
|
$dir=~s/\/t\/?$//;
|
||||||
|
|
||||||
my $t0 = [gettimeofday];
|
my $t0 = [gettimeofday];
|
||||||
ok( my $soap=SOAP::WSDL->new(wsdl => 'file:///'.$dir.'/t/acceptance/test.wsdl.xml',
|
ok( my $soap=SOAP::WSDL->new(wsdl => 'file:///'.$dir.'/t/acceptance/test.wsdl.xml',
|
||||||
|
|||||||
+14
-17
@@ -1,15 +1,13 @@
|
|||||||
#!/usr/bin/perl -w
|
#!/usr/bin/perl -w
|
||||||
use strict;
|
use strict;
|
||||||
use Test;
|
use warnings;
|
||||||
plan tests=> 8;
|
use diagnostics;
|
||||||
|
use Test::More tests=> 9;
|
||||||
use Time::HiRes qw( gettimeofday tv_interval );
|
use Time::HiRes qw( gettimeofday tv_interval );
|
||||||
use lib '../lib';
|
use lib '../lib';
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use Cwd;
|
use Cwd;
|
||||||
use SOAP::WSDL;
|
use_ok qw/SOAP::WSDL/;
|
||||||
|
|
||||||
ok 1; # if we made it this far, we're ok
|
|
||||||
### test vars END
|
|
||||||
|
|
||||||
print "# Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n";
|
print "# Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n";
|
||||||
print "# Various Features Test with WSDL file \n";
|
print "# Various Features Test with WSDL file \n";
|
||||||
@@ -20,7 +18,7 @@ my $data = {name => 'Mein Name',
|
|||||||
my $dir = cwd;
|
my $dir = cwd;
|
||||||
|
|
||||||
# chomp /t/ to allow running the script from t/ directory
|
# chomp /t/ to allow running the script from t/ directory
|
||||||
$dir=~s|/t/?||;
|
$dir=~s|/t/?$||;
|
||||||
|
|
||||||
my $t0 = [gettimeofday];
|
my $t0 = [gettimeofday];
|
||||||
ok( my $soap=SOAP::WSDL->new(wsdl => "file://$dir/t/acceptance/helloworld.asmx.xml",
|
ok( my $soap=SOAP::WSDL->new(wsdl => "file://$dir/t/acceptance/helloworld.asmx.xml",
|
||||||
@@ -31,11 +29,11 @@ print "# Create SOAP::WSDL object (".tv_interval ( $t0, [gettimeofday]) ."ms)\n"
|
|||||||
|
|
||||||
$t0 = [gettimeofday];
|
$t0 = [gettimeofday];
|
||||||
eval{ $soap->wsdlinit(caching => 0) };
|
eval{ $soap->wsdlinit(caching => 0) };
|
||||||
unless ($@) {
|
if ($@) {
|
||||||
ok(1);
|
fail("wsdlinit");
|
||||||
} else {
|
|
||||||
ok 0;
|
|
||||||
print STDERR $@;
|
print STDERR $@;
|
||||||
|
} else {
|
||||||
|
pass("wsdlinit");
|
||||||
}
|
}
|
||||||
print "# wsdl file init (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;;
|
print "# wsdl file init (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;;
|
||||||
|
|
||||||
@@ -44,18 +42,17 @@ $soap->servicename("Service1");
|
|||||||
$soap->portname("Service1Soap");
|
$soap->portname("Service1Soap");
|
||||||
|
|
||||||
$t0 = [gettimeofday];
|
$t0 = [gettimeofday];
|
||||||
|
ok( $soap->call("sayHello" , %{ $data }), "call sayHello");
|
||||||
ok( $soap->call("sayHello" , %{ $data }));
|
|
||||||
print "# Normal Call: (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
|
print "# Normal Call: (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
|
||||||
|
|
||||||
$soap->servicename("Service2");
|
$soap->servicename("Service2");
|
||||||
$soap->portname("Service2Soap");
|
is( $soap->portname("Service2Soap"), 'Service2Soap' );
|
||||||
|
|
||||||
$data = {name => 'Mein Name',
|
$data = {name => 'Mein Name',
|
||||||
givenName => 'Vorname'};
|
givenName => 'Vorname'};
|
||||||
|
|
||||||
$t0 = [gettimeofday];
|
$t0 = [gettimeofday];
|
||||||
ok($soap->call(sayGoodBye => %{ $data }) );
|
ok($soap->call(sayGoodBye => %{ $data }), "Multiple Services/Port Call" );
|
||||||
print "# Multiple Services/Port Call: (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
|
print "# Multiple Services/Port Call: (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
|
||||||
|
|
||||||
$soap->servicename("Service2");
|
$soap->servicename("Service2");
|
||||||
@@ -68,7 +65,7 @@ $data = {name => 'Mein Name',
|
|||||||
$t0 = [gettimeofday];
|
$t0 = [gettimeofday];
|
||||||
|
|
||||||
my $xml = $soap->serializer->method( $soap->call(sayGoodByeOverload => %{ $data }) );
|
my $xml = $soap->serializer->method( $soap->call(sayGoodByeOverload => %{ $data }) );
|
||||||
$xml =~ /<name/ and ok(1);
|
like($xml , qr/<name/, 'serialized overloaded method');
|
||||||
|
|
||||||
$data = {
|
$data = {
|
||||||
name => 'Mein Name',
|
name => 'Mein Name',
|
||||||
@@ -78,7 +75,7 @@ $data = {
|
|||||||
|
|
||||||
$t0 = [gettimeofday];
|
$t0 = [gettimeofday];
|
||||||
$xml = $soap->serializer->method( $soap->call(sayGoodByeOverload => %{ $data }) );
|
$xml = $soap->serializer->method( $soap->call(sayGoodByeOverload => %{ $data }) );
|
||||||
$xml !~ /<name/ and ok(1);
|
unlike($xml , qr/<name/ , 'Overloaded calls');
|
||||||
|
|
||||||
print "# Overloaded Calls: (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
|
print "# Overloaded Calls: (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
|
||||||
|
|
||||||
|
|||||||
@@ -0,0 +1,55 @@
|
|||||||
|
#!/usr/bin/perl -w
|
||||||
|
#######################################################################################
|
||||||
|
#
|
||||||
|
# 2_helloworld.t
|
||||||
|
#
|
||||||
|
# Acceptance test for message encoding, based on .NET wsdl and example code.
|
||||||
|
# SOAP::WSDL's encoding doesn't I<exactly> match the .NET example, because
|
||||||
|
# .NET doesn't always specify types (SOAP::WSDL does), and the namespace
|
||||||
|
# prefixes chosen are different (maybe the encoding style, too ? this would be a bug !)
|
||||||
|
#
|
||||||
|
########################################################################################
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use diagnostics;
|
||||||
|
use Test::More tests => 6;
|
||||||
|
use Time::HiRes qw( gettimeofday tv_interval );
|
||||||
|
use lib '../lib';
|
||||||
|
use Cwd;
|
||||||
|
use_ok qw/SOAP::WSDL/;
|
||||||
|
|
||||||
|
### test vars END
|
||||||
|
print "# Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n";
|
||||||
|
print "# Acceptance test against sample output with simple WSDL\n";
|
||||||
|
|
||||||
|
my $data = {
|
||||||
|
name => 'test',
|
||||||
|
givenName => 'GIVENNAME',
|
||||||
|
test => {
|
||||||
|
name => 'TESTNAME',
|
||||||
|
givenName => 'GIVENNAME',
|
||||||
|
},
|
||||||
|
};
|
||||||
|
|
||||||
|
my $dir= cwd;
|
||||||
|
$dir=~s/\/t\/?$//;
|
||||||
|
|
||||||
|
# print $dir;
|
||||||
|
my $url = $dir . '/t/acceptance/test.wsdl.xml';
|
||||||
|
die "no wsdl found" if (not -e $url);
|
||||||
|
ok( my $soap=SOAP::WSDL->new( wsdl => 'file:///'. $url ), "Create SOAP::WSDL object");
|
||||||
|
$soap->no_dispatch( 1 );
|
||||||
|
|
||||||
|
eval{ $soap->wsdlinit() };
|
||||||
|
unless ($@) {
|
||||||
|
pass "wsdlinit";
|
||||||
|
} else {
|
||||||
|
fail "wsdlinit - $@";
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
ok( $soap->call(sayHello => %{ $data }) , "SOAP call");
|
||||||
|
|
||||||
|
is( $soap->servicename() , 'Service1', "Auto-detected servicename");
|
||||||
|
is( $soap->portname() , 'Service1Soap', "Auto-detected portname");
|
||||||
|
|
||||||
@@ -0,0 +1,19 @@
|
|||||||
|
# Addresses issue reported by David Bussenschutt
|
||||||
|
use Test::More tests => 1;
|
||||||
|
use lib '../lib';
|
||||||
|
use SOAP::Lite;
|
||||||
|
use SOAP::WSDL;
|
||||||
|
use File::Spec;
|
||||||
|
use File::Basename qw(dirname);
|
||||||
|
|
||||||
|
my $path = File::Spec->rel2abs( dirname __FILE__);
|
||||||
|
|
||||||
|
my $soap = SOAP::WSDL->new(
|
||||||
|
wsdl => "file://$path/acceptance/helloworld.asmx.xml"
|
||||||
|
);
|
||||||
|
my $transport = $soap->schema()->useragent()->protocols_forbidden(['file']);
|
||||||
|
|
||||||
|
# If it dies with 500 Access to 'file'..., wsdlinit uses the same UA...
|
||||||
|
eval { $soap->wsdlinit()};
|
||||||
|
ok index( $@, q{500 Access to 'file}) > 0;
|
||||||
|
|
||||||
Reference in New Issue
Block a user