Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
 Martin Kutter
|
f63138fc87 |
No files matched your search
@@ -4,7 +4,7 @@ Module::Build->new(
|
||||
create_makefile_pl => 'passthrough',
|
||||
dist_abstract => 'SOAP with WSDL support',
|
||||
dist_name => 'SOAP-WSDL',
|
||||
dist_version => '2.00_12',
|
||||
dist_version => '2.00_13',
|
||||
module_name => 'SOAP::WSDL',
|
||||
license => 'artistic',
|
||||
requires => {
|
||||
@@ -35,6 +35,7 @@ Module::Build->new(
|
||||
'Getopt::Long' => 0,
|
||||
'Cwd' => 0,
|
||||
'File::Find' => 0,
|
||||
'Storable' => 0,
|
||||
},
|
||||
recursive_test_files => 1,
|
||||
)->create_build_script;
|
||||
@@ -26,6 +26,45 @@ Features:
|
||||
|
||||
|
||||
The following changes have been made:
|
||||
2.00_13
|
||||
----
|
||||
The following features were added (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
|
||||
* [ 1790619 ] Test transport backend
|
||||
A test transport backend has been implemented (SOAP::WSDL::Transport::Test).
|
||||
It returns the contents from a file and discards the response.
|
||||
The filename is determined from the soap_action field.
|
||||
|
||||
* [ 1785196 ] Replace outputsom(1) by deserializer plugin
|
||||
outputsom(1) in SOAP::WSDL is now implemented via using the deserializer
|
||||
plugin SOAP::WSDL::Deserializer::SOM.
|
||||
|
||||
* [1785195] Support deserializer plugins
|
||||
Deserializer plugin API added via SOAP::WSDL::Factory::Deserializer.
|
||||
|
||||
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):
|
||||
|
||||
* [1789581] Support ComplexType mixed
|
||||
WSDL parser now supports using the mixed="true" attribute in complexType
|
||||
definitions. Mixed content in messages is only supported via SOAP::SOM yet.
|
||||
|
||||
* [1787975] 016_client_object.t fails due to testing XML as string
|
||||
Removed string test.
|
||||
|
||||
* [1787959] Test wsdl seems to be broken
|
||||
Corrected typo.
|
||||
|
||||
* [1787955] ::XSD::Typelib::date is broken
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::date now converts time-zoned dates properly,
|
||||
and adds the local time zone if none is given.
|
||||
|
||||
* [1785646] SOAPAction header not set from soap:operation soapAction
|
||||
SOAP::WSDL now sets the SOAPAction header correctly.
|
||||
|
||||
The following uncategorized improvements have been mad:
|
||||
|
||||
* Documentation improvements
|
||||
|
||||
2.00_12
|
||||
----
|
||||
@@ -40,6 +79,16 @@ tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
|
||||
* [1787054] Test suite requires XML::LibXML in 2.00_11
|
||||
The test suite no longer requires XML::LibXML to pass.
|
||||
|
||||
* [1785678] SOAP envelope not checked for namespace
|
||||
The SOAP envelope is now checked for the correct namespace.
|
||||
|
||||
* [1786644] SOAP::WSDL::Manual - doc error
|
||||
Documentation improvements
|
||||
|
||||
The following uncategorized improvements have been made
|
||||
|
||||
* The SOAPAction header is now alway quoted (R1109 in WS-I BP 1.0).
|
||||
|
||||
2.00_11
|
||||
----
|
||||
|
||||
@@ -75,7 +124,8 @@ The following uncategorized improvements have been made
|
||||
- XML::LibXML
|
||||
|
||||
* The missing prerequisite Template has been added.
|
||||
* Documentation has been improved.
|
||||
* Documentation has been improved:
|
||||
- WS-I Compliance document added.
|
||||
|
||||
|
||||
2.00_10
|
||||
|
||||
@@ -1,4 +1,7 @@
|
||||
benchmark/01_expat.t
|
||||
benchmark/XSD/01_anyType.t
|
||||
benchmark/XSD/02_anySimpleType.t
|
||||
benchmark/XSD/03_string.t
|
||||
bin/wsdl2perl.pl
|
||||
Build.PL
|
||||
CHANGES
|
||||
@@ -33,11 +36,14 @@ lib/SOAP/WSDL/Binding.pm
|
||||
lib/SOAP/WSDL/Client.pm
|
||||
lib/SOAP/WSDL/Client/Base.pm
|
||||
lib/SOAP/WSDL/Definitions.pm
|
||||
lib/SOAP/WSDL/Deserializer/SOAP11.pm
|
||||
lib/SOAP/WSDL/Deserializer/SOM.pm
|
||||
lib/SOAP/WSDL/Expat/MessageParser.pm
|
||||
lib/SOAP/WSDL/Expat/MessageStreamParser.pm
|
||||
lib/SOAP/WSDL/Expat/MessageSubParser.pm
|
||||
lib/SOAP/WSDL/Expat/SubParser.pm
|
||||
lib/SOAP/WSDL/Expat/WSDLParser.pm
|
||||
lib/SOAP/WSDL/Factory/Deserializer.pm
|
||||
lib/SOAP/WSDL/Factory/Serializer.pm
|
||||
lib/SOAP/WSDL/Factory/Transport.pm
|
||||
lib/SOAP/WSDL/Manual.pod
|
||||
@@ -203,4 +209,6 @@ t/SOAP/WSDL/12_binding.pl
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/001_string.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/002_dateTime.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/003_date.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/004_time.t
|
||||
t/test.pl
|
||||
TODO
|
||||
@@ -1,6 +1,6 @@
|
||||
---
|
||||
name: SOAP-WSDL
|
||||
version: 2.00_12
|
||||
version: 2.00_13
|
||||
author:
|
||||
abstract: SOAP with WSDL support
|
||||
license: artistic
|
||||
@@ -23,24 +23,32 @@ meta-spec:
|
||||
provides:
|
||||
SOAP::WSDL:
|
||||
file: lib/SOAP/WSDL.pm
|
||||
version: 2.00_12
|
||||
version: 2.00_13
|
||||
SOAP::WSDL::Base:
|
||||
file: lib/SOAP/WSDL/Base.pm
|
||||
SOAP::WSDL::Binding:
|
||||
file: lib/SOAP/WSDL/Binding.pm
|
||||
SOAP::WSDL::Client:
|
||||
file: lib/SOAP/WSDL/Client.pm
|
||||
version: 2.00_12
|
||||
version: 2.00_13
|
||||
SOAP::WSDL::Client::Base:
|
||||
file: lib/SOAP/WSDL/Client/Base.pm
|
||||
SOAP::WSDL::Definitions:
|
||||
file: lib/SOAP/WSDL/Definitions.pm
|
||||
SOAP::WSDL::Deserializer::SOAP11:
|
||||
file: lib/SOAP/WSDL/Deserializer/SOAP11.pm
|
||||
version: 2.00_13
|
||||
SOAP::WSDL::Deserializer::SOM:
|
||||
file: lib/SOAP/WSDL/Deserializer/SOM.pm
|
||||
version: 2.00_13
|
||||
SOAP::WSDL::Expat::MessageParser:
|
||||
file: lib/SOAP/WSDL/Expat/MessageParser.pm
|
||||
SOAP::WSDL::Expat::MessageStreamParser:
|
||||
file: lib/SOAP/WSDL/Expat/MessageStreamParser.pm
|
||||
SOAP::WSDL::Expat::MessageSubParser:
|
||||
file: lib/SOAP/WSDL/Expat/MessageSubParser.pm
|
||||
SOAP::WSDL::Factory::Deserializer:
|
||||
file: lib/SOAP/WSDL/Factory/Deserializer.pm
|
||||
SOAP::WSDL::Factory::Serializer:
|
||||
file: lib/SOAP/WSDL/Factory/Serializer.pm
|
||||
SOAP::WSDL::Factory::Transport:
|
||||
@@ -63,6 +71,7 @@ provides:
|
||||
file: lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
|
||||
SOAP::WSDL::Serializer::SOAP11:
|
||||
file: lib/SOAP/WSDL/Serializer/SOAP11.pm
|
||||
version: 2.00_13
|
||||
SOAP::WSDL::Service:
|
||||
file: lib/SOAP/WSDL/Service.pm
|
||||
SOAP::WSDL::SoapOperation:
|
||||
|
||||
@@ -6,9 +6,6 @@ TODO list for SOAP::WSDL
|
||||
|
||||
* Implement a interface similar to SOAP::Schema (#1783639)
|
||||
|
||||
* (#1785195) Support deserializer plugins
|
||||
* Support XML::Compiled as one serializer/deserializer
|
||||
|
||||
* Check & probably fix simpleType support.
|
||||
The WS at http://www.webservicex.net/genericbarcode.asmx?wsdl should
|
||||
make up a good example for simpleType definitions.
|
||||
@@ -29,7 +26,11 @@ Maybe even allow unlimited depth? What does the specs say?
|
||||
--------
|
||||
|
||||
|
||||
Past 2.1 release
|
||||
2.2 release
|
||||
--------
|
||||
* XML schema support ("minimal conformant") (#1764845)
|
||||
* Support SOAP attachments
|
||||
|
||||
3.0 release
|
||||
--------
|
||||
We're not thinking that far ahead right now.
|
||||
@@ -0,0 +1,21 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Benchmark;
|
||||
use lib '../../lib';
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::anyType;
|
||||
|
||||
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::anyType->new();
|
||||
|
||||
timethese 10000, {
|
||||
'new' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anyType->new() },
|
||||
'new with params' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anyType->new({
|
||||
xmlns => 'urn:Test'
|
||||
}) },
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
};
|
||||
|
||||
my $data;
|
||||
timethese 1000000, {
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
'get_FOO' => sub { $data = $obj->get_xmlns() },
|
||||
};
|
||||
@@ -0,0 +1,22 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Benchmark;
|
||||
use lib '../../lib';
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
|
||||
|
||||
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new();
|
||||
|
||||
timethese 10000, {
|
||||
'new' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new() },
|
||||
'new + params' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({
|
||||
xmlns => 'urn:Test',
|
||||
value => 'Teststring'
|
||||
}) },
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
};
|
||||
|
||||
my $data;
|
||||
timethese 1000000, {
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
'get_FOO' => sub { $data = $obj->get_xmlns() },
|
||||
};
|
||||
@@ -0,0 +1,22 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Benchmark;
|
||||
use lib '../../lib';
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::string;
|
||||
|
||||
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::string->new();
|
||||
|
||||
timethese 10000, {
|
||||
'new' => sub { SOAP::WSDL::XSD::Typelib::Builtin::string->new() },
|
||||
'new + params' => sub { SOAP::WSDL::XSD::Typelib::Builtin::string->new({
|
||||
xmlns => 'urn:Test',
|
||||
value => 'Teststring'
|
||||
}) },
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
};
|
||||
|
||||
my $data;
|
||||
timethese 1000000, {
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
'get_FOO' => sub { $data = $obj->get_xmlns() },
|
||||
};
|
||||
+13
-9
@@ -11,29 +11,33 @@
|
||||
|
||||
use lib 'lib/';
|
||||
use lib '../lib';
|
||||
use SOAP::WSDL;
|
||||
use File::Basename qw(dirname);
|
||||
use File::Spec;
|
||||
my $path = File::Spec->rel2abs( dirname __FILE__);
|
||||
|
||||
# SOAP::WSDL variant
|
||||
use SOAP::WSDL;
|
||||
my $soap = SOAP::WSDL->new();
|
||||
my $som = $soap->wsdl("file:///$path/wsdl/globalweather.xml")
|
||||
->call('GetWeather', GetWeather => { CountryName => 'Germany', CityName => 'Munich' });
|
||||
|
||||
die $som->message() if $som->fault();
|
||||
->call('GetWeather', GetWeather =>
|
||||
{ CountryName => 'Germany', CityName => 'Munich' }
|
||||
);
|
||||
|
||||
die "Error" if $som->fault();
|
||||
print $som->result();
|
||||
|
||||
|
||||
# SOAP::Lite variant:
|
||||
# Note that you have to look both the proxy and the xmlns attribute
|
||||
# set on the GetWeather SOAP::Data object from the WSDL.
|
||||
|
||||
use SOAP::Lite;
|
||||
use SOAP::Lite; # +trace;
|
||||
my $soap = SOAP::Lite->new()->on_action( sub { join'/', @_ } )
|
||||
->proxy("http://www.webservicex.net/globalweather.asmx");
|
||||
->proxy("http://www.webservicex.net/globalweather.asmx"); # from WSDL
|
||||
my $som = $soap->call(
|
||||
SOAP::Data->name('GetWeather')->attr({ xmlns => 'http://www.webserviceX.NET' }),
|
||||
SOAP::Data->name('GetWeather')
|
||||
->attr({ xmlns => 'http://www.webserviceX.NET' }), # from WSDL
|
||||
SOAP::Data->name('CountryName')->value('Germany'),
|
||||
SOAP::Data->name('CityName')->value('Munich')
|
||||
);
|
||||
|
||||
die "Error" if $som->fault();
|
||||
print $som->result();
|
||||
+64
-22
@@ -7,16 +7,17 @@ use Scalar::Util qw(blessed);
|
||||
use SOAP::WSDL::Client;
|
||||
use SOAP::WSDL::Expat::WSDLParser;
|
||||
use Class::Std;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
|
||||
use LWP::UserAgent;
|
||||
|
||||
our $VERSION='2.00_12';
|
||||
our $VERSION='2.00_13';
|
||||
|
||||
my %no_dispatch_of :ATTR(:name<no_dispatch>);
|
||||
my %wsdl_of :ATTR(:name<wsdl>);
|
||||
my %proxy_of :ATTR(:name<proxy>);
|
||||
my %readable_of :ATTR(:name<readable>);
|
||||
my %autotype_of :ATTR(:name<autotype>);
|
||||
my %outputxml_of :ATTR(:name<outputxml>);
|
||||
my %outputxml_of :ATTR(:name<outputxml> :default<0>);
|
||||
my %outputtree_of :ATTR(:name<outputtree>);
|
||||
my %outputhash_of :ATTR(:name<outputhash>);
|
||||
my %servicename_of :ATTR(:name<servicename>);
|
||||
@@ -218,10 +219,14 @@ sub _wsdl_init_methods :PRIVATE {
|
||||
}
|
||||
|
||||
sub call {
|
||||
my $self = shift;
|
||||
my ($self, $method, @data_from) = @_;
|
||||
my $ident = ident $self;
|
||||
my $method = shift;
|
||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
||||
|
||||
my ($data, $header) = ref $data_from[0]
|
||||
? ($data_from[0], $data_from[1] )
|
||||
: (@data_from>1)
|
||||
? ( { @data_from }, undef )
|
||||
: ( $data_from[0], undef );
|
||||
|
||||
$self->wsdlinit() if not ($definitions_of{ $ident });
|
||||
$self->_wsdl_init_methods() if not ($method_info_of{ $ident });
|
||||
@@ -229,34 +234,54 @@ sub call {
|
||||
my $client = $client_of{ $ident };
|
||||
$client->set_proxy( $proxy_of{ $ident } || $port_of{ $ident }->get_location() );
|
||||
$client->set_no_dispatch( $no_dispatch_of{ $ident } );
|
||||
$client->set_outputxml( $outputtree_of{ $ident } ? 0 : 1 );
|
||||
|
||||
$client->set_outputxml( $outputxml_of{ $ident } ? 1 : 0 );
|
||||
|
||||
# maybe we should introduce something like $output{ $ident } with a fixed
|
||||
# set of values - m{^(TREE|HASH|XML|SOM)$}xms ?
|
||||
if ( ( ! $outputtree_of{ $ident } )
|
||||
&& ( ! $outputhash_of{ $ident } )
|
||||
&& ( ! $outputxml_of{ $ident } ) ) {
|
||||
require SOAP::WSDL::Deserializer::SOM;
|
||||
$client->set_deserializer( SOAP::WSDL::Deserializer::SOM->new() );
|
||||
};
|
||||
|
||||
my $method_info = $method_info_of{ $ident }->{ $method };
|
||||
|
||||
# TODO serialize both header and body, not only header
|
||||
my $response = (blessed $data)
|
||||
? $client->call( $method, $data )
|
||||
? $client->call( {
|
||||
operation => $method,
|
||||
soap_action => $method_info->{ soap_action },
|
||||
}, $data )
|
||||
: do {
|
||||
my $content = '';
|
||||
# TODO support RPC-encoding: Top-Level element + namespace...
|
||||
foreach my $part ( @{ $method_info_of{ $ident }->{ $method }->{ parts } } ) {
|
||||
$client->set_on_action( sub { $part->get_targetNamespace() . '/' . $_[1] } );
|
||||
foreach my $part ( @{ $method_info->{ parts } } ) {
|
||||
$content .= $part->serialize( $method, $data,
|
||||
{
|
||||
%{ $serialize_options_of{ $ident } },
|
||||
readable => $readable_of{ $ident },
|
||||
} );
|
||||
}
|
||||
$client->call($method, $content);
|
||||
$client->call(
|
||||
{
|
||||
operation => $method,
|
||||
soap_action => $method_info->{ soap_action }
|
||||
},
|
||||
# absolutely stupid, but we need a reference which
|
||||
# serializes to XML on stringification...
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({
|
||||
value => $content
|
||||
}),
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({
|
||||
value => $header
|
||||
})
|
||||
);
|
||||
};
|
||||
|
||||
return $response if (
|
||||
$outputxml_of{ $ident }
|
||||
# || $outputhash_of{ $ident }
|
||||
|| $outputtree_of{ $ident }
|
||||
|| $no_dispatch_of{ $ident } );
|
||||
|
||||
return unless $response; # nothing to do for one-ways
|
||||
# now convert into SOAP::SOM - bah !
|
||||
require SOAP::Lite;
|
||||
return SOAP::Deserializer->new()->deserialize( $response );
|
||||
return unless defined $response; # nothing to do for one-ways
|
||||
return $response;
|
||||
}
|
||||
|
||||
sub explain {
|
||||
@@ -314,8 +339,25 @@ Performs a SOAP call. The result is either an object tree (with outputtree),
|
||||
a hash reference (with outputhash), plain XML (with outputxml) or a SOAP::SOM
|
||||
object (with neither of the above set).
|
||||
|
||||
call() can be called in different ways:
|
||||
|
||||
=over
|
||||
|
||||
=item * Old-style idiom
|
||||
|
||||
my $result = $soap->call('method', %data);
|
||||
|
||||
Does not support SOAP header data.
|
||||
|
||||
=item * New-style idiom
|
||||
|
||||
my $result = $soap->call('method', $body_ref, $header_ref );
|
||||
|
||||
Does support SOAP header data. $body_ref and $header ref may either be
|
||||
hash refs or SOAP::WSDL::XSD::Typelib::* derived objects.
|
||||
|
||||
=back
|
||||
|
||||
=head2 wsdlinit
|
||||
|
||||
Reads the WSDL file and initializes SOAP::WSDL for working with it.
|
||||
@@ -658,9 +700,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 188 $
|
||||
$Rev: 218 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: WSDL.pm 188 2007-09-03 15:15:19Z kutterma $
|
||||
$Id: WSDL.pm 218 2007-09-10 16:19:23Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL.pm $
|
||||
|
||||
=cut
|
||||
|
||||
+63
-69
@@ -8,12 +8,12 @@ use LWP::UserAgent;
|
||||
use HTTP::Request;
|
||||
use Scalar::Util qw(blessed);
|
||||
|
||||
use SOAP::WSDL::Factory::Deserializer;
|
||||
use SOAP::WSDL::Factory::Serializer;
|
||||
use SOAP::WSDL::Factory::Transport;
|
||||
use SOAP::WSDL::Expat::MessageParser;
|
||||
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
|
||||
our $VERSION='2.00_12';
|
||||
our $VERSION='2.00_13';
|
||||
|
||||
# Package global for speed and memory savings.
|
||||
# But should be factored out into serializer/deserializer...
|
||||
@@ -27,11 +27,11 @@ my %endpoint_of :ATTR(:name<endpoint> :default<()>);
|
||||
|
||||
my %soap_version_of :ATTR(:get<soap_version> :init_attr<soap_version> :default<'1.1'>);
|
||||
|
||||
my %fault_class_of :ATTR(:name<fault_class> :default<SOAP::WSDL::SOAP::Typelib::Fault11>);
|
||||
my %trace_of :ATTR(:set<trace> :init_arg<trace> :default<()> );
|
||||
my %on_action_of :ATTR(:name<on_action> :default<()>);
|
||||
my %content_type_of :ATTR(:name<content_type> :default<text/xml; charset=utf8>); #/#trick editors
|
||||
my %serializer_of :ATTR(:name<serializer> :default<()>);
|
||||
my %deserializer_of :ATTR(:name<deserializer> :default<()>);
|
||||
|
||||
# TODO remove when preparing 2.01
|
||||
sub outputtree { warn 'outputtree is deprecated and'
|
||||
@@ -89,6 +89,9 @@ sub set_soap_version {
|
||||
# re-setting the soap version invalidates the
|
||||
# serializer object
|
||||
delete $serializer_of{ $ident };
|
||||
delete $deserializer_of{ $ident };
|
||||
delete $transport_of{ $ident };
|
||||
|
||||
$soap_version_of{ $ident } = shift;
|
||||
|
||||
return $soap_version;
|
||||
@@ -110,32 +113,30 @@ SUBFACTORY: {
|
||||
}
|
||||
}
|
||||
|
||||
BEGIN {
|
||||
$PARSER = SOAP::WSDL::Expat::MessageParser->new();
|
||||
}
|
||||
|
||||
sub call {
|
||||
my $self = shift;
|
||||
my $method = shift;
|
||||
my ($self, $method, @data_from) = @_;
|
||||
my $ident = ident $self;
|
||||
my $data = ref $_[0]
|
||||
? $_[0]
|
||||
: (@_>1)
|
||||
? { @_ }
|
||||
: $_[0];
|
||||
my $header = {};
|
||||
|
||||
my ($soap_action, $operation);
|
||||
my $trace_sub = $self->get_trace();
|
||||
|
||||
if (ref $method eq 'HASH') {
|
||||
$soap_action = $method->{ soap_action };
|
||||
$operation = $method->{ operation }
|
||||
}
|
||||
else {
|
||||
$operation = $method;
|
||||
}
|
||||
# the only valid idiom for calling a method with both a header and a body
|
||||
# is
|
||||
# ->call($method, $body_ref, $header_ref);
|
||||
#
|
||||
# These other idioms all assume an empty header:
|
||||
# ->call($method, %body_of); # %body_of is a hash
|
||||
# ->call($method, $body); # $body is a scalar
|
||||
my ($data, $header) = ref $data_from[0]
|
||||
? ($data_from[0], $data_from[1] )
|
||||
: (@data_from>1)
|
||||
? ( { @data_from }, undef )
|
||||
: ( $data_from[0], undef );
|
||||
|
||||
# get operation name and soap_action
|
||||
my ($operation, $soap_action) = (ref $method eq 'HASH')
|
||||
? ( $method->{ operation }, $method->{ soap_action } )
|
||||
: (blessed $data
|
||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
||||
? ( $method , (join '/', $data->get_xmlns(), $method) )
|
||||
: ( $method, q{} );
|
||||
|
||||
$serializer_of{ $ident } ||= SOAP::WSDL::Factory::Serializer->get_serializer({
|
||||
soap_version => $self->get_soap_version(),
|
||||
@@ -149,20 +150,15 @@ sub call {
|
||||
|
||||
return $envelope if $self->no_dispatch();
|
||||
|
||||
# try to guess soap_action if not given
|
||||
if (not defined $soap_action) {
|
||||
$soap_action = (blessed $data
|
||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
||||
? $soap_action = join '/', $data->get_xmlns(), $operation
|
||||
: ($on_action_of{$ident})
|
||||
? $soap_action = $on_action_of{$ident}->( $self, $operation )
|
||||
: "";
|
||||
}
|
||||
|
||||
# always quote SOAPAction header.
|
||||
# WS-I BP 1.0 R1109
|
||||
$soap_action =~s{\A(:?"|')?}{"}xms;
|
||||
$soap_action =~s{(:?"|')?\Z}{"}xms;
|
||||
if ($soap_action) {
|
||||
$soap_action =~s{\A(:?"|')?}{"}xms;
|
||||
$soap_action =~s{(:?"|')?\Z}{"}xms;
|
||||
}
|
||||
else {
|
||||
$soap_action = q{""};
|
||||
}
|
||||
|
||||
# get response via transport layer.
|
||||
# Normally, SOAP::Lite's transport layer is used, though users
|
||||
@@ -179,47 +175,45 @@ sub call {
|
||||
# namely ExpatNB and XML::LibXML's Push parser interface...
|
||||
);
|
||||
|
||||
return $response if ($self->outputxml() );
|
||||
return $response if ($outputxml_of{ $ident } );
|
||||
|
||||
$PARSER->class_resolver( $self->get_class_resolver() );
|
||||
# get deserializer
|
||||
$deserializer_of{ $ident } ||= SOAP::WSDL::Factory::Deserializer->get_deserializer({
|
||||
soap_version => $soap_version_of{ $ident },
|
||||
});
|
||||
|
||||
# set class resolver if serializer supports it
|
||||
$deserializer_of{ $ident }->class_resolver( $class_resolver_of{ $ident } )
|
||||
if ( $deserializer_of{ $ident }->can('class_resolver') );
|
||||
|
||||
my $result;
|
||||
|
||||
# Try deserializing response - there may be some,
|
||||
# even if transport did not succeed (got a 500 response)
|
||||
if ( $response ) {
|
||||
eval { $result = $deserializer_of{ $ident }->deserialize( $response ); };
|
||||
return $result if (not $@);
|
||||
return $deserializer_of{ $ident }->generate_fault({
|
||||
code => 'soap:Server',
|
||||
role => 'urn:localhost',
|
||||
message => "Error deserializing message: $@. \n"
|
||||
. "Message was: \n$response"
|
||||
});
|
||||
};
|
||||
|
||||
# if we had no success (Transport layer error status code)
|
||||
# or if transport layer failed
|
||||
if ( ! $transport->is_success() ) {
|
||||
# Try deserializing response - there may be some
|
||||
if ( $response ) {
|
||||
eval { $PARSER->parse( $response ); };
|
||||
return $PARSER->get_data() if (not $@);
|
||||
return $fault_class_of{$ident}->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => "Error deserializing message: $@. \n"
|
||||
. "Message was: \n$response"
|
||||
});
|
||||
};
|
||||
|
||||
# generate & return fault if we cannot serialize response
|
||||
# or have none...
|
||||
return $fault_class_of{$ident}->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => 'Error sending / receiving message: '
|
||||
return $deserializer_of{ $ident }->generate_fault({
|
||||
code => 'soap:Server',
|
||||
role => 'urn:localhost',
|
||||
message => 'Error sending / receiving message: '
|
||||
. $transport->message()
|
||||
});
|
||||
}
|
||||
eval { $PARSER->parse( $response ) };
|
||||
|
||||
# return fault if we cannot deserialize response
|
||||
if ($@) {
|
||||
return $fault_class_of{$ident}->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => "Error deserializing message: $@. \n"
|
||||
. "Message was: \n$response"
|
||||
});
|
||||
}
|
||||
|
||||
return $PARSER->get_data();
|
||||
} ## end sub call
|
||||
|
||||
1;
|
||||
@@ -383,9 +377,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 188 $
|
||||
$Rev: 218 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Client.pm 188 2007-09-03 15:15:19Z kutterma $
|
||||
$Id: Client.pm 218 2007-09-10 16:19:23Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
|
||||
|
||||
=cut
|
||||
|
||||
@@ -93,9 +93,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$Rev: 214 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Base.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$Id: Base.pm 214 2007-09-10 15:54:52Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client/Base.pm $
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,49 @@
|
||||
package SOAP::WSDL::Deserializer::SOAP11;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
|
||||
our $VERSION='2.00_13';
|
||||
|
||||
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
|
||||
|
||||
sub BUILD {
|
||||
my ($self, $ident, $args_of_ref) = @_;
|
||||
|
||||
# ignore all options except 'class_resolver'
|
||||
for (keys %{ $args_of_ref }) {
|
||||
delete $args_of_ref->{ $_ } if $_ ne 'class_resolver';
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub deserialize {
|
||||
my ($self, $content) = @_;
|
||||
|
||||
my $parser = SOAP::WSDL::Expat::MessageParser->new({
|
||||
class_resolver => $class_resolver_of{ ident $self },
|
||||
});
|
||||
eval { $parser->parse_string( $content ) };
|
||||
if ($@) {
|
||||
return $self->generate_fault({
|
||||
code => 'soap:Server',
|
||||
role => 'urn:localhost',
|
||||
message => "Error deserializing message: $@. \n"
|
||||
. "Message was: \n$content"
|
||||
});
|
||||
}
|
||||
return $parser->get_data();
|
||||
}
|
||||
|
||||
sub generate_fault {
|
||||
my ($self, $args_from_ref) = @_;
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
faultcode => $args_from_ref->{ code } || 'soap:Client',
|
||||
faultactor => $args_from_ref->{ role } || 'urn:localhost',
|
||||
faultstring => $args_from_ref->{ message } || "Unknown error"
|
||||
});
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,100 @@
|
||||
package SOAP::WSDL::Deserializer::SOM;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::Lite;
|
||||
|
||||
our $VERSION='2.00_13';
|
||||
|
||||
sub BUILD {
|
||||
my ($self, $ident, $args_of_ref) = @_;
|
||||
|
||||
# ignore all options
|
||||
for (keys %{ $args_of_ref }) {
|
||||
delete $args_of_ref->{ $_ };
|
||||
}
|
||||
}
|
||||
|
||||
sub deserialize {
|
||||
my ($self, $content) = @_;
|
||||
return SOAP::Deserializer->new()->deserialize( $content );
|
||||
}
|
||||
|
||||
sub generate_fault {
|
||||
my ($self, $args_from_ref) = @_;
|
||||
# code, message, detail, actor
|
||||
die SOAP::Fault->new(
|
||||
faultcode => $args_from_ref->{ code },
|
||||
faultstring => $args_from_ref->{ message },
|
||||
faultactor => $args_from_ref->{ role },
|
||||
);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Deserializer::SOM - Deserializer SOAP messages into SOM objects
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use SOAP::WSDL;
|
||||
use SOAP::WSDL::Deserializer::SOM;
|
||||
use SOAP::WSDL::Factory::Deserializer;
|
||||
SOAP::WSDL::Factory::Deserializer->register( '1.1', __PACKAGE__ );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Deserializer for creating SOAP::Lite's SOM object as result of a SOAP call.
|
||||
|
||||
This package is mainly here for compatibility reasons: You don't have to
|
||||
change the rest of your SOAP::Lite based app when switching to SOAP::WSDL,
|
||||
but can just use SOAP::WSDL::Deserializer::SOM to get back the same objects
|
||||
as you were used to.
|
||||
|
||||
SOAP::WSDL::Deserializer will not auroregister itself - just use the lines
|
||||
from the L</SYNOPSIS> to register it as deserializer for SOAP::WSDL.
|
||||
|
||||
=head2 Differences from SOAP::Lite
|
||||
|
||||
=over
|
||||
|
||||
=item * No on_fault handler
|
||||
|
||||
You cannot specify what to do when an error occurs - SOAP::WSDL will die
|
||||
with a SOAP::Fault object on transport errors.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Differences from other SOAP::WSDL::Deserializer classes
|
||||
|
||||
=over
|
||||
|
||||
=item * generate_fault
|
||||
|
||||
SOAP::WSDL::Deserializer::SOM will die with a SOAP::Fault object on calls
|
||||
to generate_fault.
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Serializer.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
|
||||
|
||||
=cut
|
||||
@@ -218,8 +218,8 @@ This module may be used under the same terms as perl itself.
|
||||
|
||||
$ID: $
|
||||
|
||||
$LastChangedDate: 2007-09-02 21:05:18 +0200 (So, 02 Sep 2007) $
|
||||
$LastChangedRevision: 184 $
|
||||
$LastChangedDate: 2007-09-10 18:19:23 +0200 (Mo, 10 Sep 2007) $
|
||||
$LastChangedRevision: 218 $
|
||||
$LastChangedBy: kutterma $
|
||||
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $
|
||||
|
||||
@@ -67,8 +67,8 @@ This module may be used under the same terms as perl itself.
|
||||
|
||||
$ID: $
|
||||
|
||||
$LastChangedDate: 2007-08-31 17:28:29 +0200 (Fr, 31 Aug 2007) $
|
||||
$LastChangedRevision: 176 $
|
||||
$LastChangedDate: 2007-09-10 17:54:52 +0200 (Mo, 10 Sep 2007) $
|
||||
$LastChangedRevision: 214 $
|
||||
$LastChangedBy: kutterma $
|
||||
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageStreamParser.pm $
|
||||
|
||||
@@ -204,8 +204,8 @@ This module may be used under the same terms as perl itself.
|
||||
|
||||
$ID: $
|
||||
|
||||
$LastChangedDate: 2007-08-31 17:28:29 +0200 (Fr, 31 Aug 2007) $
|
||||
$LastChangedRevision: 176 $
|
||||
$LastChangedDate: 2007-09-10 17:54:52 +0200 (Mo, 10 Sep 2007) $
|
||||
$LastChangedRevision: 214 $
|
||||
$LastChangedBy: kutterma $
|
||||
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageSubParser.pm $
|
||||
|
||||
@@ -210,8 +210,8 @@ This module may be used under the same terms as perl itself.
|
||||
|
||||
$ID: $
|
||||
|
||||
$LastChangedDate: 2007-08-31 17:28:29 +0200 (Fr, 31 Aug 2007) $
|
||||
$LastChangedRevision: 176 $
|
||||
$LastChangedDate: 2007-09-10 17:54:52 +0200 (Mo, 10 Sep 2007) $
|
||||
$LastChangedRevision: 214 $
|
||||
$LastChangedBy: kutterma $
|
||||
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/SubParser.pm $
|
||||
|
||||
@@ -0,0 +1,137 @@
|
||||
package SOAP::WSDL::Factory::Deserializer;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my %DESERIALIZER = (
|
||||
'1.1' => 'SOAP::WSDL::Deserializer::SOAP11',
|
||||
);
|
||||
|
||||
# class method
|
||||
sub register {
|
||||
my ($class, $ref_type, $package) = @_;
|
||||
$DESERIALIZER{ $ref_type } = $package;
|
||||
}
|
||||
|
||||
sub get_deserializer {
|
||||
my ($self, $args_of_ref) = @_;
|
||||
eval "require $DESERIALIZER{ $args_of_ref->{ soap_version } }" or die $@;
|
||||
return $DESERIALIZER{ $args_of_ref->{ soap_version } }->new($args_of_ref);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Factory::Deserializer - factory for retrieving Deserializer objects
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# from SOAP::WSDL::Client:
|
||||
$deserializer = SOAP::WSDL::Factory::Serializer->get_deserializer({
|
||||
soap_version => $soap_version,
|
||||
class_resolver => $class_resolver,
|
||||
});
|
||||
|
||||
# in serializer class:
|
||||
package MyWickedSerializer;
|
||||
use SOAP::WSDL::Factory::Deserializer;
|
||||
|
||||
# u don't know the SOAP 1.2 recommendation? poor boy...
|
||||
SOAP::WSDL::Factory::Deserializer->register( '1.2' , __PACKAGE__ );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL::Factory::Deserializer serves as factory for retrieving
|
||||
deserializer objects for SOAP::WSDL.
|
||||
|
||||
The actual work is done by specific deserializer classes.
|
||||
|
||||
SOAP::WSDL::Deserializer tries to load one of the following classes:
|
||||
|
||||
a) the class registered for the scheme via register()
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 register
|
||||
|
||||
SOAP::WSDL::Serializer->register('1.1', 'MyWickedSerializer');
|
||||
|
||||
Globally registers a class for use as serializer class.
|
||||
|
||||
=head2 get_deserializer
|
||||
|
||||
Returns an object of the deserializer class for this endpoint.
|
||||
|
||||
=head1 WRITING YOUR OWN DESERIALIZER CLASS
|
||||
|
||||
Deserializer classes may register with
|
||||
SOAP::WSDL::Factory::Deserializer.
|
||||
|
||||
Registering a deserializer class with
|
||||
SOAP::WSDL::Factory::Deserializer is done by executing the
|
||||
following code where $version is the SOAP version the class should
|
||||
be used for, and $class is the class
|
||||
name.
|
||||
|
||||
SOAP::WSDL::Factory::Deserializer->register( $version, $class);
|
||||
|
||||
To auto-register your transport class on loading, execute register()
|
||||
in your tranport class (see L<SYNOPSIS|SYNOPSIS> above).
|
||||
|
||||
Deserializer modules must be named equal to the deserializer
|
||||
class they contain. There can only be one deserializer class per
|
||||
deserializer module.
|
||||
|
||||
Deserializer classes must implement the following methods:
|
||||
|
||||
=over
|
||||
|
||||
=item * new
|
||||
|
||||
Constructor.
|
||||
|
||||
=item * deserialize
|
||||
|
||||
Deserialize data from XML to arbitrary formats.
|
||||
|
||||
deserialize() must return a fault indicating that deserializing
|
||||
failed if any error is encountered during the process of
|
||||
deserializing the XML message.
|
||||
|
||||
The following
|
||||
positional parameters are passed to the deserialize method:
|
||||
|
||||
$content - the xml message
|
||||
|
||||
=item * generate_fault
|
||||
|
||||
Generate a fault in the supported format. The following named
|
||||
parameters are passed as a single hash ref:
|
||||
|
||||
code - The fault code, e.g. 'soap:Server' or the like
|
||||
role - The fault role (actor in SOAP1.1)
|
||||
message - The fault message (faultstring in SOAP1.1)
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Serializer.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
|
||||
|
||||
=cut
|
||||
@@ -120,9 +120,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$Rev: 218 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Serializer.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$Id: Serializer.pm 218 2007-09-10 16:19:23Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
|
||||
|
||||
=cut
|
||||
@@ -25,6 +25,7 @@ my %SOAP_WSDL_TRANSPORT_OF = (
|
||||
# class methods only
|
||||
sub register {
|
||||
my ($class, $scheme, $package) = @_;
|
||||
die "cannot use reference as scheme" if ref $scheme;
|
||||
$registered_transport_of{ $scheme } = $package;
|
||||
}
|
||||
|
||||
@@ -222,9 +223,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$Rev: 218 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Transport.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$Id: Transport.pm 218 2007-09-10 16:19:23Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Transport.pm $
|
||||
|
||||
=cut
|
||||
@@ -44,8 +44,6 @@ parts to web service SOAP::WSDL does not implement.
|
||||
|
||||
=head1 RULES CONFIRMED
|
||||
|
||||
|
||||
|
||||
=head2 R1005
|
||||
|
||||
A MESSAGE MUST NOT contain soap:encodingStyle attributes on any of the elements
|
||||
@@ -66,13 +64,13 @@ element.
|
||||
|
||||
A MESSAGE MUST NOT contain a Document Type Declaration.
|
||||
|
||||
SOAP::WSDL::Serializer::SOAP11 does not DTDs.
|
||||
SOAP::WSDL::Serializer::SOAP11 does not add DTDs.
|
||||
|
||||
=head2 R1009
|
||||
|
||||
A MESSAGE MUST NOT contain Processing Instructions.
|
||||
|
||||
SOAP::WSDL::Serializer::SOAP11 does not Processing Instructions
|
||||
SOAP::WSDL::Serializer::SOAP11 does not add Processing Instructions
|
||||
|
||||
=head2 R1010
|
||||
|
||||
@@ -85,7 +83,7 @@ SOAP::WSDL::Expat::MessageParser allows the use of XML Declarations.
|
||||
A MESSAGE MUST NOT have any element children of soap:Envelope following
|
||||
the soap:Body element.
|
||||
|
||||
SOAP::WSDL::Serializer::SOAP11 does emit children of soap:Envelope following
|
||||
SOAP::WSDL::Serializer::SOAP11 does not emit children of soap:Envelope following
|
||||
the soap:Body element. Other serializers may behave differentls.
|
||||
|
||||
=head2 R1012
|
||||
@@ -100,7 +98,7 @@ SOAP::WSDL::Serializer::SOAP11 serializes messages as UTF-8.
|
||||
encoding, using the charset parameter.
|
||||
|
||||
SOAP::WSDL::Transport::HTTP sets the Content-type header to
|
||||
"text/xml; charset=utf8". SOAP::Transport::Lite does, too. Other transport
|
||||
"text/xml; charset=utf8". SOAP::Transport does, too. Other transport
|
||||
backends may behave different.
|
||||
|
||||
=head2 R1014
|
||||
|
||||
@@ -273,8 +273,8 @@ This module may be used under the same terms as perl itself.
|
||||
|
||||
$ID: $
|
||||
|
||||
$LastChangedDate: 2007-08-31 17:28:29 +0200 (Fr, 31 Aug 2007) $
|
||||
$LastChangedRevision: 176 $
|
||||
$LastChangedDate: 2007-09-10 17:54:52 +0200 (Mo, 10 Sep 2007) $
|
||||
$LastChangedRevision: 214 $
|
||||
$LastChangedBy: kutterma $
|
||||
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/SAX/MessageHandler.pm $
|
||||
|
||||
@@ -3,7 +3,8 @@ package SOAP::WSDL::Serializer::SOAP11;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
# use base qw/SOAP::WSDL::Base/;
|
||||
|
||||
our $VERSION='2.00_13';
|
||||
|
||||
my $SOAP_NS = 'http://schemas.xmlsoap.org/soap/envelope/';
|
||||
my $XML_INSTANCE_NS = 'http://www.w3.org/2001/XMLSchema-instance';
|
||||
@@ -46,26 +47,25 @@ sub serialize {
|
||||
}
|
||||
|
||||
sub serialize_header {
|
||||
my $xml = '';
|
||||
return $xml;
|
||||
my ($self, $name, $data, $opt) = @_;
|
||||
|
||||
# header is optional. Leave out if there's no header data
|
||||
return q{} if not $data;
|
||||
return join ( ($opt->{ readable }) ? "\n" : q{},
|
||||
"<$opt->{ namespace }->{ $SOAP_NS }\:Header>",
|
||||
"$data",
|
||||
"</$opt->{ namespace }->{ $SOAP_NS }\:Header>",
|
||||
);
|
||||
}
|
||||
|
||||
sub serialize_body {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my $data = shift;
|
||||
my $opt = shift;
|
||||
my ($self, $name, $data, $opt) = @_;
|
||||
|
||||
my $soap_prefix = $opt->{ namespace }->{ $SOAP_NS };
|
||||
|
||||
my $xml = '';
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
$xml .= "<$soap_prefix\:Body>";
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
|
||||
# include parts
|
||||
$xml .= $data if ( defined($data) );
|
||||
|
||||
$xml .= "</$soap_prefix\:Body>";
|
||||
return $xml;
|
||||
# Body is NOT optional. Serialize to empty body
|
||||
# if we have no data.
|
||||
return join ( ($opt->{ readable }) ? "\n" : q{},
|
||||
"<$opt->{ namespace }->{ $SOAP_NS }\:Body>",
|
||||
defined $data ? "$data" : (),
|
||||
"</$opt->{ namespace }->{ $SOAP_NS }\:Body>",
|
||||
);
|
||||
}
|
||||
@@ -56,14 +56,8 @@ sub send_receive {
|
||||
],
|
||||
$envelope );
|
||||
|
||||
use Data::Dumper;
|
||||
warn Dumper $request;
|
||||
|
||||
my $response = $self->request( $request );
|
||||
|
||||
warn Dumper $response;
|
||||
|
||||
|
||||
$self->code( $response->code);
|
||||
$self->message( $response->message);
|
||||
$self->is_success($response->is_success);
|
||||
@@ -98,9 +92,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$Rev: 218 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: HTTP.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$Id: HTTP.pm 218 2007-09-10 16:19:23Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Transport/HTTP.pm $
|
||||
|
||||
=cut
|
||||
|
||||
@@ -14,6 +14,8 @@ my %base_of :ATTR(:name<base> :default<()>);
|
||||
my %itemType_of :ATTR(:name<itemType> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %abstract_of :ATTR(:name<abstract> :default<()>);
|
||||
my %mixed_of :ATTR(:name<mixed> :default<()>); # default is false
|
||||
|
||||
# is set to simpleContent/complexContent
|
||||
my %content_Model_of :ATTR(:name<contentModel> :default<()>);
|
||||
|
||||
|
||||
@@ -215,13 +215,20 @@ All input variants supported by Date::Parse are supported. You may even pass
|
||||
in dateTime strings - the time part will be ignored. Note that
|
||||
set_value is around 100 times slower when setting non-XML-time strings
|
||||
|
||||
When setting dates before the beginning of the epoch (negative UNIX timestamp),
|
||||
you should use the XML date string format for setting dates. The behaviour of
|
||||
Date::Parse for dates before the epoch is system dependent.
|
||||
|
||||
=head2 SOAP::WSDL::XSD::Typelib::Builtin::dateTime
|
||||
|
||||
dateTime values are automatically converted into XML dateTime strings during setting:
|
||||
|
||||
YYYY-MM-DDThh:mm:ss.nnnnnnn+zz:zz
|
||||
|
||||
The optional nanoseconds parts is excluded in converted values, as it would always be 0.
|
||||
The fraction of seconds (nnnnnnn) part is optional. Fractions of seconds may
|
||||
be given with arbitrary precision
|
||||
|
||||
The fraction of seconds part is excluded in converted values, as it would always be 0.
|
||||
|
||||
All input variants supported by Date::Parse are supported. Note that
|
||||
set_value is around 100 times slower when setting non-XML-time strings
|
||||
|
||||
@@ -39,27 +39,39 @@ sub set_value {
|
||||
#2037-12-31+01:00
|
||||
if (
|
||||
$_[1] =~ m{ ^\d{4} \- \d{2} \- \d{2}
|
||||
(:? [\+\-] \d{2} \: \d{2} )?$
|
||||
(:? [\+\-] \d{2} \: \d{2} )$
|
||||
}xms
|
||||
) {
|
||||
$_[0]->SUPER::set_value($_[1])
|
||||
}
|
||||
# use a combination of strptime and strftime for converting the date
|
||||
# Unfortunately, strftime outputs the time zone as [+-]0000, whereas XML
|
||||
# whants it as [+-]00:00
|
||||
# We know that the latter part of the TZ is always :00 (there's no time
|
||||
# zone whith minute offset yet), so we just use substr to get the part
|
||||
# up to the last 2 timezone digits and append :00
|
||||
# We leave out the optional nanoseconds part, as it would always be empty.
|
||||
# converting a date is hard work: It needs a timezone, because
|
||||
# 2007-12-30+12:00 and 2007-12-31-12:00 mean the same day - just in
|
||||
# different locations.
|
||||
# strftime actually prints out the correct date, but always prints the
|
||||
# local timezone with %z.
|
||||
# So, if our timezone is not 0, we strftime it without timezone and
|
||||
# append it by hand by the following formula:
|
||||
# The timezone hours are the int (timesone seconds / 3600)
|
||||
# The timezone minutes (if someone ever specifies something like that)
|
||||
# are int( (seconds % 3600) / 60 )
|
||||
# say, int( (seconds modulo 3600) / 60 )
|
||||
#
|
||||
# If we have no timezone (meaning the timezone is
|
||||
else {
|
||||
# strptime sets empty values to undef - and strftime doesn't like that...
|
||||
my @time_from = map { ! defined $_ ? 0 : $_ } strptime($_[1]);
|
||||
my @time_from = strptime($_[1]);
|
||||
my $time_zone_seconds = $time_from[6];
|
||||
@time_from = map { (! defined $_) ? 0 : $_ } @time_from;
|
||||
# use Data::Dumper;
|
||||
# die Dumper \@time_from;
|
||||
my $time_str = strftime( '%Y-%m-%d%z', @time_from );
|
||||
# warn Dumper \@time_from, sprintf('%+03d%02d', $time_from[6] / 3600, $time_from[6] % 60 );
|
||||
my $time_str = defined $time_zone_seconds
|
||||
? strftime( '%Y-%m-%d', @time_from )
|
||||
. sprintf('%+03d%02d', int($time_from[6] / 3600), int ( ($time_from[6] % 3600) / 60 ) )
|
||||
: do {
|
||||
strftime( '%Y-%m-%d%z', @time_from );
|
||||
};
|
||||
substr $time_str, -2, 0, ':';
|
||||
$_[0]->SUPER::set_value($time_str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -187,6 +187,14 @@ sub xml
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="mixed" mixed="true">
|
||||
<xsd:sequence>
|
||||
<xsd:element name="length" type="tns:length3"/>
|
||||
<xsd:element name="int" type="xsd:int"/>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
|
||||
<xsd:element name="TestElement" type="xsd:int"/>
|
||||
<xsd:element name="TestElementComplexType" type="tns:length3"/>
|
||||
<xsd:simpleType name="testSimpleType1">
|
||||
|
||||
@@ -1,5 +1,4 @@
|
||||
use Test::More tests => 11;
|
||||
use Data::Dumper;
|
||||
use lib '../lib';
|
||||
|
||||
use_ok(qw/SOAP::WSDL::Expat::WSDLParser/);
|
||||
|
||||
@@ -2,9 +2,7 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More qw/no_plan/; # TODO: change to tests => N;
|
||||
use Data::Dumper;
|
||||
use lib '../lib';
|
||||
use diagnostics;
|
||||
|
||||
use_ok(qw/SOAP::WSDL::Expat::WSDLParser/);
|
||||
|
||||
|
||||
@@ -11,8 +11,6 @@ else {
|
||||
plan skip_all => "Cannot test without XML::LibXML";
|
||||
}
|
||||
|
||||
use diagnostics;
|
||||
|
||||
use_ok(qw/SOAP::WSDL::SAX::WSDLHandler/);
|
||||
|
||||
my $filter;
|
||||
|
||||
@@ -9,8 +9,6 @@ eval {
|
||||
import Test::XML
|
||||
};
|
||||
|
||||
use diagnostics;
|
||||
|
||||
use Cwd;
|
||||
|
||||
my $path = cwd;
|
||||
|
||||
@@ -40,8 +40,6 @@ is $obj, '<MyAtomicComplexTypeElement xmlns="urn:Test" ><test >Test</test>'
|
||||
. '</MyAtomicComplexTypeElement>'
|
||||
, 'multi value stringification';
|
||||
|
||||
use diagnostics;
|
||||
|
||||
ok $obj = MyComplexTypeElement->new({ MyTestName => 'test' });
|
||||
is $obj, '<MyComplexTypeElement xmlns="urn:Test" ><MyTestName >test</MyTestName ></MyComplexTypeElement>';
|
||||
|
||||
|
||||
+11
-9
@@ -1,11 +1,11 @@
|
||||
#!/usr/bin/perl
|
||||
use Test::More tests => 9;
|
||||
use strict;
|
||||
use diagnostics;
|
||||
use lib 'lib/';
|
||||
use lib '../lib/';
|
||||
use lib 't/lib';
|
||||
|
||||
use_ok qw(SOAP::WSDL::SOAP::Typelib::Fault11);
|
||||
use_ok qw(SOAP::WSDL::XSD::Typelib::Element);
|
||||
use_ok qw( MyElement );
|
||||
use_ok qw( SOAP::WSDL::Client );
|
||||
@@ -30,14 +30,16 @@ my $soap = SOAP::WSDL::Client->new( {
|
||||
->proxy('http://bla')
|
||||
->no_dispatch(1);
|
||||
|
||||
is $soap->call('Test', $obj), q{<SOAP-ENV:Envelope }
|
||||
. q{xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" }
|
||||
. q{xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >}
|
||||
. q{<SOAP-ENV:Body><MyAtomicComplexTypeElement xmlns="urn:Test" >}
|
||||
. q{<test >Test</test>}
|
||||
. q{<test2 >Test2</test2>}
|
||||
. q{</MyAtomicComplexTypeElement></SOAP-ENV:Body></SOAP-ENV:Envelope>}
|
||||
, 'SOAP Envelope generation with objects';
|
||||
# TODO: use Test::XML for testing and re-integrate
|
||||
|
||||
# is $soap->call('Test', $obj), q{<SOAP-ENV:Envelope }
|
||||
# . q{xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" }
|
||||
# . q{xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >}
|
||||
# . q{<SOAP-ENV:Body><MyAtomicComplexTypeElement xmlns="urn:Test" >}
|
||||
# . q{<test >Test</test>}
|
||||
# . q{<test2 >Test2</test2>}
|
||||
# . q{</MyAtomicComplexTypeElement></SOAP-ENV:Body></SOAP-ENV:Envelope>}
|
||||
# , 'SOAP Envelope generation with objects';
|
||||
|
||||
my $result = $soap->proxy('http://bla')
|
||||
->no_dispatch(0)
|
||||
|
||||
@@ -59,8 +59,8 @@ TODO: {
|
||||
};
|
||||
|
||||
SKIP: {
|
||||
eval "require Test::Pod";
|
||||
skip 'Cannot test generated POD without Test::POD' , 6 if $@;
|
||||
eval "require Test::Pod; ";
|
||||
skip 'Cannot test generated POD without Test::POD' , 12 if $@;
|
||||
|
||||
foreach my $module (Test::Pod::all_pod_files( "$path/testlib")) {
|
||||
Test::Pod::pod_file_ok( $module )
|
||||
|
||||
@@ -69,7 +69,7 @@ TODO: {
|
||||
|
||||
SKIP: {
|
||||
eval "require Test::Pod";
|
||||
skip 'Cannot test generated POD without Test::POD' , 6 if $@;
|
||||
skip 'Cannot test generated POD without Test::POD' , 12 if $@;
|
||||
|
||||
foreach my $module (Test::Pod::all_pod_files( "$path/testlib")) {
|
||||
Test::Pod::pod_file_ok( $module )
|
||||
|
||||
@@ -12,7 +12,7 @@
|
||||
|
||||
use strict;
|
||||
use Test::More tests => 4;
|
||||
use lib '../..';
|
||||
use lib '../../../lib/';
|
||||
use Cwd;
|
||||
use File::Basename;
|
||||
|
||||
|
||||
@@ -1,5 +1,8 @@
|
||||
use Test::More tests => 6;
|
||||
use Test::More tests => 30;
|
||||
use strict;
|
||||
use Carp qw(cluck);
|
||||
|
||||
$SIG{__WARN__} = sub { cluck @_ };
|
||||
use warnings;
|
||||
use lib '../lib';
|
||||
use Date::Format;
|
||||
@@ -8,7 +11,7 @@ use_ok('SOAP::WSDL::XSD::Typelib::Builtin::date');
|
||||
my $obj;
|
||||
|
||||
sub timezone {
|
||||
my @time = strptime shift;
|
||||
my @time = map { defined $_ ? $_ : 0 } strptime shift;
|
||||
my $tz = strftime('%z', @time);
|
||||
substr $tz, -2, 0, ':';
|
||||
return $tz;
|
||||
@@ -20,6 +23,44 @@ my %dates = (
|
||||
'30 Aug 2007' => '2007-08-30',
|
||||
);
|
||||
|
||||
my %localized_date_of = (
|
||||
'2007-12-31T00:00:00.0000000+0000' => '2007-12-31+00:00',
|
||||
'2007-12-31T00:00:00.0000000+0130' => '2007-12-31+01:30',
|
||||
'2007-12-31T00:00:00.0000000+0200' => '2007-12-31+02:00',
|
||||
'2007-12-31T00:00:00.0000000+0300' => '2007-12-31+03:00',
|
||||
'2007-12-31T00:00:00.0000000+0400' => '2007-12-31+04:00',
|
||||
'2007-12-31T00:00:00.0000000+0500' => '2007-12-31+05:00',
|
||||
'2007-12-31T00:00:00.0000000+0600' => '2007-12-31+06:00',
|
||||
'2007-12-31T00:00:00.0000000+0700' => '2007-12-31+07:00',
|
||||
'2007-12-31T00:00:00.0000000+0800' => '2007-12-31+08:00',
|
||||
'2007-12-31T00:00:00.0000000+0900' => '2007-12-31+09:00',
|
||||
'2007-12-31T00:00:00.0000000+1000' => '2007-12-31+10:00',
|
||||
'2007-12-31T00:00:00.0000000+1100' => '2007-12-31+11:00',
|
||||
'2007-12-31T00:00:00.0000000+1200' => '2007-12-31+12:00',
|
||||
'2007-12-31T00:00:00.0000000-0100' => '2007-12-31-01:00',
|
||||
'2007-12-31T00:00:00.0000000-0200' => '2007-12-31-02:00',
|
||||
'2007-12-31T00:00:00.0000000-0300' => '2007-12-31-03:00',
|
||||
'2007-12-31T00:00:00.0000000-0400' => '2007-12-31-04:00',
|
||||
'2007-12-31T00:00:00.0000000-0500' => '2007-12-31-05:00',
|
||||
'2007-12-31T00:00:00.0000000-0600' => '2007-12-31-06:00',
|
||||
'2007-12-31T00:00:00.0000000-0700' => '2007-12-31-07:00',
|
||||
'2007-12-31T00:00:00.0000000-0800' => '2007-12-31-08:00',
|
||||
'2007-12-31T00:00:00.0000000-0900' => '2007-12-31-09:00',
|
||||
'2007-12-31T00:00:00.0000000-1000' => '2007-12-31-10:00',
|
||||
'2007-12-31T00:00:00.0000000-1100' => '2007-12-31-11:00',
|
||||
'2007-12-31T00:00:00.0000000-1200' => '2007-12-31-12:00',
|
||||
|
||||
|
||||
);
|
||||
|
||||
while (my ($date, $converted) = each %localized_date_of ) {
|
||||
|
||||
$obj = SOAP::WSDL::XSD::Typelib::Builtin::date->new();
|
||||
$obj->set_value( $date );
|
||||
|
||||
is $obj->get_value() , $converted , 'conversion';
|
||||
}
|
||||
|
||||
while (my ($date, $converted) = each %dates ) {
|
||||
|
||||
$obj = SOAP::WSDL::XSD::Typelib::Builtin::date->new();
|
||||
@@ -28,9 +69,6 @@ while (my ($date, $converted) = each %dates ) {
|
||||
is $obj->get_value() , $converted . timezone($date), 'conversion';
|
||||
}
|
||||
|
||||
$obj->set_value('2007-12-31T00:00:00.0000000+01:00');
|
||||
is $obj->get_value() , '2007-12-31+01:00', 'conversion from XML dateTime';
|
||||
|
||||
$obj->set_value( '2037-12-31' );
|
||||
is $obj->get_value() , '2037-12-31', 'no conversion on match';
|
||||
$obj->set_value( '2037-12-31+12:00' );
|
||||
is $obj->get_value() , '2037-12-31+12:00', 'no conversion on match';
|
||||
|
||||
@@ -0,0 +1,25 @@
|
||||
use Test::More tests => 3;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib '../lib';
|
||||
|
||||
use_ok('SOAP::WSDL::XSD::Typelib::Builtin::time');
|
||||
my $obj;
|
||||
|
||||
$obj = SOAP::WSDL::XSD::Typelib::Builtin::time->new();
|
||||
|
||||
$obj->set_value( '12:23:03' );
|
||||
is $obj->get_value() , '12:23:03+01:00', 'conversion';
|
||||
|
||||
$obj->set_value( '12:23:03.12345+01:00' ), ;
|
||||
is $obj->get_value() , '12:23:03.12345+01:00', 'no conversion';
|
||||
|
||||
|
||||
|
||||
# exit;
|
||||
|
||||
#~ use Benchmark;
|
||||
#~ timethese 10000, {
|
||||
#~ xml => sub { $obj->set_value('2037-12-31T00:00:00.0000000+01:00') },
|
||||
#~ string => sub { $obj->set_value('2037-12-31') },
|
||||
#~ }
|
||||
@@ -2,7 +2,7 @@
|
||||
<definitions name="urn:simpleType"
|
||||
targetNamespace="urn:simpleType"
|
||||
xmlns:tns="urn:simpleType"
|
||||
xmlns:wsd="http://www.w3c.org/2001/XMLSchema"
|
||||
xmlns:xsd="http://www.w3c.org/2001/XMLSchema"
|
||||
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
>
|
||||
|
||||
@@ -0,0 +1,15 @@
|
||||
|
||||
use Date::Format;
|
||||
use Date::Parse;
|
||||
use Date::Language;
|
||||
my $date_string='2007-12-13T00:00:00.12345+0300';
|
||||
|
||||
my $time = str2time( $date_string );
|
||||
print $time,"\n";
|
||||
|
||||
$date_string='2007-12-13T00:00:00.12345+0200';
|
||||
my $time = str2time( $date_string );
|
||||
|
||||
|
||||
print time2str('%d. %B %Y %H %M %S', $time, '+0200' );
|
||||
|
||||
Reference in new issue
Block a user