import SOAP-WSDL 2.00_31 from CPAN

git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_31
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_31.tar.gz
This commit is contained in:
Martin Kutter
2008-02-10 15:36:36 -08:00
committed by Michael G. Schwern
parent 874251225f
commit f0b3bdc201
54 changed files with 1094 additions and 450 deletions

View File

@@ -5,7 +5,7 @@ $build = Module::Build->new(
create_makefile_pl => 'passthrough',
dist_abstract => 'SOAP with WSDL support',
dist_name => 'SOAP-WSDL',
dist_version => '2.00_29',
dist_version => '2.00_31',
module_name => 'SOAP::WSDL',
license => 'artistic',
requires => {
@@ -24,6 +24,7 @@ $build = Module::Build->new(
'LWP::UserAgent' => 0,
'Template' => 0,
'Term::ReadKey' => 0,
'URI' => 0,
'XML::Parser::Expat' => 0,
},
buildrequires => {

44
Changes
View File

@@ -1,4 +1,4 @@
Release notes for SOAP::WSDL 2.00_29
Release notes for SOAP::WSDL 2.00_31
-------
I'm proud to present a new pre-release version of SOAP::WSDL.
@@ -34,6 +34,48 @@ Features:
The following changes have been made:
2.00_31 - Feb 11 2007
The following features were added (the numbers in square brackets are the
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
* [ 1883843 ] Support wsdl:import
* [ 1883863 ] Support xsd:import
The following bugs have been fixed (the numbers in square brackets are the
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
The numbers with # are CPAN RT IDs (http://rt.cpan.org/).
The following uncategorized improvements have been made:
* The WSDL Parser now warns about unsupported WSDL / XML schema elements
* Fixed path handling in t/006_client.t
* Removed useless ms regex flag in SOAP::WSDL::Factory::Transport
* The test suite has been improved
2.00_30 - unreleased
The following features were added (the numbers in square brackets are the
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
* [ 1875288 ] Support XML attributes (partial)
The following bugs have been fixed (the numbers in square brackets are the
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
The numbers with # are CPAN RT IDs (http://rt.cpan.org/).
* [ 1876435 ] Test on perl-5.10 fails
* #32611 empty complexType structure classes are missing 'use Class::Std::Fast::Storable'
The following uncategorized improvements have been made:
* ComplexType objects now accept { foo => undef } in constructor and handle
it as non-present child element foo.
* Updated test suite
* Updated SOAP::WSDL::Client::Base to correctly handle SOAP calls with
no parameters (empty parts)
* Test on perl-5.10 fails when SOAP::Lite is not installed
2.00_29
The following bugs have been fixed (the numbers in square brackets are the

View File

@@ -2,6 +2,7 @@ benchmark/01_expat.t
benchmark/hello.pl
benchmark/person.pl
benchmark/person.xml
benchmark/person_profile.pl
benchmark/XSD/01_anyType.t
benchmark/XSD/02_anySimpleType.t
benchmark/XSD/03_string.t
@@ -229,7 +230,6 @@ Makefile.PL
MANIFEST This list of files
META.yml
MIGRATING
patches/Manual.diff
README
t/001_use.t
t/002_parse_wsdl.t
@@ -281,7 +281,10 @@ t/acceptance/wsdl/email_account.wsdl
t/acceptance/wsdl/generator_test.wsdl
t/acceptance/wsdl/generator_test_dot_names.wsdl
t/acceptance/wsdl/generator_unsupported_test.wsdl
t/acceptance/wsdl/import.xsd
t/acceptance/wsdl/message_gateway.wsdl
t/acceptance/wsdl/WSDLParser-import.wsdl
t/acceptance/wsdl/WSDLParser-imported.wsdl
t/acceptance/wsdl/WSDLParser.wsdl
t/contributed.wsdl
t/Expat/03_wsdl.t
@@ -313,6 +316,7 @@ t/SOAP/WSDL/11_helloworld.NET.t
t/SOAP/WSDL/12_binding.t
t/SOAP/WSDL/Client.t
t/SOAP/WSDL/Client/Base.t
t/SOAP/WSDL/Definitions.t
t/SOAP/WSDL/Deserializer/Hash.t
t/SOAP/WSDL/Deserializer/SOM.t
t/SOAP/WSDL/Deserializer/XSD.t
@@ -330,6 +334,7 @@ t/SOAP/WSDL/Generator/XSD.t
t/SOAP/WSDL/Generator/XSD_dot_names.t
t/SOAP/WSDL/Generator/XSD_unsupported.t
t/SOAP/WSDL/Part.t
t/SOAP/WSDL/PortType.t
t/SOAP/WSDL/Serializer/XSD.t
t/SOAP/WSDL/Server.t
t/SOAP/WSDL/Server/CGI.t
@@ -338,8 +343,10 @@ t/SOAP/WSDL/Transport/02_HTTP.t
t/SOAP/WSDL/Transport/acceptance/test2.xml
t/SOAP/WSDL/Transport/acceptance/test3.xml
t/SOAP/WSDL/Typelib/Fault11.t
t/SOAP/WSDL/XSD/Attribute.t
t/SOAP/WSDL/XSD/ComplexType.t
t/SOAP/WSDL/XSD/Element.t
t/SOAP/WSDL/XSD/Schema.t
t/SOAP/WSDL/XSD/SimpleType.t
t/SOAP/WSDL/XSD/Typelib/Attribute.t
t/SOAP/WSDL/XSD/Typelib/Builtin/01_constructors.t

View File

@@ -1,6 +1,6 @@
---
name: SOAP-WSDL
version: 2.00_29
version: 2.00_31
author:
- 'Martin Kutter <martin.kutter@fen-net.de>'
abstract: SOAP with WSDL support
@@ -25,12 +25,13 @@ requires:
List::Util: 0
Template: 0
Term::ReadKey: 0
URI: 0
XML::Parser::Expat: 0
perl: 5.8.0
provides:
SOAP::WSDL:
file: lib/SOAP/WSDL.pm
version: 2.00_25
version: 2.00_31
SOAP::WSDL::Base:
file: lib/SOAP/WSDL/Base.pm
version: 2.00_27
@@ -77,7 +78,7 @@ provides:
version: 2.00_24
SOAP::WSDL::Factory::Transport:
file: lib/SOAP/WSDL/Factory/Transport.pm
version: 2.00_25
version: 2.00_31
SOAP::WSDL::Generator::Template:
file: lib/SOAP/WSDL/Generator/Template.pm
version: 2.00_25
@@ -139,7 +140,7 @@ provides:
version: 2.00_25
SOAP::WSDL::TypeLookup:
file: lib/SOAP/WSDL/TypeLookup.pm
version: 2.00_29
version: 2.00_31
SOAP::WSDL::Types:
file: lib/SOAP/WSDL/Types.pm
SOAP::WSDL::XSD::Attribute:
@@ -149,7 +150,7 @@ provides:
file: lib/SOAP/WSDL/XSD/Builtin.pm
SOAP::WSDL::XSD::ComplexType:
file: lib/SOAP/WSDL/XSD/ComplexType.pm
version: 2.00_25
version: 2.00_29
SOAP::WSDL::XSD::Element:
file: lib/SOAP/WSDL/XSD/Element.pm
version: 2.00_25
@@ -163,8 +164,10 @@ provides:
version: 2.00_25
SOAP::WSDL::XSD::Typelib::Attribute:
file: lib/SOAP/WSDL/XSD/Typelib/Attribute.pm
version: 2.00_29
SOAP::WSDL::XSD::Typelib::AttributeSet:
file: lib/SOAP/WSDL/XSD/Typelib/AttributeSet.pm
version: 2.00_29
SOAP::WSDL::XSD::Typelib::Builtin:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
version: 2.00_25
@@ -265,7 +268,7 @@ provides:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
SOAP::WSDL::XSD::Typelib::ComplexType:
file: lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
version: 2.00_29
version: 2.00_31
SOAP::WSDL::XSD::Typelib::Element:
file: lib/SOAP/WSDL/XSD/Typelib/Element.pm
version: 2.00_29

View File

@@ -1,7 +1,23 @@
MIGRATING
---------
This document describes how to migrate from 2.00_24 and before versions to
MIGRATING FROM PRE-2.00_29
--------------------------
SOAP::WSDL 2.00_29 added experimental XML attribute support. The attribute
support changed the code of the generated classes, which may now
require the class SOAP::WSDL::XSD::Typelib::Attribute introduced in the same
pre-release.
While interfaces generated with pre-releases back to 2.00_25 work without
change, this does not hold true vice versa: Interfaces generated with
2.00_29 and above won't work with older pre-releases.
You'll have to update SOAP::WSDL on all your machines.
MIGRATING FROM PRE-2.00_24
--------------------------
This section describes how to migrate from 2.00_24 and before versions to
2.00_25.
Migrating from 2.00_xx

View File

@@ -0,0 +1,11 @@
use lib '../lib';
use lib '../example/lib';
use lib '../../SOAP-WSDL_XS/blib/lib';
use lib '../../SOAP-WSDL_XS/blib/arch';
use strict;
use MyInterfaces::TestService::TestPort;
my $soap = MyInterfaces::TestService::TestPort->new();
# Load all classes - XML::Compile has created everything before, too
for (1..100) { $soap->ListPerson({}) };

View File

@@ -69,8 +69,6 @@ my $url = $ARGV[0];
pod2usage( -exit => 1 , verbose => 2 ) if ($opt{help});
pod2usage( -exit => 1 , verbose => 1 ) if not ($url);
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
local $ENV{HTTP_PROXY} = $opt{proxy} if $opt{proxy};
local $ENV{HTTPS_PROXY} = $opt{proxy} if $opt{proxy};
@@ -81,12 +79,11 @@ my $lwp = LWP::UserAgent->new(
);
$lwp->env_proxy(); # get proxy from environment. Works for both http & https.
my $response = $lwp->get($url);
die $response->message(), "\n" if $response->code != 200;
my $parser = SOAP::WSDL::Expat::WSDLParser->new({
user_agent => $lwp,
});
my $xml = $response->content();
my $definitions = $parser->parse_string( $xml );
my $definitions = $parser->parse_uri( $url );
my %typemap = ();
@@ -112,7 +109,7 @@ $generator->set_element_prefix($opt{ element_prefix }) if $generator->can('set_e
$generator->set_interface_prefix($opt{ interface_prefix }) if $generator->can('set_interface_prefix');
$generator->set_OUTPUT_PATH($opt{ base_path }) if $generator->can('set_OUTPUT_PATH');
$generator->set_definitions($definitions) if $generator->can('set_definitions');
$generator->set_wsdl($xml) if $generator->can('set_wsdl');
# $generator->set_wsdl($xml) if $generator->can('set_wsdl');
# start with typelib, as errors will most likely occur here...
$generator->generate();

View File

@@ -14,7 +14,7 @@ use Class::Std::Fast;
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
use LWP::UserAgent;
our $VERSION= '2.00_25';
our $VERSION= '2.00_31';
my %no_dispatch_of :ATTR(:name<no_dispatch>);
my %wsdl_of :ATTR(:name<wsdl>);
@@ -176,7 +176,7 @@ sub _wsdl_init_methods :PRIVATE {
my $ns = $wsdl->get_targetNamespace();
# get bindings, portType, message, part(s) - use private methods for clear separation...
$self->_wsdl_get_service if not ($service_of{ $ident });
$self->_wsdl_get_service();
$self->_wsdl_get_portType();
$method_info_of{ $ident } = {};
@@ -187,9 +187,10 @@ sub _wsdl_init_methods :PRIVATE {
# get SOAP Action
# SOAP-Action is a required HTTP Header, so we need to look it up...
# There must be a soapAction uri - or the WSDL is invalid (and
# it's not us to prove that...)
my $soap_binding_operation = $binding_operation->get_operation()->[0];
$method->{ soap_action } = $soap_binding_operation ?
$soap_binding_operation->get_soapAction() : $method;
$method->{ soap_action } = $soap_binding_operation->get_soapAction();
# get parts
# 1. get operation from port
@@ -204,7 +205,10 @@ sub _wsdl_init_methods :PRIVATE {
my $message = $wsdl->find_message( $ns, $localname )
or croak "Message {$ns}$localname not found in WSDL definition";
if (my $body=$binding_operation->first_input()->first_body()) {
# Is body not required? So there must be one? Do we need the "if"?
# if (
my $body=$binding_operation->first_input()->first_body();
# {
if ($body->get_parts()) {
$method->{ parts } = []; # make sure it's empty
my $message_part_ref = $message->get_part();
@@ -216,7 +220,9 @@ sub _wsdl_init_methods :PRIVATE {
grep { $_->get_name() eq $name } @{ $message_part_ref };
}
}
}
# }
# A body does not need to specify the parts of a messages.
# Use all of the message's parts if it does not.
$method->{ parts } ||= $message->get_part();
# rpc / encoded methods may have a namespace specified.
@@ -730,9 +736,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 477 $
$Rev: 524 $
$LastChangedBy: kutterma $
$Id: WSDL.pm 477 2007-12-24 10:23:52Z kutterma $
$Id: WSDL.pm 524 2008-02-10 23:24:43Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL.pm $
=cut

View File

@@ -8,22 +8,32 @@ our $VERSION = '2.00_25';
sub call {
my ($self, $method, $body, $header) = @_;
# Treat non-objects special
if (not blessed $body) {
# make sure there's something sensible in our body data
$body = {} if not defined $body;
$body = ref $body eq 'ARRAY' ? $body : [ $body ];
my $index = 0;
my @part_from;
foreach my $part (@{ $body }) {
my $class = $method->{ body }->{ parts }->[$index];
my @body_from = @{ $body }; # make a copy
# build list of parts as objects initialized with
# parameters given
my @part_from = ();
foreach my $class (@{ $method->{ body }->{ parts } }) {
eval "require $class" || die $@;
push @part_from, $class->new($part);
$index++;
push @part_from, $class->new(shift(@body_from) || {});
}
# it's either the first part or a list ref with all parts...
$body = $#part_from ? \@part_from : $part_from[0];
}
# if we have a header
if (%{ $method->{ header } }) {
# trat non object special - as above, but only for one
if (not blessed $header) {
my $class = $method->{ header }->{ parts }->[0];
eval "require $class" || die $@;
@@ -33,39 +43,6 @@ sub call {
return $self->SUPER::call($method, $body, $header);
}
#sub __create_methods {
# my ($package, %info_of) = @_;
#
# no strict qw(refs);
# no warnings qw(redefine);
# for my $method (keys %info_of){
# my ($soap_action, @parts);
#
# # up to 2.00_10 we had list refs...
# if (ref $info_of{ $method }eq 'HASH') {
# @parts = @{ $info_of{ $method }->{ parts } };
# $soap_action = $info_of{ $method }->{ soap_action };
# }
# else {
# die "Pre-v2.00_10 Interfaces are no longer supported. Please re-generate your interface.";
# }
#
# *{ "$package\::$method" } = sub {
# my $self = shift;
# my @param = map {
# my $data = shift || {};
# eval "require $_";
# $_->new( $data );
# } @parts;
#
# return $self->SUPER::call( {
# operation => $method,
# soap_action => $soap_action,
# }, @param );
# }
# }
#}
1;
__END__
@@ -101,9 +78,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 440 $
$Rev: 501 $
$LastChangedBy: kutterma $
$Id: Base.pm 440 2007-12-04 22:24:33Z kutterma $
$Id: Base.pm 501 2008-01-26 20:23:32Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client/Base.pm $
=cut

View File

@@ -23,7 +23,8 @@ sub BUILD {
sub deserialize {
my ($self, $content) = @_;
$parser_of{ ${ $self } } ||= SOAP::WSDL::Expat::MessageParser->new();
$parser_of{ ${ $self } } = SOAP::WSDL::Expat::MessageParser->new()
if not $parser_of{ ${ $self } };
$parser_of{ ${ $self } }->class_resolver( $class_resolver_of{ ident $self } );
eval { $parser_of{ ${ $self } }->parse_string( $content ) };
if ($@) {
@@ -98,9 +99,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 427 $
$Rev: 501 $
$LastChangedBy: kutterma $
$Id: XSD.pm 427 2007-12-02 22:20:24Z kutterma $
$Id: XSD.pm 501 2008-01-26 20:23:32Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Deserializer/XSD.pm $
=cut

View File

@@ -1,17 +1,47 @@
package SOAP::WSDL::Expat::Base;
use strict;
use warnings;
use URI;
use XML::Parser::Expat;
# TODO: convert to Class::Std::Fast based class - hash based classes suck.
our $VERSION = '2.00_27';
sub new {
my ($class, $args) = @_;
my ($class, $arg_ref) = @_;
my $self = {};
bless $self, $class;
$self->set_user_agent($arg_ref->{ user_agent })
if $arg_ref->{ user_agent };
return $self;
}
sub set_uri { $_[0]->{ uri } = $_[1]; }
sub get_uri { return $_[0]->{ uri }; }
sub set_user_agent { $_[0]->{ user_agent } = $_[1]; }
sub get_user_agent { return $_[0]->{ user_agent }; }
sub parse_uri {
my $self = shift;
my $uri = shift;
$self->set_uri( $uri );
if (not $self->{ user_agent }) {
require LWP::UserAgent;
$self->{ user_agent } = LWP::UserAgent->new();
}
my $response = $self->{ user_agent }->get($uri);
die $response->message() if $response->code() ne '200';
return $self->parse( $response->content() );
}
sub parse {
eval {
$_[0]->_initialize( XML::Parser::Expat->new( Namespaces => 1 ) )->parse( $_[1] );

View File

@@ -171,6 +171,7 @@ sub _initialize {
$current = bless \$o, $_class;
}
# set attributes if there are any
$current->attr({ @_[2..$#_] }) if (@_ > 2);
$depth++;
@@ -294,8 +295,8 @@ the same terms as perl itself
$Id: $
$LastChangedDate: 2008-01-19 13:57:57 +0100 (Sa, 19 Jan 2008) $
$LastChangedRevision: 497 $
$LastChangedDate: 2008-02-02 10:19:45 +0100 (Sa, 02 Feb 2008) $
$LastChangedRevision: 516 $
$LastChangedBy: kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $

View File

@@ -5,7 +5,57 @@ use Carp;
use SOAP::WSDL::TypeLookup;
use base qw(SOAP::WSDL::Expat::Base);
our $VERSION = q{2.00_29};
our $VERSION = q{2.00_31};
sub _import_children {
my ($self, $name, $imported, $importer, $import_namespace) = @_;
my $targetNamespace = $importer->get_targetNamespace();
my $push_method = "push_$name";
my $get_method = "get_$name";
no strict qw(refs);
my $value_ref = $imported->$get_method();
if ($value_ref) {
$value_ref = [ $value_ref ] if (not ref $value_ref eq 'ARRAY');
# set xmlns - can be different from parent
for (@{ $value_ref }) {
# fixup targetNamespace, but don't override
$_->set_targetNamespace( $import_namespace )
if ( ($import_namespace ne $targetNamespace) && ! $_->get_targetNamespace);
# update parent...
$_->set_parent( $importer );
}
# push elements into importing WSDL
$importer->$push_method(@{ $value_ref });
}
}
sub xml_schema_import {
my $self = shift;
my $schema = shift;
my $parser = ref($self)->new();
my %attr_of = @_;
my $import_namespace = $attr_of{ namespace };
my $uri = URI->new_abs($attr_of{schemaLocation}, $self->get_uri() );
my $import = $parser->parse_uri($uri);
for my $name ( qw(type element group) ) {
$self->_import_children( $name, $import, $schema, $import_namespace);
}
}
sub wsdl_import {
my $self = shift;
my $definitions = shift;
my $parser = ref($self)->new();
my %attr_of = @_;
my $import_namespace = $attr_of{ namespace };
my $uri = URI->new_abs($attr_of{location}, $self->get_uri() );
my $import = $parser->parse_uri($uri);
for my $name ( qw(types message binding portType service) ) {
$self->_import_children( $name, $import, $definitions, $import_namespace);
}
}
sub _initialize {
my ($self, $parser) = @_;
@@ -81,6 +131,20 @@ sub _initialize {
: _fixup_attrs($parser, %attrs)
);
}
elsif ($action->{type} eq 'HANDLER') {
my $method = $self->can($action->{method});
$method->($self, $current, %attrs);
}
else {
# TODO replace by hash lookup of known namespaces.
my $namespace = $parser->namespace($localname) || q{};
my $part = $namespace eq 'http://schemas.xmlsoap.org/wsdl/'
? 'WSDL 1.1'
: 'XML Schema';
warn "$part element <$localname> is not implemented yet"
if ($localname !~m{ \A (:? annotation | documentation ) \z }xms );
}
return;
},
@@ -179,8 +243,8 @@ the same terms as perl itself
$Id: $
$LastChangedDate: 2007-12-24 11:23:52 +0100 (Mo, 24 Dez 2007) $
$LastChangedRevision: 477 $
$LastChangedDate: 2008-02-11 00:14:27 +0100 (Mo, 11 Feb 2008) $
$LastChangedRevision: 522 $
$LastChangedBy: kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/WSDLParser.pm $

View File

@@ -16,7 +16,7 @@ sub register {
sub get_deserializer {
my ($self, $args_of_ref) = @_;
$args_of_ref->{ soap_version } ||= '1.1';
# sanity check
die "no deserializer registered for SOAP version $args_of_ref->{ soap_version }"
if not exists ($DESERIALIZER{ $args_of_ref->{ soap_version } });

View File

@@ -16,7 +16,7 @@ sub register {
sub get_serializer {
my ($self, $args_of_ref) = @_;
$args_of_ref->{ soap_version } ||= '1.1';
# sanity check
die "no serializer registered for SOAP version $args_of_ref->{ soap_version }"
if not exists ($SERIALIZER{ $args_of_ref->{ soap_version } });
@@ -138,9 +138,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 391 $
$Rev: 510 $
$LastChangedBy: kutterma $
$Id: Serializer.pm 391 2007-11-17 21:56:13Z kutterma $
$Id: Serializer.pm 510 2008-01-29 08:03:46Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
=cut

View File

@@ -2,7 +2,7 @@ package SOAP::WSDL::Factory::Transport;
use strict;
use warnings;
our $VERSION='2.00_25';
our $VERSION='2.00_31';
# class data
my %registered_transport_of = ();
@@ -34,7 +34,7 @@ sub register {
sub get_transport {
my ($class, $scheme, %attrs) = @_;
$scheme =~s{ \A ([^\:]+) \: .+ }{$1}smx;
$scheme =~s{ \A ([^\:]+) \: .+ }{$1}x;
if ($registered_transport_of{ $scheme }) {
no strict qw(refs);
@@ -240,9 +240,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 459 $
$Rev: 524 $
$LastChangedBy: kutterma $
$Id: Transport.pm 459 2007-12-16 16:00:14Z kutterma $
$Id: Transport.pm 524 2008-02-10 23:24:43Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Transport.pm $
=cut

View File

@@ -9,7 +9,12 @@ ELSIF (complexType.get_variety == 'choice');
INCLUDE complexType/all.tt(complexType = complexType);
ELSIF (complexType.get_variety);
THROW NOT_IMPLEMENTED, "Unknown variety ${ complexType.get_variety } in ${ complexType.get_name } (${ element.get_name })";
ELSE;
# There's no variety - might be empty complexType
END;
%]
ELSE %]
# There's no variety - empty complexType
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
__PACKAGE__->_factory();
[% END %]

View File

@@ -34,11 +34,11 @@ considered as bugs.
=item * RULES NOT APPLICABLE
WS-I Basic Profile contains rules for web services as a whole. SOAP::WSDL only
plays the part of one layer in a Web Service CONSUMER, thus does not implement
some parts the WS-I Basic Profile references.
plays the part of one layer in a Web Service CONSUMER / RECEIVER, thus does
not implement some parts the WS-I Basic Profile references.
This section contains rules not applicable for SOAP::WSDL, because they refer
parts to web service SOAP::WSDL does not implement.
to parts SOAP::WSDL does not implement.
=back
@@ -427,9 +427,10 @@ TODO support rpc-literal bindings.
In a DESCRIPTION the value of the location attribute of a wsdl:import element
SHOULD be treated as a hint.
SOAP::WSDL's schema parser does not handle import elements yet.
The wsdl:import element imports the referenced WSDL definition.
TODO implement support for wsdl:import in SOAP::WSDL::Expat::WSDLParser.
This is rather hard-wired and does not allow to specify a wsdl:import without
a resolvable location.
=head2 R4002
@@ -448,9 +449,7 @@ TODO Test whether UTF-16 works.
The wsdl:documentation element MAY occur as a child of the wsdl:import
element in a DESCRIPTION.
SOAP::WSDL's schema parser does not handle import elements yet.
TODO implement support for wsdl:import in SOAP::WSDL::Expat::WSDLParser.
Not tested yet.
=head2 R2024
@@ -681,7 +680,11 @@ is Schema valid.
A DESCRIPTION MUST only use the WSDL "import" statement to import another
WSDL description.
SOAP::WSDL has no means of generating WSDL definitions
SOAP::WSDL (partially) supports the wsdl:import statement. The wsdl:include
statement is not supported (yet).
It's the responsibility of the WSDL author to use only the wsdl:import
statement for importing WSDL descriptions.
=head2 R2002
@@ -1249,9 +1252,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 478 $
$Rev: 514 $
$LastChangedBy: kutterma $
$Id: WS_I.pod 478 2007-12-27 14:15:01Z kutterma $
$Id: WS_I.pod 514 2008-01-31 19:57:52Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Manual/WS_I.pod $
=cut

View File

@@ -5,6 +5,7 @@ use warnings;
use Class::Std::Fast::Storable;
use Scalar::Util qw(blessed);
our $VERSION=q{2.00_27};
use SOAP::WSDL::Factory::Serializer;
my $SOAP_NS = 'http://schemas.xmlsoap.org/soap/envelope/';
my $XML_INSTANCE_NS = 'http://www.w3.org/2001/XMLSchema-instance';
@@ -119,9 +120,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 477 $
$Rev: 510 $
$LastChangedBy: kutterma $
$Id: XSD.pm 477 2007-12-24 10:23:52Z kutterma $
$Id: XSD.pm 510 2008-01-29 08:03:46Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Serializer/XSD.pm $
=cut

View File

@@ -2,11 +2,15 @@ package SOAP::WSDL::TypeLookup;
use strict;
use warnings;
our $VERSION=q{2.00_29};
our $VERSION=q{2.00_31};
my %TYPES = (
# wsdl:
'http://schemas.xmlsoap.org/wsdl/' => {
'import' => {
type => 'HANDLER',
method => 'wsdl_import',
},
binding => {
type => 'CLASS',
class => 'SOAP::WSDL::Binding',
@@ -83,6 +87,10 @@ my %TYPES = (
}
},
'http://www.w3.org/2001/XMLSchema' => {
'import' => {
type => 'HANDLER',
method => 'xml_schema_import',
},
schema => {
type => 'CLASS',
class => 'SOAP::WSDL::XSD::Schema',

View File

@@ -18,7 +18,7 @@ sub serialize {
my $prefix = $prefix_of{ $ns }
|| die 'No prefix found for namespace '. $ns;
$xml .= ' type="' . $prefix . ':'
. $self->get_name() . '"' if ($self->get_name() );
. $self->get_name() . '"';
}
if (defined $value) {

View File

@@ -6,7 +6,7 @@ use Class::Std::Fast::Storable;
use Scalar::Util qw(blessed);
use base qw/SOAP::WSDL::Base/;
our $VERSION=q{2.00_25};
our $VERSION=q{2.00_29};
my %annotation_of :ATTR(:name<annotation> :default<()>);
my %attribute_of :ATTR(:name<attribute> :default<()>);

View File

@@ -53,7 +53,7 @@ sub serialize {
# TODO: implement final and substitutionGroup - maybe never implement
# substitutionGroup ?
$name ||= $self->get_name();
$name = $self->get_name() if not ($name);
if ( $opt->{ qualify } ) {
$opt->{ attributes } = [ ' xmlns="' . $self->get_targetNamespace .'"' ];

View File

@@ -4,6 +4,8 @@ use warnings;
use base qw(SOAP::WSDL::XSD::Typelib::Element);
our $VERSION=q{2.00_29};
sub start_tag {
# my ($self, $opt, $value) = @_;
return q{} if (@_ < 3);

View File

@@ -3,6 +3,8 @@ use strict;
use warnings;
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
our $VERSION=q{2.00_29};
sub serialize {
# we work on @_ for performance.
$_[1] ||= {}; # $option_ref

View File

@@ -9,7 +9,7 @@ require Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
our $VERSION = '2.00_29';
our $VERSION = '2.00_31';
my %ELEMENTS_FROM;
my %ATTRIBUTES_OF;
@@ -45,6 +45,10 @@ my %xml_attr_of :ATTR();
sub attr {
my $self = shift;
my $class = ref $self;
# disable strictness - in perl 5.10 %{ "$foo\::_bar" } triggers a
# symbolic reference error with strictness enabled
no strict qw(refs);
die "$class has no attributes" if not defined %{ "$class\::_ATTR::"};
if (@_) {
# setter
@@ -176,7 +180,7 @@ sub _factory {
: die croak "cannot use $is_ref reference as value for $name - $type required"
# not $is_ref
: $type->new({ value => $_[1] });
: defined $_[1] ? $type->new({ value => $_[1] }) : () ;
return;
};
@@ -223,7 +227,7 @@ sub _factory {
: $_ =~ m{ \A # beginning of string
xmlns # xmlns
}xms # get_elements is inlined for performance.
? do {}
? ()
: do { use Data::Dumper;
croak "unknown field $_ in $class. Valid fields are:\n"
. join(', ', @{ $ELEMENTS_FROM{ $class } }) . "\n"
@@ -455,9 +459,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 497 $
$Rev: 524 $
$LastChangedBy: kutterma $
$Id: ComplexType.pm 497 2008-01-19 12:57:57Z kutterma $
$Id: ComplexType.pm 524 2008-02-10 23:24:43Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm $
=cut

View File

@@ -175,9 +175,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 497 $
$Rev: 498 $
$LastChangedBy: kutterma $
$Id: Element.pm 497 2008-01-19 12:57:57Z kutterma $
$Id: Element.pm 498 2008-01-20 22:47:18Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/XSD/Typelib/Element.pm $
=cut

View File

@@ -1,44 +0,0 @@
--- Manual.pod-orig 2007-12-04 00:45:33.000000000 -0500
+++ Manual.pod 2007-12-04 00:53:12.000000000 -0500
@@ -37,7 +37,7 @@
objects based on SOAP::WSDL's XML schema implementation.
To access the object's properties use get_NAME / set_NAME getter/setter
-methods whith NAME corresponding to the XML tag name / the hash structure as
+methods with NAME corresponding to the XML tag name / the hash structure as
showed in the generated pod.
=item * Run script
@@ -91,7 +91,7 @@
There should be a bunch of classes for types (in the MyTypes:: namespace by
default), elements (in MyElements::), and at least one typemap (in
-MyTypemaps::) and one ore more interface classes (in MyInterfaces::).
+MyTypemaps::) and one or more interface classes (in MyInterfaces::).
If you don't already know the details of the web service you're going to
instrument, it's now time to read the perldoc of the generated interface
@@ -111,7 +111,7 @@
print $result;
The above handling of errors ("die $result if not $result") may look a bit
-strange - it is due to the nature of
+strange - it is due to the nature of the
L<SOAP::WSDL::SOAP::Typelib::Fault11|SOAP::WSDL::SOAP::Typelib::Fault11>
objects SOAP::WSDL uses for signalling failure.
@@ -144,12 +144,12 @@
only implement a few by hand. These (precious) few classes may get lost in
the mass of (cheap) generated ones. Just imagine one of your co-workers (or
even yourself) deleting the whole bunch and re-generating everything - oops
-- almost everything. You got the point.
+- almost everything. You get the point.
For simplicity, you probably just want to use builtin types wherever possible
- you are probably not interested in whether a fault detail's error code is
presented to you as a simpleType ranging from 1 to 10 (which you have to
-write) or as a int (which is a builtin type ready to use).
+write) or as an int (which is a builtin type ready to use).
Using builtin types for simpleType definitions may greatly reduce the number
of additional classes you need to implement.

View File

@@ -4,23 +4,26 @@ use warnings;
use diagnostics;
use Test::More tests => 17; # qw/no_plan/; # TODO: change to tests => N;
use lib '../lib';
use File::Spec;
use File::Basename qw(dirname);
eval {
require Test::XML;
import Test::XML
};
use Cwd;
my $path = cwd;
$path =~s|\/t\/?$||; # allow running from t/ and above (Build test)
my $path = File::Spec->rel2abs( dirname __FILE__ );
my ($volume, $dir) = File::Spec->splitpath($path, 1);
my @dir_from = File::Spec->splitdir($dir);
unshift @dir_from, $volume if $volume;
my $url = join '/', @dir_from;
use_ok(qw/SOAP::WSDL/);
my $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path .'/t/acceptance/wsdl/006_sax_client.wsdl',
outputxml => 1, # required, if not set ::SOM serializer will be loaded on
# call
my $soap;
$soap = SOAP::WSDL->new(
wsdl => 'file:///' . $url .'/acceptance/wsdl/006_sax_client.wsdl',
outputxml => 1, # required, if not set ::SOM serializer will be loaded
)->wsdlinit();
$soap->servicename('MessageGateway');

View File

@@ -1,5 +1,5 @@
#!/usr/bin/perl
use Test::More tests => 9;
use Test::More tests => 10;
use strict;
use lib 'lib/';
use lib '../lib/';
@@ -48,16 +48,23 @@ ok $result->isa('SOAP::WSDL::SOAP::Typelib::Fault11'),
'return fault on impossible call';
ok ! $result, 'fault is false in boolean context';
package FakeResolver;
sub get_class {
my %class_list = (
# $soap->no_dispatch(1);
ok ! $soap->call('Test'), 'second call';
package FakeResolver;
my %class_list = (
'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11',
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyType',
);
sub get_class {
return $class_list{ $_[1] };
}
sub get_typemap {
return \%class_list;
}

View File

@@ -2,11 +2,11 @@ use strict;
use warnings;
use Test::More tests => 12;
use File::Spec;
use File::Basename;
use File::Basename qw(dirname);
use_ok qw(SOAP::WSDL);
my $path = File::Spec->rel2abs(dirname( __FILE__ ) );
$path =~s{\\}{/}xmsg; # fix for windows
my $soap = SOAP::WSDL->new();
$soap->wsdl("file://$path/WSDL_NOT_FOUND.wsdl");

View File

@@ -1,4 +1,4 @@
use Test::More tests => 7;
use Test::More tests => 10;
use strict;
use warnings;
use diagnostics;
@@ -29,3 +29,12 @@ ok( $soap->wsdlinit(), 'parsed WSDL' );
ok( $soap->wsdlinit( servicename => 'testService', portname => 'testPort'), 'parsed WSDL' );
ok( ($soap->portname() eq 'testPort' ), 'found port passed to wsdlinit');
ok( $soap = SOAP::WSDL->new(
wsdl => 'file://' . $url . '/../../acceptance/wsdl/02_port.wsdl'
), 'Instantiated object' );
ok( $soap->wsdlinit() );
$soap->outputxml(1);
eval { $soap->call('test') };
like $@, qr{type \s tns:testSimpleType1 \s , \s urn:simpleType \s not \s found}xms;

View File

@@ -1,4 +1,4 @@
use Test::More tests => 8;
use Test::More tests => 9;
use strict;
use warnings;
use lib '../lib';
@@ -28,7 +28,11 @@ ok( $soap = SOAP::WSDL->new(
), 'Instantiated object' );
#3
$soap->readable(1);
SKIP: {
skip 'Cannot test warning without Test::Warn', 1 if not (eval "require Test::Warn");
Test::Warn::warning_like( sub { $soap->readable(1) },
qr{\A 'readable' \s has \s no \s effect \s any \s more}xms);
}
$soap->outputxml(1);
ok( $soap->wsdlinit(

View File

@@ -1,6 +1,6 @@
use strict;
use warnings;
use Test::More tests => 4; #qw(no_plan);
use Test::More tests => 8; #qw(no_plan);
use_ok qw(SOAP::WSDL::Client);
@@ -11,3 +11,27 @@ ok $client = SOAP::WSDL::Client->new({
});
is $client->get_endpoint(), 'http://localhost';
$client->no_dispatch(1);
$client->set_serializer('main');
my $serialize = $client->call({
operation => 'testMethod'
}, { foo => 'bar'}, { bar => 'baz'});
is $serialize->{ body }->{ foo }, 'bar';
is $serialize->{ header }->{ bar }, 'baz';
# Old calling style compatibility test - foo => bar is body...
$serialize = $client->call({
operation => 'testMethod'
}, foo => 'bar');
is $serialize->{ body }->{ foo }, 'bar';
# Old calling style compatibility test - foo => bar is body...
$serialize = $client->call('testMethod', foo => 'bar');
is $serialize->{ body }->{ foo }, 'bar';
sub serialize {
my $self = shift;
return shift;
}

View File

@@ -4,11 +4,9 @@ use Class::Std::Fast;
package main;
use strict;
use warnings;
use Test::More tests => 9;
use Test::More tests => 21;
use_ok qw(SOAP::WSDL::Client::Base);
my $client = SOAP::WSDL::Client::Base->new();
{
no warnings qw(redefine once);
*SOAP::WSDL::Client::call = sub { is $_[1]->{ operation }, 'sayHello', 'Called method';
@@ -16,6 +14,8 @@ my $client = SOAP::WSDL::Client::Base->new();
};
}
my $client = SOAP::WSDL::Client::Base->new();
my @result = $client->call({
operation => 'sayHello',
soap_action => 'urn:HelloWorld#sayHello',
@@ -25,19 +25,23 @@ my @result = $client->call({
'use' => 'literal',
namespace => '',
encodingStyle => '',
parts => [qw( SOAP::WSDL::XSD::Typelib::Builtin::string )],
parts => [qw( SOAP::WSDL::XSD::Typelib::Builtin::string
SOAP::WSDL::XSD::Typelib::Builtin::string
)],
},
header => {
parts => [qw( SOAP::WSDL::XSD::Typelib::Builtin::string )],
parts => [qw( SOAP::WSDL::XSD::Typelib::Builtin::string
)],
},
headerfault => {
}
}, { value => 'Body' }, { value => 'Header' });
is $result[0], 'Body';
is $result[0]->[0], 'Body';
is $result[1], 'Header';
isa_ok $result[0], 'SOAP::WSDL::XSD::Typelib::Builtin::string';
isa_ok $result[0]->[0], 'SOAP::WSDL::XSD::Typelib::Builtin::string';
@result = $client->call({
operation => 'sayHello',
@@ -64,3 +68,97 @@ is $result[0], 'Body2';
is $result[1], 'Header2';
isa_ok $result[1], 'SOAP::WSDL::XSD::Typelib::Builtin::string';
# Call with more body parts than parameters. Body parts are empty
@result = $client->call({
operation => 'sayHello',
soap_action => 'urn:HelloWorld#sayHello',
style => 'document',
body => {
'use' => 'literal',
namespace => '',
encodingStyle => '',
parts => [qw( SOAP::WSDL::XSD::Typelib::Builtin::string )],
},
header => {
parts => [qw( SOAP::WSDL::XSD::Typelib::Builtin::string )],
},
headerfault => {
}
}, [],
SOAP::WSDL::XSD::Typelib::Builtin::string->new({ value => 'Header2' })
);
isa_ok $result[0], 'SOAP::WSDL::XSD::Typelib::Builtin::string';
is $result[0], undef;
is $result[1], 'Header2';
isa_ok $result[1], 'SOAP::WSDL::XSD::Typelib::Builtin::string';
# Call with more body parts than parameters. Body parts are empty
# No header
@result = $client->call({
operation => 'sayHello',
soap_action => 'urn:HelloWorld#sayHello',
style => 'document',
body => {
'use' => 'literal',
namespace => '',
encodingStyle => '',
parts => [qw( SOAP::WSDL::XSD::Typelib::Builtin::string )],
},
header => {
},
headerfault => {
}
});
isa_ok $result[0], 'SOAP::WSDL::XSD::Typelib::Builtin::string';
is $result[0], undef;
eval { $client->call({
operation => 'sayHello',
soap_action => 'urn:HelloWorld#sayHello',
style => 'document',
body => {
'use' => 'literal',
namespace => '',
encodingStyle => '',
parts => [qw( SomeStupidClassYouProbablyDontHaveOnYourSystem )],
},
header => {
},
headerfault => {
}
})
};
like $@, qr{ Can't \s locate }xms;
isa_ok $result[0], 'SOAP::WSDL::XSD::Typelib::Builtin::string';
is $result[0], undef;
eval { $client->call({
operation => 'sayHello',
soap_action => 'urn:HelloWorld#sayHello',
style => 'document',
body => {
'use' => 'literal',
namespace => '',
encodingStyle => '',
parts => [qw( SOAP::WSDL::XSD::Typelib::Builtin::string )],
},
header => {
parts => [qw( SomeOtherStupidClassYouProbablyDontHaveOnYourSystem )],
},
headerfault => {
}
})
};
# die $@;
like $@, qr{ Can't \s locate }xms;

32
t/SOAP/WSDL/Definitions.t Normal file
View File

@@ -0,0 +1,32 @@
use strict;
use warnings;
use Test::More tests => 4;
use SOAP::WSDL::PortType;
use_ok qw(SOAP::WSDL::Definitions);
my $obj = SOAP::WSDL::Definitions->new({
portType => [
SOAP::WSDL::PortType->new({
name => 'foo',
targetNamespace => 'bar',
}),
SOAP::WSDL::PortType->new({
name => 'foo',
targetNamespace => 'baz',
}),
SOAP::WSDL::PortType->new({
name => 'foobar',
targetNamespace => 'bar',
}),
]
});
my $found= $obj->find_portType('bar', 'foobar');
is $found->get_name(), 'foobar', 'found PortType';
$found = $obj->find_portType('baz', 'foo');
is $found->get_name(), 'foo', 'found PortType';
$found = $obj->find_portType('baz', 'foobar');
is $found, undef, 'find_PortType returns undef on unknown PortType';

View File

@@ -4,7 +4,7 @@ package TestResolver;
sub get_typemap { {} };
package main;
use Test::More tests => 8;
use Test::More tests => 9;
use SOAP::WSDL::Deserializer::XSD;
@@ -25,3 +25,6 @@ is $fault->get_faultcode(), 'soap:Client';
isa_ok $obj->deserialize('rubbeldiekatz'), 'SOAP::WSDL::SOAP::Typelib::Fault11';
isa_ok $obj->deserialize('<zumsel></zumsel>'), 'SOAP::WSDL::SOAP::Typelib::Fault11';
isa_ok $obj->deserialize('<Envelope xmlns="huchmampf"></Envelope>'), 'SOAP::WSDL::SOAP::Typelib::Fault11';
is $obj->deserialize('<SOAP-ENV:Envelope
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
<SOAP-ENV:Body ></SOAP-ENV:Body></SOAP-ENV:Envelope>'), undef, 'Deserialize empty envelope';

View File

@@ -1,6 +1,6 @@
use strict;
use warnings;
use Test::More tests => 3;
use Test::More tests => 5;
use_ok qw(SOAP::WSDL::Expat::Base);
my $parser = SOAP::WSDL::Expat::Base->new();
@@ -10,3 +10,12 @@ ok $@;
eval { $parser->parsefile('Foobar')};
ok $@;
$parser = SOAP::WSDL::Expat::Base->new({
user_agent => 'foo',
});
is $parser->get_user_agent(), 'foo';
$parser->set_user_agent('bar');
is $parser->get_user_agent(), 'bar';

View File

@@ -36,20 +36,20 @@ my $xml_attr = q{<SOAP-ENV:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
<SOAP-ENV:Body><MyElementAttrs xmlns="urn:Test" test="Test" test2="Test2">
<test>Test</test>
<test2 >Test2</test2>
<test2 > </test2>
</MyElementAttrs></SOAP-ENV:Body></SOAP-ENV:Envelope>};
$parser->parse($xml_attr);
is $parser->get_data(),
q{<MyElementAttrs xmlns="urn:Test" test="Test" test2="Test2"><test>Test</test><test2>Test2</test2></MyElementAttrs>},
q{<MyElementAttrs xmlns="urn:Test" test="Test" test2="Test2"><test>Test</test></MyElementAttrs>},
'Content with attributes';
my $xml_error = q{<SOAP-ENV:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
<SOAP-ENV:Body><MyElementAttrs xmlns="urn:Test" test="Test" test2="Test2">
<test>Test</test>
<test2 >Test2</test2>
<test2 ></test2>
<foo>Bar</foo>
</MyElementAttrs></SOAP-ENV:Body></SOAP-ENV:Envelope>};

View File

@@ -1,6 +1,6 @@
use strict;
use warnings;
use Test::More tests => 4; #qw(no_plan);
use Test::More tests => 10; #qw(no_plan);
use File::Spec;
use File::Basename;
@@ -30,16 +30,27 @@ my $generator = SOAP::WSDL::Generator::Template::XSD->new({
OUTPUT_PATH => "$path/testlib",
});
my $code = "";
$generator->set_output(\$code);
$generator->generate_typelib();
{
eval $code;
ok !$@;
print $@ if $@;
}
#my $code = "";
#$generator->set_output(\$code);
#$generator->generate_typelib();
#{
# eval $code;
# ok !$@;
# print $@ if $@;
#}
# print $code;
$definitions = $parser->parse_uri(
"file://$path/../../../acceptance/wsdl/WSDLParser-import.wsdl"
);
ok my $service = $definitions->first_service();
is $service->get_name(), 'Service1', 'wsdl:import service name';
is $definitions->first_binding()->get_name(), 'Service1Soap', 'wsdl:import binding name';
ok my $schema_from_ref = $definitions->first_types()->get_schema();
is @{ $schema_from_ref }, 2, 'got builtin and imported schema';
ok @{ $schema_from_ref->[1]->get_element } > 0;
is $schema_from_ref->[1]->get_element->[0]->get_name(), 'sayHello';
__END__

View File

@@ -1,9 +1,13 @@
use strict;
use warnings;
use Test::More tests => 5;
use Test::More tests => 6;
use Scalar::Util qw(blessed);
use SOAP::WSDL::Factory::Transport;
eval { SOAP::WSDL::Factory::Transport->get_transport('') };
like $@, qr{^no transport};
eval { SOAP::WSDL::Factory::Transport->get_transport('zumsl') };
like $@, qr{^no transport};
@@ -12,7 +16,7 @@ ok blessed $obj;
SOAP::WSDL::Factory::Transport->register('zumsl', 'Hope_You_Have_No_Such_Package_Installed');
eval { SOAP::WSDL::Factory::Transport->get_transport('zumsl') };
eval { SOAP::WSDL::Factory::Transport->get_transport('zumsl:foo') };
like $@, qr{^Cannot load};
eval { SOAP::WSDL::Factory::Transport->register( \'zumsl', 'Foo') };

View File

@@ -1,4 +1,4 @@
use Test::More tests => 38;
use Test::More tests => 41;
use File::Basename qw(dirname);
use File::Spec;
use File::Path;
@@ -149,5 +149,12 @@ is $ct_east->get_testAtomicSimpleTypeElement2->get_value(), 23;
isa_ok($ct_east->get_testAtomicSimpleTypeElement2,
'MyTypes::testComplexTypeElementAtomicSimpleType::_testAtomicSimpleTypeElement2');
ok eval { require MyElements::testElementCompletelyEmptyComplex; }
, 'load MyElements::testElementCompletelyEmptyComplex';
ok my $empty = MyElements::testElementCompletelyEmptyComplex->new();
is $empty->serialize_qualified(), '<testElementCompletelyEmptyComplex xmlns="urn:Test"/>'
, 'serialize empty';
rmtree "$path/testlib";

32
t/SOAP/WSDL/PortType.t Normal file
View File

@@ -0,0 +1,32 @@
use strict;
use warnings;
use Test::More tests => 4;
use SOAP::WSDL::Operation;
use_ok qw(SOAP::WSDL::PortType);
my $portType = SOAP::WSDL::PortType->new({
operation => [
SOAP::WSDL::Operation->new({
name => 'foo',
targetNamespace => 'bar',
}),
SOAP::WSDL::Operation->new({
name => 'foo',
targetNamespace => 'baz',
}),
SOAP::WSDL::Operation->new({
name => 'foobar',
targetNamespace => 'bar',
}),
]
});
my $operation = $portType->find_operation('bar', 'foobar');
is $operation->get_name(), 'foobar', 'found operation';
$operation = $portType->find_operation('baz', 'foo');
is $operation->get_name(), 'foo', 'found operation';
$operation = $portType->find_operation('baz', 'foobar');
is $operation, undef, 'find_operation returns undef on unknown operation';

View File

@@ -55,8 +55,13 @@ eval { $server->handle($request) };
like $@, qr{\A Not \s implemented:}x, 'Not implemented fault caught';
$server->set_action_map_ref({ Test => 'test'});
ok $server->handle($request);
$server->set_deserializer('MyDeserializer2');
eval { $server->handle(HTTP::Request->new()) };
like $@, qr{\A Error \s deserializing}x, 'Error deserializing caught';
sub test {
return;
}

View File

@@ -11,7 +11,7 @@ use Test::More;
eval "require IO::Scalar"
or plan skip_all => 'IO::Scalar required for testing...';
plan tests => 8;
plan tests => 12;
use_ok(SOAP::WSDL::Server);
use_ok(SOAP::WSDL::Server::CGI);
@@ -30,51 +30,113 @@ $server->set_action_map_ref({
my $output = q{};
my $fh = IO::Scalar->new(\$output);
my $stdout = *STDOUT;
my $stdin = *STDIN;
*STDOUT = $fh;
{
local %ENV;
$server->handle();
$server->handle();
like $output, qr{ \A Status: \s 411 \s Length \s Required}x;
$output = q{};
like $output, qr{ \A Status: \s 411 \s Length \s Required}x;
$output = q{};
$ENV{'CONTENT_LENGTH'} = '0e0';
$server->handle();
$ENV{'CONTENT_LENGTH'} = '0e0';
$server->handle();
like $output, qr{ Error \s deserializing }xsm;
$output = q{};
like $output, qr{ Error \s deserializing }xsm;
$output = q{};
$server->set_action_map_ref({
$server->set_action_map_ref({
'foo' => 'bar',
});
$server->set_dispatch_to( 'HandlerClass' );
});
$server->set_dispatch_to( 'HandlerClass' );
$server->handle();
like $output, qr{no \s element \s found}xms;
$output = q{};
$server->handle();
like $output, qr{no \s element \s found}xms;
$output = q{};
$ENV{REQUEST_METHOD} = 'POST';
$ENV{HTTP_SOAPACTION} = 'test';
$server->handle();
like $output, qr{no \s element \s found}xms;
$output = q{};
$ENV{REQUEST_METHOD} = 'POST';
$ENV{HTTP_SOAPACTION} = 'test';
$server->handle();
like $output, qr{no \s element \s found}xms;
$output = q{};
delete $ENV{HTTP_SOAPACTION};
delete $ENV{HTTP_SOAPACTION};
$ENV{EXPECT} = 'Foo';
$ENV{HTTP_SOAPAction} = 'foo';
$server->handle();
$ENV{EXPECT} = 'Foo';
$ENV{HTTP_SOAPAction} = 'foo';
$server->handle();
like $output, qr{no \s element \s found}xms;
$output = q{};
like $output, qr{no \s element \s found}xms;
$output = q{};
$ENV{EXPECT} = '100-Continue';
$ENV{HTTP_SOAPAction} = 'foo';
$server->handle();
like $output, qr{100 \s Continue}xms;
$output = q{};
$ENV{EXPECT} = '100-Continue';
$ENV{HTTP_SOAPAction} = 'foo';
$server->handle();
like $output, qr{100 \s Continue}xms;
$output = q{};
delete $ENV{EXPECT};
my $input = 'Foobar';
my $ih = IO::Scalar->new(\$input);
$ih->seek(0);
*STDIN = $ih;
# my $buffer;
# read(*STDIN, $buffer, 6);
# die $buffer;
$ENV{HTTP_SOAPAction} = 'bar';
$ENV{CONTENT_LENGTH} = 6;
$server->handle();
like $output, qr{ Error \s deserializing \s message}xms;
$output = q{};
$ih->seek(0);
$input = q{<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
<SOAP-ENV:Body></SOAP-ENV:Body></SOAP-ENV:Envelope>};
$ENV{HTTP_SOAPAction} = 'bar';
$ENV{CONTENT_LENGTH} = length $input;
$server->handle();
# die $output;
like $output, qr{ Not \s found:}xms;
$output = q{};
$ih->seek(0);
$server->set_dispatch_to( 'HandlerClass' );
$server->set_action_map_ref({
'bar' => 'bar',
});
$input = q{<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
<SOAP-ENV:Body></SOAP-ENV:Body></SOAP-ENV:Envelope>};
$ENV{HTTP_SOAPAction} = q{"bar"};
$ENV{CONTENT_LENGTH} = length $input;
$server->handle();
use Data::Dumper;
like $output, qr{ \A Status: \s 200 \s OK}xms;
$output = q{};
$ih->seek(0);
$server->set_dispatch_to( 'HandlerClass' );
$server->set_action_map_ref({
'bar' => 'bar',
});
$input = q{<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
<SOAP-ENV:Body></SOAP-ENV:Body></SOAP-ENV:Envelope>};
$ENV{SERVER_SOFTWARE} ='IIS Foobar';
$ENV{HTTP_SOAPAction} = q{"bar"};
$ENV{CONTENT_LENGTH} = length $input;
$server->handle();
use Data::Dumper;
like $output, qr{ \A HTTP/1.0 \s 200 \s OK}xms;
$output = q{};
$ih->seek(0);
}
# restore handles
*STDOUT = $stdout;
*STDIN = $stdin;
# print $output;

View File

@@ -0,0 +1,40 @@
use strict;
use warnings;
use Test::More tests => 2; #qw(no_plan);
use_ok qw(SOAP::WSDL::XSD::Attribute);
use SOAP::WSDL::Expat::WSDLParser;
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
my $xml = q{<s:schema elementFormDefault="qualified"
targetNamespace="urn:HelloWorld" xmlns:s="http://www.w3.org/2001/XMLSchema">
<s:element name="sayHello">
<s:complexType>
<s:sequence>
<s:element minOccurs="0" maxOccurs="1" name="name"
type="s:string" />
<s:element minOccurs="0" maxOccurs="1" name="givenName"
type="s:string" nillable="1" />
</s:sequence>
<s:attribute name="testAttr" type="s:string" use="optional"></s:attribute>
</s:complexType>
</s:element>
<s:element name="sayHelloResponse">
<s:complexType>
<s:sequence>
<s:element minOccurs="0" maxOccurs="1"
name="sayHelloResult" type="s:string" />
</s:sequence>
</s:complexType>
</s:element>
</s:schema>
};
my $schema = $parser->parse($xml);
is $schema->find_element('urn:HelloWorld', 'sayHello')
->first_complexType()
->first_attribute()->get_name(),
'testAttr', 'found attribute';

View File

@@ -1,11 +1,11 @@
package Foo;
sub serialize {
return "serialized $_[1] $_[2]";
return "serialized $_[1] $_[2]" . join ' ', @{$_[3]->{ attributes } || [] } if $_[3];
}
package main;
use strict;
use warnings;
use Test::More tests => 12;
use Test::More tests => 16;
use_ok qw(SOAP::WSDL::XSD::Element);
@@ -16,6 +16,9 @@ is $element->first_simpleType(), undef;
$element->set_simpleType('Foo');
is $element->first_simpleType(), 'Foo';
is $element->serialize('Foobar', 'Bar', { namespace => {} } ), 'serialized Foobar Bar';
is $element->serialize('Foobar', undef, { namespace => {} } ), 'serialized Foobar ';
$element->set_simpleType( [ 'Foo', 'Bar' ]);
is $element->first_simpleType(), 'Foo';
@@ -30,6 +33,13 @@ is $element->first_complexType(), 'Foo';
$element->set_default('Foo');
is $element->serialize('Foobar', undef, { namespace => {} } ), 'serialized Foobar Foo';
$element->set_targetNamespace('urn:foobar');
is $element->serialize('Foobar', undef, { namespace => {}, qualify => 1 } ), 'serialized Foobar Foo xmlns="urn:foobar"';
$element->set_targetNamespace('urn:foobar');
is $element->serialize('Foobar', 'Bar', { namespace => {}, qualify => 1 } ), 'serialized Foobar Bar xmlns="urn:foobar"';
$element->set_name('Bar');
is $element->serialize(undef, undef, { namespace => {} } ), 'serialized Bar Foo';

32
t/SOAP/WSDL/XSD/Schema.t Normal file
View File

@@ -0,0 +1,32 @@
use strict;
use warnings;
use Test::More tests => 4;
use SOAP::WSDL::XSD::Element;
use_ok qw(SOAP::WSDL::XSD::Schema);
my $obj = SOAP::WSDL::XSD::Schema->new({
element => [
SOAP::WSDL::XSD::Element->new({
name => 'foo',
targetNamespace => 'bar',
}),
SOAP::WSDL::XSD::Element->new({
name => 'foo',
targetNamespace => 'baz',
}),
SOAP::WSDL::XSD::Element->new({
name => 'foobar',
targetNamespace => 'bar',
}),
]
});
my $found= $obj->find_element('bar', 'foobar');
is $found->get_name(), 'foobar', 'found Element';
$found = $obj->find_element('baz', 'foo');
is $found->get_name(), 'foo', 'found Element';
$found = $obj->find_element('baz', 'foobar');
is $found, undef, 'find_Element returns undef on unknown Element';

View File

@@ -68,21 +68,18 @@ __PACKAGE__->_factory(
);
package main;
use Test::More tests => 106;
use Test::More tests => 109;
use Storable;
my $have_warn = eval { require Test::Warn; import Test::Warn; 1; };
my $obj;
$obj = MyEmptyType->new();
is $obj->serialize, '';
is $obj->serialize({ name => 'test'}), '<test/>';
$obj = MyEmptyType2->new();
is $obj->serialize, '';
is $obj->serialize({ name => 'test'}), '<test/>';
for my $class (qw{MyEmptyType MyEmptyType2}) {
$obj = $class->new();
is $obj->serialize, '', "$class object serializes to q{}";
is $obj->serialize({ name => 'test'}), '<test/>', "$class object serializes to <test/> with name=test";
}
$obj = MyType->new({});
isa_ok $obj, 'MyType';
@@ -106,6 +103,7 @@ $obj = MyType->new({
value => 'Test2'
})
});
isa_ok $obj, 'MyType';
isa_ok $obj->get_test, 'SOAP::WSDL::XSD::Typelib::Builtin::string';
is $obj->get_test, 'Test2', 'element content';
@@ -131,6 +129,7 @@ $obj = MyType->new({
})
],
});
isa_ok $obj, 'MyType';
isa_ok $obj->get_test, 'ARRAY';
is $obj->get_test()->[0], 'Test', 'element content (list content [0])';
@@ -165,13 +164,10 @@ $nested = MyType2->new({
},
});
$hash_of_ref = $nested->as_hash_ref();
is $hash_of_ref->{ test }->{ test }->[1], 'Test2';
# isnt $nested->get_test->[0], $obj, 'element identity';
$obj = MyType->new();
isa_ok $obj, 'MyType';
is $obj->get_test, undef, 'undefined element content';
@@ -197,6 +193,11 @@ for my $count (1..5) {
$obj->set_test();
is $obj->get_test, (), 'removed element content';
$obj = MyEmptyType->new();
eval {
isa_ok $obj->attr() , 'SOAP::WSDL::XSD::Typelib::AttributeSet';
};
like $@, qr{\s has \s no \s attributes}x;
$obj = MyElement->new();
isa_ok $obj->attr() , 'SOAP::WSDL::XSD::Typelib::AttributeSet';
@@ -263,6 +264,11 @@ for my $count (1..5) {
}
my $clone = Storable::thaw( Storable::freeze( $obj ));
is $clone->get_test()->[0], 'TestString0';
## failure tests
eval {
$obj = MyType->new({
test => [
@@ -283,6 +289,14 @@ eval {
};
like $@, qr{cannot \s use \s CODE}xms;
# TODO ignore XMLNS (for now)
$obj = MyType->new({ xmlns => 'fubar'});
ok defined $obj;
TODO: {
local $TODO = "Support XML namespaces";
is $obj->get_xmlns(), 'fubar';
}
eval {
$obj = MyType->new({
foobar => 'fubar'
@@ -300,16 +314,13 @@ like $@, qr{Can't \s locate \s object \s method}x;
eval { MyType->new({ FOO => 42 }) };
like $@, qr{unknown \s field \s}xm;
my $clone = Storable::thaw( Storable::freeze( $obj ));
is $clone->get_test()->[0], 'TestString0';
eval { SOAP::WSDL::XSD::Typelib::ComplexType::AUTOMETHOD() };
like $@, qr{Cannot \s call}xm;
eval { SOAP::WSDL::XSD::Typelib::ComplexType->_factory([], { test => {} }, {}) };
like $@, qr{ No \s class \s given \s for \s }xms;
eval { SOAP::WSDL::XSD::Typelib::ComplexType->_factory([], { test => {} }, { test => 'HopeItDoesntExistOnYourSystem'}) };
like $@, qr{ Can't \s locate \s HopeItDoesntExistOnYourSystem.pm }xms;
# print Dumper

View File

@@ -0,0 +1,20 @@
<?xml version="1.0" encoding="UTF-8"?>
<definitions xmlns:http="http://schemas.xmlsoap.org/wsdl/http/"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:s="http://www.w3.org/2001/XMLSchema" xmlns:s0="urn:HelloWorld"
xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:tm="http://microsoft.com/wsdl/mime/textMatching/"
xmlns:mime="http://schemas.xmlsoap.org/wsdl/mime/"
targetNamespace="urn:HelloWorld"
xmlns="http://schemas.xmlsoap.org/wsdl/">
<import namespace="urn:HelloWorld" location="WSDLParser-imported.wsdl"/>
<service name="Service1">
<port name="Service1Soap" binding="s0:Service1Soap">
<soap:address
location="http://localhost:81/soap-wsdl-test/helloworld.pl" />
</port>
</service>
</definitions>

View File

@@ -0,0 +1,52 @@
<?xml version="1.0" encoding="UTF-8"?>
<definitions xmlns:http="http://schemas.xmlsoap.org/wsdl/http/"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:s="http://www.w3.org/2001/XMLSchema" xmlns:s0="urn:HelloWorld"
xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:tm="http://microsoft.com/wsdl/mime/textMatching/"
xmlns:mime="http://schemas.xmlsoap.org/wsdl/mime/"
targetNamespace="urn:HelloWorld"
xmlns="http://schemas.xmlsoap.org/wsdl/">
<types>
<s:schema>
<s:import namespace="urn:HelloWorld" schemaLocation="import.xsd"/>
</s:schema>
</types>
<message name="sayHelloSoapIn">
<part name="parameters" element="s0:sayHello" />
</message>
<message name="sayHelloSoapOut">
<part name="parameters" element="s0:sayHelloResponse" />
</message>
<portType name="Service1Soap">
<operation name="sayHello">
<input message="s0:sayHelloSoapIn" />
<output message="s0:sayHelloSoapOut" />
</operation>
</portType>
<binding name="Service1Soap" type="s0:Service1Soap">
<soap:binding transport="http://schemas.xmlsoap.org/soap/http"
style="document" />
<operation name="sayHello">
<soap:operation soapAction="urn:HelloWorld#sayHello"
style="document" />
<input>
<soap:body use="literal" />
</input>
<output>
<soap:body use="literal" />
</output>
</operation>
</binding>
</definitions>

View File

@@ -201,6 +201,15 @@ xmlns:mime="http://schemas.xmlsoap.org/wsdl/mime/" xmlns:http="http://schemas.xm
<xsd:complexType name="emptyComplexType">
<xsd:sequence></xsd:sequence>
</xsd:complexType>
<xsd:element name="testElementCompletelyEmptyComplex">
<xsd:complexType>
</xsd:complexType>
</xsd:element>
<xsd:complexType name="completelyEmptyComplexType">
</xsd:complexType>
</xsd:schema>
</types>
<message name="testChoice">

View File

@@ -0,0 +1,23 @@
<s:schema elementFormDefault="qualified" targetNamespace="urn:HelloWorld"
xmlns:s="http://www.w3.org/2001/XMLSchema">
<s:element name="sayHello">
<s:complexType>
<s:sequence>
<s:element minOccurs="0" maxOccurs="1" name="name"
type="s:string" />
<s:element minOccurs="0" maxOccurs="1" name="givenName"
type="s:string" nillable="1" />
</s:sequence>
<s:attribute name="testAttr" type="s:string" use="optional"></s:attribute>
</s:complexType>
</s:element>
<s:element name="sayHelloResponse">
<s:complexType>
<s:sequence>
<s:element minOccurs="0" maxOccurs="1" name="sayHelloResult"
type="s:string" />
</s:sequence>
</s:complexType>
</s:element>
</s:schema>