Compare commits

..
20 Commits
Author SHA1 Message Date
Martin KutterandMichael G. Schwern c6a48ba84b import SOAP-WSDL 1.26 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  1.26
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-1.26.tar.gz
2009-12-12 19:48:00 -08:00
Martin KutterandMichael G. Schwern 30be0da3dc import SOAP-WSDL 2.00_16 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_16
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_16.tar.gz
2009-12-12 19:47:59 -08:00
Martin KutterandMichael G. Schwern 2347a88353 import SOAP-WSDL 1.25 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  1.25
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-1.25.tar.gz
2009-12-12 19:47:57 -08:00
Martin KutterandMichael G. Schwern 9e85f63aa0 import SOAP-WSDL 1.24 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  1.24
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-1.24.tar.gz
2009-12-12 19:47:56 -08:00
Martin KutterandMichael G. Schwern 7ba2f93e44 import SOAP-WSDL 2.00_15 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_15
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_15.tar.gz
2009-12-12 19:47:55 -08:00
Martin KutterandMichael G. Schwern 099c83b6bc import SOAP-WSDL 2.00_14 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_14
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_14.tar.gz
2009-12-12 19:47:53 -08:00
Martin KutterandMichael G. Schwern f63138fc87 import SOAP-WSDL 2.00_13 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_13
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_13.tar.gz
2009-12-12 19:47:52 -08:00
Martin KutterandMichael G. Schwern fd0854e34a import SOAP-WSDL 2.00_12 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_12
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_12.tar.gz
2009-12-12 19:47:49 -08:00
Martin KutterandMichael G. Schwern c2da74b5ae import SOAP-WSDL 2.00_11 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_11
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_11.tar.gz
2009-12-12 19:47:49 -08:00
Martin KutterandMichael G. Schwern 7ba1959888 import SOAP-WSDL 2.00_10 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_10
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_10.tar.gz
2009-12-12 19:47:48 -08:00
Martin KutterandMichael G. Schwern a554e87f49 import SOAP-WSDL 2.00_09 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_09
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_09.tar.gz
2009-12-12 19:47:47 -08:00
Martin KutterandMichael G. Schwern 312f3d6bbd import SOAP-WSDL 2.00_08 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_08
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_08.tar.gz
2009-12-12 19:47:46 -08:00
Martin KutterandMichael G. Schwern 40e0e67e84 import SOAP-WSDL 2.00_07 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_07
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_07.tar.gz
2009-12-12 19:47:45 -08:00
Martin KutterandMichael G. Schwern 25548e6296 import SOAP-WSDL 2.00_06 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_06
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_06.tar.gz
2009-12-12 19:47:44 -08:00
Martin KutterandMichael G. Schwern a78d6d15b5 import SOAP-WSDL 2.00_05 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_05
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_05.tar.gz
2009-12-12 19:47:43 -08:00
Martin KutterandMichael G. Schwern 5c42b1d8f6 import SOAP-WSDL 2.00_04 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_04
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_04.tar.gz
2009-12-12 19:47:43 -08:00
Martin KutterandMichael G. Schwern 21b5330a8d import SOAP-WSDL 2.00_03 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_03
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_03.tar.gz
2009-12-12 19:47:42 -08:00
Martin KutterandMichael G. Schwern 7716d4349a import SOAP-WSDL 2.00_02 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_02
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_02.tar.gz
2009-12-12 19:47:41 -08:00
Martin KutterandMichael G. Schwern 6fe52c4370 import SOAP-WSDL 2.00_01 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_01
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_01.tar.gz
2009-12-12 19:47:41 -08:00
Martin KutterandMichael G. Schwern bfbf5e27e0 import SOAP-WSDL 1.23 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  1.23
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-1.23.tar.gz
2009-12-12 19:47:40 -08:00
11 changed files with 2124 additions and 1897 deletions
+16 -3
View File
@@ -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;
+14
View File
@@ -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.
+3
View File
@@ -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
+3 -3
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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";
} }
+1 -1
View File
@@ -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
View File
@@ -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" ;
+55
View File
@@ -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");
+19
View File
@@ -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;