Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
 Martin Kutter
|
099c83b6bc | ||
|
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_14',
|
||||
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;
|
||||
@@ -1,4 +1,4 @@
|
||||
Release notes for SOAP::WSDL 2.00_12
|
||||
Release notes for SOAP::WSDL 2.00_14
|
||||
-------
|
||||
|
||||
I'm very happy to present a new pre-release version of SOAP::WSDL.
|
||||
@@ -23,10 +23,75 @@ Features:
|
||||
The following plugins are supported:
|
||||
o Transport plugins via SOAP::WSDL::Factory::Transport
|
||||
o Serializer plugins via SOAP::WSDL::Factory::Serializer
|
||||
o Deserializer plugins via SOAP::WSDL::Factory::Serializer
|
||||
|
||||
|
||||
The following changes have been made:
|
||||
|
||||
2.00_14
|
||||
----
|
||||
|
||||
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):
|
||||
|
||||
* [ 1792235 ] SOAP::WSDL::Transport::Test missing from 2.00_13
|
||||
The package has been re-added
|
||||
|
||||
* [ 1792221 ] class_resolver not set from ::Client in 2.00_13
|
||||
Changed to set class_resolver correctly.
|
||||
|
||||
The following uncategorized improvements have been made:
|
||||
|
||||
* The ::SOM deserializer has been simplified to be just a subclass
|
||||
of SOAP::Deserializer from SOAP::Lite
|
||||
* Factories now emit more useful error messages when no class is registered
|
||||
for the protocol/soap_version requested
|
||||
* Documentation has been improved
|
||||
- refined ::Factory:: modules' documentation
|
||||
* Several tests have been added
|
||||
* XSD classes have been improved for testability
|
||||
|
||||
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 made:
|
||||
|
||||
* Documentation improvements
|
||||
|
||||
2.00_12
|
||||
----
|
||||
|
||||
@@ -40,6 +105,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 +150,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
|
||||
@@ -57,6 +63,7 @@ lib/SOAP/WSDL/Service.pm
|
||||
lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
|
||||
lib/SOAP/WSDL/SoapOperation.pm
|
||||
lib/SOAP/WSDL/Transport/HTTP.pm
|
||||
lib/SOAP/WSDL/Transport/Test.pm
|
||||
lib/SOAP/WSDL/TypeLookup.pm
|
||||
lib/SOAP/WSDL/Types.pm
|
||||
lib/SOAP/WSDL/XSD/Builtin.pm
|
||||
@@ -117,7 +124,7 @@ lib/SOAP/WSDL/XSD/Typelib/Element.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||
LICENSE
|
||||
Makefile.PL
|
||||
MANIFEST This list of files
|
||||
MANIFEST
|
||||
META.yml
|
||||
README
|
||||
t/001_use.t
|
||||
@@ -200,7 +207,14 @@ t/SOAP/WSDL/05_simpleType-restriction.t
|
||||
t/SOAP/WSDL/05_simpleType-union.t
|
||||
t/SOAP/WSDL/11_helloworld.NET.t
|
||||
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/Transport/01_Test.t
|
||||
t/SOAP/WSDL/Transport/acceptance/test2.xml
|
||||
t/SOAP/WSDL/Transport/acceptance/test3.xml
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/001_anyType.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/002_anySimpleType.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/003_date.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/004_time.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/005_dateTime.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/006_string.t
|
||||
t/test.pl
|
||||
TODO
|
||||
@@ -1,6 +1,6 @@
|
||||
---
|
||||
name: SOAP-WSDL
|
||||
version: 2.00_12
|
||||
version: 2.00_14
|
||||
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_14
|
||||
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_14
|
||||
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,12 +71,16 @@ 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:
|
||||
file: lib/SOAP/WSDL/SoapOperation.pm
|
||||
SOAP::WSDL::Transport::HTTP:
|
||||
file: lib/SOAP/WSDL/Transport/HTTP.pm
|
||||
SOAP::WSDL::Transport::Test:
|
||||
file: lib/SOAP/WSDL/Transport/Test.pm
|
||||
version: 2.00_14
|
||||
SOAP::WSDL::TypeLookup:
|
||||
file: lib/SOAP/WSDL/TypeLookup.pm
|
||||
SOAP::WSDL::Types:
|
||||
|
||||
@@ -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() },
|
||||
};
|
||||
+15
-11
@@ -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;
|
||||
my $soap = SOAP::Lite->new()->on_action( sub { join'/', @_ } )
|
||||
->proxy("http://www.webservicex.net/globalweather.asmx");
|
||||
my $som = $soap->call(
|
||||
SOAP::Data->name('GetWeather')->attr({ xmlns => 'http://www.webserviceX.NET' }),
|
||||
use SOAP::Lite; # +trace;
|
||||
$soap = SOAP::Lite->new()->on_action( sub { join'/', @_ } )
|
||||
->proxy("http://www.webservicex.net/globalweather.asmx"); # from WSDL
|
||||
$som = $soap->call(
|
||||
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
|
||||
|
||||
+61
-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_14';
|
||||
|
||||
# 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,43 @@ 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 }->set_class_resolver( $class_resolver_of{ $ident } )
|
||||
if ( $deserializer_of{ $ident }->can('set_class_resolver') );
|
||||
|
||||
# Try deserializing response - there may be some,
|
||||
# even if transport did not succeed (got a 500 response)
|
||||
if ( $response ) {
|
||||
my $result = eval { $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 +375,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 188 $
|
||||
$Rev: 239 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Client.pm 188 2007-09-03 15:15:19Z kutterma $
|
||||
$Id: Client.pm 239 2007-09-11 09:45:42Z 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,127 @@
|
||||
package SOAP::WSDL::Deserializer::SOM;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.00_14';
|
||||
our @ISA = qw(SOAP::Deserializer);
|
||||
|
||||
my $HAVE_SOAP_LITE = eval { require SOAP::Lite };
|
||||
|
||||
sub deserialize {
|
||||
my $self = shift;
|
||||
die 'Cannot deserialize to SOM object without SOAP::Lite.
|
||||
Please install SOAP::Lite.
|
||||
'
|
||||
if not $HAVE_SOAP_LITE;
|
||||
$self->SUPER::deserialize(@_);
|
||||
}
|
||||
|
||||
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 here for two reasons:
|
||||
|
||||
=over
|
||||
|
||||
=item * Compatibility
|
||||
|
||||
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.
|
||||
|
||||
=item * Completeness
|
||||
|
||||
SOAP::Lite covers much more of the SOAP specification than SOAP::WSDL.
|
||||
|
||||
SOAP::WSDL::Deserializer::SOM can be used for content which cannot be
|
||||
deserialized by L<SOAP::WSDL::Deserializer::SOAP11|SOAP::WSDL::Deserializer::SOAP11>.
|
||||
This may be XML including mixed content, attachements and other XML data not
|
||||
(yet) handled by L<SOAP::WSDL::Deserializer::SOAP11|SOAP::WSDL::Deserializer::SOAP11>.
|
||||
|
||||
=back
|
||||
|
||||
SOAP::WSDL::Deserializer::SOM is a subclass of L<SOAP::Deserializer|SOAP::Deserializer>
|
||||
from the L<SOAP::Lite|SOAP::Lite> package.
|
||||
|
||||
You may
|
||||
|
||||
=head1 USAGE
|
||||
|
||||
SOAP::WSDL::Deserializer will not auroregister itself - to use it for a particular
|
||||
SOAP version just use the following lines:
|
||||
|
||||
my $soap_version = '1.1'; # or '1.2', further versions may appear.
|
||||
|
||||
use SOAP::WSDL::Deserializer::SOM;
|
||||
use SOAP::WSDL::Factory::Deserializer;
|
||||
SOAP::WSDL::Factory::Deserializer->register( $soap_version, __PACKAGE__ );
|
||||
|
||||
=head1 DIFFERENCES FROM OTHER CLASSES
|
||||
|
||||
=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,152 @@
|
||||
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) = @_;
|
||||
|
||||
# sanity check
|
||||
die "no deserializer registered for SOAP version $args_of_ref->{ soap_version }"
|
||||
if not exists ($DESERIALIZER{ $args_of_ref->{ soap_version } });
|
||||
|
||||
# load module
|
||||
eval "require $DESERIALIZER{ $args_of_ref->{ soap_version } }"
|
||||
or die "Cannot load serializer $DESERIALIZER{ $args_of_ref->{ soap_version } }", $@;
|
||||
|
||||
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::Deserializer->get_deserializer({
|
||||
soap_version => $soap_version,
|
||||
class_resolver => $class_resolver,
|
||||
});
|
||||
|
||||
# in deserializer class:
|
||||
package MyWickedDeserializer;
|
||||
use SOAP::WSDL::Factory::Deserializer;
|
||||
|
||||
# register class as deserializer for SOAP1.2 messages
|
||||
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:
|
||||
|
||||
=over
|
||||
|
||||
=item * The class registered for the scheme via register()
|
||||
|
||||
=back
|
||||
|
||||
By default, L<SOAP::WSDL::Deserializer::SOAP11|SOAP::WSDL::Deserializer::SOAP11>
|
||||
is registered for SOAP1.1 messages.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 register
|
||||
|
||||
SOAP::WSDL::Deserializer->register('1.1', 'MyWickedDeserializer');
|
||||
|
||||
Globally registers a class for use as deserializer 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.
|
||||
|
||||
=head2 Registering a 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).
|
||||
|
||||
=head2 Deserializer package layout
|
||||
|
||||
Deserializer modules must be named equal to the deserializer class they
|
||||
contain. There can only be one deserializer class per deserializer module.
|
||||
|
||||
=head2 Methods to implement
|
||||
|
||||
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
|
||||
@@ -14,7 +14,15 @@ sub register {
|
||||
|
||||
sub get_serializer {
|
||||
my ($self, $args_of_ref) = @_;
|
||||
eval "require $SERIALIZER{ $args_of_ref->{ soap_version } }" or die $@;
|
||||
|
||||
# sanity check
|
||||
die "no deserializer registered for SOAP version $args_of_ref->{ soap_version }"
|
||||
if not exists ($SERIALIZER{ $args_of_ref->{ soap_version } });
|
||||
|
||||
# load module
|
||||
eval "require $SERIALIZER{ $args_of_ref->{ soap_version } }"
|
||||
or die "Cannot load serializer $SERIALIZER{ $args_of_ref->{ soap_version } }", $@;
|
||||
|
||||
return $SERIALIZER{ $args_of_ref->{ soap_version } }->new();
|
||||
}
|
||||
|
||||
@@ -24,7 +32,7 @@ sub get_serializer {
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Factory::Serializer - factory for retrieving serializer objects
|
||||
SOAP::WSDL::Factory::Serializer - Factory for retrieving serializer objects
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
@@ -37,7 +45,7 @@ SOAP::WSDL::Factory::Serializer - factory for retrieving serializer objects
|
||||
package MyWickedSerializer;
|
||||
use SOAP::WSDL::Factory::Serializer;
|
||||
|
||||
# u don't know the SOAP 1.2 recommendation? poor boy...
|
||||
# register as serializer for SOAP1.2 messages
|
||||
SOAP::WSDL::Factory::Serializer->register( '1.2' , __PACKAGE__ );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
@@ -49,7 +57,11 @@ The actual work is done by specific serializer classes.
|
||||
|
||||
SOAP::WSDL::Serializer tries to load one of the following classes:
|
||||
|
||||
a) the class registered for the scheme via register()
|
||||
=over
|
||||
|
||||
=item * the class registered for the scheme via register()
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
@@ -65,28 +77,32 @@ Returns an object of the serializer class for this endpoint.
|
||||
|
||||
=head1 WRITING YOUR OWN SERIALIZER CLASS
|
||||
|
||||
=head2 Registering a deserializer
|
||||
|
||||
Serializer classes may register with SOAP::WSDL::Factory::Serializer.
|
||||
|
||||
Serializer objects may also be passed directly to SOAP::WSDL::Client
|
||||
by using the set_serializer method. Note that serializers objects set
|
||||
via SOAP::WSDL::Client's set_serializer method are discarded when the
|
||||
SOAP version is changed via set_soap_version.
|
||||
Serializer objects may also be passed directly to SOAP::WSDL::Client by
|
||||
using the set_serializer method. Note that serializers objects set via
|
||||
SOAP::WSDL::Client's set_serializer method are discarded when the SOAP
|
||||
version is changed via set_soap_version.
|
||||
|
||||
Registering a serializer class with SOAP::WSDL::Factory::Serializer
|
||||
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.
|
||||
Registering a serializer class with SOAP::WSDL::Factory::Serializer 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::Serializer->register( $version, $class);
|
||||
|
||||
To auto-register your transport class on loading, execute register()
|
||||
in your tranport class (see L<SYNOPSIS|SYNOPSIS> above).
|
||||
To auto-register your transport class on loading, execute register() in
|
||||
your tranport class (see L<SYNOPSIS|SYNOPSIS> above).
|
||||
|
||||
Serializer modules must be named equal to the serializer
|
||||
class they contain. There can only be one serializer class per
|
||||
serializer module.
|
||||
=head2 Serializer package layout
|
||||
|
||||
Serializer class must implement the following methods:
|
||||
Serializer modules must be named equal to the serializer class they contain.
|
||||
There can only be one serializer class per serializer module.
|
||||
|
||||
=head2 Methods to implement
|
||||
|
||||
Serializer classes must implement the following methods:
|
||||
|
||||
=over
|
||||
|
||||
@@ -96,8 +112,8 @@ Constructor.
|
||||
|
||||
=item * serialize
|
||||
|
||||
Serializes data to XML. The following named parameters are passed to
|
||||
the serialize method in a anonymous hash ref:
|
||||
Serializes data to XML. The following named parameters are passed to the
|
||||
serialize method in a anonymous hash ref:
|
||||
|
||||
{
|
||||
method => $operation_name,
|
||||
@@ -120,9 +136,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$Rev: 225 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Serializer.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$Id: Serializer.pm 225 2007-09-10 19:04:57Z 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;
|
||||
}
|
||||
|
||||
@@ -77,7 +78,7 @@ sub get_transport {
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Factory::Transport - factory for retrieving transport objects
|
||||
SOAP::WSDL::Factory::Transport - Factory for retrieving transport objects
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
@@ -88,22 +89,29 @@ SOAP::WSDL::Factory::Transport - factory for retrieving transport objects
|
||||
package MyWickedTransport;
|
||||
use SOAP::WSDL::Factory::Transport;
|
||||
|
||||
# u don't know the httpr protocol? poor boy...
|
||||
# register class as transport module for httpr and https
|
||||
# (httpr is "reliable http", a protocol developed by IBM).
|
||||
SOAP::WSDL::Factory::Transport->register( 'httpr' , __PACKAGE__ );
|
||||
SOAP::WSDL::Factory::Transport->register( 'https' , __PACKAGE__ );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL::Transport serves as factory for retrieving
|
||||
transport objects for SOAP::WSDL.
|
||||
SOAP::WSDL::Transport serves as factory for retrieving transport objects for
|
||||
SOAP::WSDL.
|
||||
|
||||
The actual work is done by specific transport classes.
|
||||
|
||||
SOAP::WSDL::Transport tries to load one of the following classes:
|
||||
|
||||
a) the class registered for the scheme via register()
|
||||
b) the SOAP::Lite class matching the scheme
|
||||
c) the SOAP::WSDL class matching the scheme
|
||||
=over
|
||||
|
||||
=item * the class registered for the scheme via register()
|
||||
|
||||
=item * the SOAP::Lite class matching the scheme
|
||||
|
||||
=item * the SOAP::WSDL class matching the scheme
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
@@ -131,31 +139,34 @@ Gets the current transport object.
|
||||
|
||||
=head1 WRITING YOUR OWN TRANSPORT CLASS
|
||||
|
||||
=head2 Registering a transport class
|
||||
|
||||
Transport classes must be registered with SOAP::WSDL::Factory::Transport.
|
||||
|
||||
This is done by executing the following code where $scheme is the
|
||||
URL scheme the class should be used for, and $module is the class'
|
||||
module name.
|
||||
This is done by executing the following code where $scheme is the URL scheme
|
||||
the class should be used for, and $module is the class' module name.
|
||||
|
||||
SOAP::WSDL::Factory::Transport->register( $scheme, $module);
|
||||
|
||||
To auto-register your transport class on loading, execute register()
|
||||
in your tranport class (see L<SYNOPSIS|SYNOPSIS> above).
|
||||
To auto-register your transport class on loading, execute register() in your
|
||||
tranport class (see L<SYNOPSIS|SYNOPSIS> above).
|
||||
|
||||
Multiple protocols ore multiple classes are registered by multiple calls to
|
||||
register().
|
||||
|
||||
=head2 Transport plugin package layout
|
||||
|
||||
You may only use transport classes whose name is either
|
||||
the module name or the module name with '::Client' appended.
|
||||
|
||||
Transport classes must implement the interface required for
|
||||
SOAP::Lite transport classes.
|
||||
=head2 Methods to implement
|
||||
|
||||
See L<SOAP::Lite::Transport> for details,
|
||||
L<SOAP::WSDL::Transport::HTTP|SOAP::WSDL::Transport::HTTP>
|
||||
for an example.
|
||||
Transport classes must implement the interface required for SOAP::Lite
|
||||
transport classes (see L<SOAP::Lite::Transport> for details,
|
||||
L<SOAP::WSDL::Transport::HTTP|SOAP::WSDL::Transport::HTTP> for an example).
|
||||
|
||||
Transport modules must implement the following methods:
|
||||
To provide this interface, transport modules must implement the following
|
||||
methods:
|
||||
|
||||
=over
|
||||
|
||||
@@ -199,15 +210,14 @@ SOAP::WSDL does not require you to follow these restrictions.
|
||||
|
||||
There is only one restriction in SOAP::WSDL:
|
||||
|
||||
You may only use transport classes whose name is either
|
||||
the module name or the module name with '::Client' appended.
|
||||
You may only use transport classes whose name is either the module name or
|
||||
the module name with '::Client' appended.
|
||||
|
||||
SOAP::WSDL will try to instantiate an object of your
|
||||
transport class with '::Client' appended to allow using transport
|
||||
classes written for SOAP::Lite.
|
||||
SOAP::WSDL will try to instantiate an object of your transport class with
|
||||
'::Client' appended to allow using transport classes written for SOAP::Lite.
|
||||
|
||||
This may lead to errors when a different module with the name
|
||||
of your transport module suffixed with ::Client is also loaded.
|
||||
This may lead to errors when a different module with the name of your
|
||||
transport module suffixed with ::Client is also loaded.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
@@ -222,9 +232,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$Rev: 225 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Transport.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$Id: Transport.pm 225 2007-09-10 19:04:57Z 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
|
||||
|
||||
@@ -0,0 +1,129 @@
|
||||
package SOAP::WSDL::Transport::Test;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::Factory::Transport;
|
||||
|
||||
our $VERSION = '2.00_14';
|
||||
|
||||
SOAP::WSDL::Factory::Transport->register( http => __PACKAGE__ );
|
||||
SOAP::WSDL::Factory::Transport->register( https => __PACKAGE__ );
|
||||
|
||||
my %code_of :ATTR(:name<code> :default<()>);
|
||||
my %status_of :ATTR(:name<status> :default<()>);
|
||||
my %message_of :ATTR(:name<message> :default<()>);
|
||||
my %is_success_of :ATTR(:name<is_success> :default<()>);
|
||||
my %base_dir_of :ATTR(:name<base_dir> :init_arg<base_dir> :default<.>);
|
||||
|
||||
# create methods normally inherited from SOAP::Client
|
||||
SUBFACTORY: {
|
||||
no strict qw(refs);
|
||||
foreach my $method ( qw(code message status is_success) ) {
|
||||
*{ $method } = *{ "get_$method" };
|
||||
}
|
||||
}
|
||||
|
||||
sub send_receive {
|
||||
my ($self, %parameters) = @_;
|
||||
my ($envelope, $soap_action, $endpoint, $encoding, $content_type) =
|
||||
@parameters{qw(envelope action endpoint encoding content_type)};
|
||||
|
||||
my $filename = $soap_action;
|
||||
$filename =~s{ \A(:?'|") }{}xms;
|
||||
$filename =~s{ (:?'|")\z }{}xms;
|
||||
$filename =~s{ \A [^:]+ : (:? /{2})? }{}xms;
|
||||
|
||||
$filename = join '/', $base_dir_of{ ident $self }, "$filename.xml";
|
||||
|
||||
if (not -r $filename) {
|
||||
warn "cannot access $filename";
|
||||
$self->set_code( 500 );
|
||||
$self->set_message( "Failed" );
|
||||
$self->set_is_success(0);
|
||||
$self->set_status("500 Failed");
|
||||
return;
|
||||
}
|
||||
|
||||
open my $fh, '<', $filename or die "cannot open $filename: $!";
|
||||
binmode $fh;
|
||||
my $response = <$fh>;
|
||||
close $fh or die "cannot close $filename: $!";
|
||||
|
||||
$self->set_code( 200 );
|
||||
$self->set_message( "OK" );
|
||||
$self->set_is_success(1);
|
||||
$self->set_status("200 OK");
|
||||
return $response;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Transport::Test - Test transport class for SOAP::WSDL
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use SOAP::WSDL::Client;
|
||||
use SOAP::WSDL::Transport::Test;
|
||||
|
||||
my $soap = SOAP::WSDL::Client->new()
|
||||
$soap->get_transport->set_base_dir('.');
|
||||
$soap->call('method', \%body, \%header);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL::Transport::Test is a file-based test transport backend for
|
||||
SOAP::WSDL.
|
||||
|
||||
When SOAP::WSDL::Transport::Test is used as transport backend, the reponse is
|
||||
read from a XML file and the request message is discarded. This is particularly
|
||||
useful for testing SOAP::WSDL plugins.
|
||||
|
||||
=head2 Filename resolution
|
||||
|
||||
SOAP::WSDL::Transport makes up the response XML file name from the SOAPAction
|
||||
of the request. The following filename is used:
|
||||
|
||||
base_dir / soap_action .xml
|
||||
|
||||
The protocol scheme (e.g. http:) and two heading slashes (//) are stripped from
|
||||
the soap_action.
|
||||
|
||||
base_dir defaults to '.'
|
||||
|
||||
Examples:
|
||||
|
||||
SOAPAction: http://somewhere.over.the.rainbow/webservice/webservice.asmx
|
||||
Filename: ./somewhere.over.the.rainbow/webservice/webservice.asmx.xml
|
||||
|
||||
SOAPAction: uri:MyWickedService/test
|
||||
Filename: ./MyWickedService/test.xml
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 set_base_dir
|
||||
|
||||
Sets the base directory SOAP::WSDL::Transport::Test should look for response
|
||||
files.
|
||||
|
||||
=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: 218 $
|
||||
$LastChangedBy: 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
|
||||
|
||||
@@ -13,15 +13,23 @@ my %value_of :ATTR(:get<value> :init_arg<value> :default<()>);
|
||||
# and we don't need to return the last value...
|
||||
sub set_value { $value_of{ ident $_[0] } = $_[1] }
|
||||
|
||||
# use $_[n] for speed.
|
||||
# This is less readable, but notably faster.
|
||||
#
|
||||
# use postfix-if for speed. This is slightly faster, as it saves
|
||||
# perl from creating a pad (variable context).
|
||||
#
|
||||
# The methods below may get called zillions of times, so
|
||||
# every little statement matters...
|
||||
|
||||
sub serialize {
|
||||
my ($self, $opt) = @_;
|
||||
my $ident = ident $self;
|
||||
$opt ||= {};
|
||||
return $self->start_tag({ %$opt, nil => 1})
|
||||
if not defined $value_of{ $ident };
|
||||
return join q{}, $self->start_tag($opt, $value_of{ $ident })
|
||||
no warnings qw(uninitialized);
|
||||
my $ident = ident $_[0];
|
||||
$_[1]->{ nil } = 1 if not defined $value_of{ $ident };
|
||||
return join q{}
|
||||
, $_[0]->start_tag($_[1], $value_of{ $ident })
|
||||
, $value_of{ $ident }
|
||||
, $self->end_tag($opt);
|
||||
, $_[0]->end_tag($_[1]);
|
||||
}
|
||||
|
||||
# TODO disallow serializing !
|
||||
|
||||
@@ -3,7 +3,9 @@ use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
my %xmlns_of :ATTR(:name<xmlns> :default<()>);
|
||||
my %xmlns_of :ATTR(:get<xmlns> :init_arg<xmlns> :default<()>);
|
||||
|
||||
sub set_xmlns { $xmlns_of{ ident $_[0] } = $_[1] };
|
||||
|
||||
# use $_[1] for performance
|
||||
sub start_tag {
|
||||
@@ -19,6 +21,8 @@ sub end_tag {
|
||||
: q{};
|
||||
};
|
||||
|
||||
sub serialize { q{} };
|
||||
|
||||
sub serialize_qualified :STRINGIFY {
|
||||
return $_[0]->serialize( { qualified => 1 } );
|
||||
}
|
||||
|
||||
@@ -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);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+8
-2
@@ -1,11 +1,15 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More qw/no_plan/; # TODO: change to tests => N;
|
||||
use Test::More; # TODO: change to tests => N;
|
||||
use lib '../lib';
|
||||
chdir 't/' if (-d 't/');
|
||||
|
||||
my @modules = qw(
|
||||
SOAP::WSDL
|
||||
SOAP::WSDL::Client
|
||||
SOAP::WSDL::Serializer::SOAP11
|
||||
SOAP::WSDL::Deserializer::SOAP11
|
||||
SOAP::WSDL::Transport::HTTP
|
||||
SOAP::WSDL::Definitions
|
||||
SOAP::WSDL::Message
|
||||
SOAP::WSDL::Operation
|
||||
@@ -22,6 +26,8 @@ my @modules = qw(
|
||||
SOAP::WSDL::XSD::Schema
|
||||
);
|
||||
|
||||
plan tests => 2* scalar @modules;
|
||||
|
||||
for my $module (@modules)
|
||||
{
|
||||
use_ok($module);
|
||||
|
||||
@@ -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;
|
||||
|
||||
|
||||
@@ -0,0 +1,44 @@
|
||||
use Test::More tests => 9;
|
||||
use strict;
|
||||
use warnings;
|
||||
use File::Basename;
|
||||
use SOAP::WSDL::Client;
|
||||
|
||||
my $soap;
|
||||
my $base_dir = dirname( __FILE__ );
|
||||
use_ok(qw/SOAP::WSDL::Transport::Test/);
|
||||
|
||||
$soap = SOAP::WSDL::Client->new();
|
||||
$soap->set_proxy('http://somewhere.over.the.rainbow');
|
||||
|
||||
ok( $soap->get_transport->set_base_dir( join '/', $base_dir, 'acceptance' ) );
|
||||
|
||||
my $response = $soap->call({ operation => 'test', soap_action => 'http://test' }, {});
|
||||
ok ! $response, 'Returned fault on error';
|
||||
is $response->get_faultcode(), 'soap:Server', 'faultcode';
|
||||
is $response->get_faultactor(), 'urn:localhost', 'faultactor';
|
||||
|
||||
$soap->outputxml(1);
|
||||
$response = $soap->call({ operation => 'test', soap_action => 'http://test2' }, {});
|
||||
is $response, 'test2', 'Returned file content';
|
||||
|
||||
SKIP: {
|
||||
eval { require SOAP::WSDL::Deserializer::SOM; }
|
||||
or skip 'SOAP::WSDL::Deserializer::SOM required', 3;
|
||||
# requre SOAP::WSDL::Factory::Deserializer;
|
||||
SOAP::WSDL::Factory::Deserializer->register('1.1', 'SOAP::WSDL::Deserializer::SOM');
|
||||
|
||||
my $soap_som = SOAP::WSDL::Client->new();
|
||||
$soap_som->set_proxy('http://somewhere.over.the.rainbow');
|
||||
$soap_som->get_transport->set_base_dir( join '/', $base_dir, 'acceptance' );
|
||||
|
||||
my $som;
|
||||
ok $som = $soap_som->call({ operation => 'test', soap_action => 'http://test3' }, {})
|
||||
, 'Call with SOAP::WSDL::Deserializer::SOM';
|
||||
|
||||
# In the somewhat weird logic of SOAP::Lite, the first node inside the root element
|
||||
# is the reault, all others are output parameters (and may be accessed via "paramsout")
|
||||
is $som->result(), 'Munich', 'Result match';
|
||||
is $som->paramsout(), 'Germany' , 'Output parameter match';
|
||||
}
|
||||
|
||||
@@ -0,0 +1 @@
|
||||
test2
|
||||
@@ -0,0 +1 @@
|
||||
<SOAP-ENV:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" ><SOAP-ENV:Body><GetWeatherResponse xmlns="http://www.webserviceX.NET"><CityName>Munich</CityName><CountryName>Germany</CountryName></GetWeatherResponse></SOAP-ENV:Body></SOAP-ENV:Envelope>
|
||||
@@ -0,0 +1,20 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More qw(no_plan);
|
||||
use Scalar::Util qw(blessed);
|
||||
use lib '../../../../../../lib';
|
||||
use_ok qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
|
||||
|
||||
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::anyType->new({
|
||||
xmlns => 'urn:Siemens.mosaic'
|
||||
});
|
||||
|
||||
ok blessed $obj, 'constructor returned blessed reference';
|
||||
|
||||
ok $obj->set_xmlns('urn:SOAP-WSDL'), 'set_xmlns';
|
||||
is $obj->get_xmlns(), 'urn:SOAP-WSDL', 'get_xmlns';
|
||||
|
||||
is $obj->start_tag({ name => 'test' }), '<test >', 'start_tag';
|
||||
is $obj->end_tag({ name => 'test' }), '</test >', 'end_tag';
|
||||
|
||||
is "$obj", q{}, 'serialize overloading';
|
||||
@@ -0,0 +1,44 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More qw(no_plan);
|
||||
use Scalar::Util qw(blessed);
|
||||
use lib '../../../../../../lib';
|
||||
use_ok qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({});
|
||||
|
||||
ok $obj->set_xmlns('urn:SOAP-WSDL'), 'set_xmlns';
|
||||
is $obj->get_xmlns(), 'urn:SOAP-WSDL', 'get_xmlns';
|
||||
|
||||
ok blessed $obj, 'constructor returned blessed reference';
|
||||
|
||||
is $obj->start_tag({ name => 'test' }), '<test >', 'start_tag';
|
||||
is $obj->end_tag({ name => 'test' }), '</test >', 'end_tag';
|
||||
|
||||
ok $obj->set_value('test'), 'set_value';
|
||||
is $obj->get_value(), 'test', 'get_value';
|
||||
|
||||
is "$obj", q{test}, 'serialize overloading';
|
||||
|
||||
ok ($obj)
|
||||
? pass 'boolean overloading'
|
||||
: fail 'boolean overloading';
|
||||
|
||||
ok ! $obj->set_value(undef), 'set_value with explicit undef';
|
||||
is $obj->get_value(), undef, 'get_value';
|
||||
|
||||
is "$obj", q{}, 'stringification overloading';
|
||||
|
||||
ok $obj = SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({
|
||||
xmlns => 'urn:XSD',
|
||||
value => 'test2',
|
||||
});
|
||||
|
||||
is $obj->get_xmlns(), 'urn:XSD', 'get_xmlns on attr value';
|
||||
is $obj->get_value(), 'test2', 'get_value on attr value';
|
||||
|
||||
$obj->set_value(undef);
|
||||
|
||||
is $obj->serialize({ name => 'foo' }), '<foo ></foo >'
|
||||
, 'serialize undef value with name';
|
||||
is $obj->serialize(), q{}, 'serialize undef value without name'
|
||||
@@ -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') },
|
||||
#~ }
|
||||
File renamed without changes.
File renamed without changes.
@@ -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