Compare commits
1 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
312f3d6bbd |
12
Build.PL
12
Build.PL
@@ -2,30 +2,33 @@ use Module::Build;
|
||||
Module::Build->new(
|
||||
dist_abstract => 'SOAP with WSDL support',
|
||||
dist_name => 'SOAP-WSDL',
|
||||
dist_version => '2.00_07',
|
||||
dist_version => '2.00_08',
|
||||
module_name => 'SOAP::WSDL',
|
||||
license => 'artistic',
|
||||
requires => {
|
||||
'Class::Std' => q/v0.0.8/,
|
||||
'Class::Std::Storable' => 0,
|
||||
'SOAP::Lite' => 0,
|
||||
'Date::Parse' => 0,
|
||||
'Date::Format' => 0,
|
||||
'LWP::UserAgent' => 0,
|
||||
'List::Util' => 0,
|
||||
'File::Basename' => 0,
|
||||
'File::Path' => 0,
|
||||
'XML::XPath' => 0,
|
||||
'XML::LibXML' => 0,
|
||||
'XML::SAX::Base' => 0,
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
'XML::Parser::Expat' => 0,
|
||||
},
|
||||
buildrequires => {
|
||||
'Date::Parse' => 0,
|
||||
'Date::Format' => 0,
|
||||
'Benchmark' => 0,
|
||||
'Cwd' => 0,
|
||||
'Test::More' => 0,
|
||||
'SOAP::Lite' => 0,
|
||||
'Class::Std' => 0.0.8,
|
||||
'Class::Std::Storable' => 0,
|
||||
'List::Util' => 0,
|
||||
'LWP::UserAgent' => 0,
|
||||
'File::Basename' => 0,
|
||||
'File::Path' => 0,
|
||||
'XML::Simple' => 0,
|
||||
@@ -34,7 +37,6 @@ Module::Build->new(
|
||||
'XML::SAX::Base' => 0,
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
'Pod::Simple::Text' => 0,
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
},
|
||||
recursive_test_files => 1,
|
||||
)->create_build_script;
|
||||
|
||||
9
MANIFEST
9
MANIFEST
@@ -21,6 +21,7 @@ example/lib/MyInterfaces/GlobalWeather.pm
|
||||
example/lib/MyTypemaps/FullerData_x0020_Fortune_x0020_Cookie.pm
|
||||
example/lib/MyTypemaps/GlobalWeather.pm
|
||||
example/weather.pl
|
||||
example/weather_wsdl.pl
|
||||
example/wsdl/FortuneCookie.xml
|
||||
example/wsdl/genericbarcode.xml
|
||||
example/wsdl/globalweather.xml
|
||||
@@ -50,9 +51,9 @@ lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
|
||||
lib/SOAP/WSDL/SoapOperation.pm
|
||||
lib/SOAP/WSDL/TypeLookup.pm
|
||||
lib/SOAP/WSDL/Types.pm
|
||||
lib/SOAP/WSDL/XSD/Builtin.pm
|
||||
lib/SOAP/WSDL/XSD/ComplexType.pm
|
||||
lib/SOAP/WSDL/XSD/Element.pm
|
||||
lib/SOAP/WSDL/XSD/Primitive.pm
|
||||
lib/SOAP/WSDL/XSD/Schema.pm
|
||||
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
||||
lib/SOAP/WSDL/XSD/SimpleType.pm
|
||||
@@ -107,7 +108,7 @@ lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Element.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||
LICENSE
|
||||
MANIFEST
|
||||
MANIFEST This list of files
|
||||
META.yml
|
||||
README
|
||||
t/001_use.t
|
||||
@@ -126,6 +127,7 @@ t/014_sax_typelib.t
|
||||
t/015_to_typemap.t
|
||||
t/016_client_object.t
|
||||
t/017_generator.t
|
||||
t/018_generator.t
|
||||
t/020_storable.t
|
||||
t/098_pod.t
|
||||
t/acceptance/results/03_complexType-all.xml
|
||||
@@ -179,4 +181,7 @@ t/SOAP/WSDL/10_performance.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/XSD/Typelib/Builtin/002_time.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/003_date.t
|
||||
TODO
|
||||
|
||||
13
META.yml
13
META.yml
@@ -1,21 +1,22 @@
|
||||
---
|
||||
name: SOAP-WSDL
|
||||
version: 2.00_07
|
||||
version: 2.00_08
|
||||
author:
|
||||
abstract: SOAP with WSDL support
|
||||
license: artistic
|
||||
requires:
|
||||
Class::Std: v0.0.8
|
||||
Class::Std::Storable: 0
|
||||
Date::Format: 0
|
||||
Date::Parse: 0
|
||||
File::Basename: 0
|
||||
File::Path: 0
|
||||
LWP::UserAgent: 0
|
||||
List::Util: 0
|
||||
SOAP::Lite: 0
|
||||
XML::LibXML: 0
|
||||
XML::Parser::Expat: 0
|
||||
XML::SAX::Base: 0
|
||||
XML::SAX::ParserFactory: 0
|
||||
XML::XPath: 0
|
||||
generated_by: Module::Build version 0.2808
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
||||
@@ -23,7 +24,7 @@ meta-spec:
|
||||
provides:
|
||||
SOAP::WSDL:
|
||||
file: lib/SOAP/WSDL.pm
|
||||
version: 2.00_05
|
||||
version: 2.00_08
|
||||
SOAP::WSDL::Base:
|
||||
file: lib/SOAP/WSDL/Base.pm
|
||||
SOAP::WSDL::Binding:
|
||||
@@ -64,12 +65,12 @@ provides:
|
||||
file: lib/SOAP/WSDL/TypeLookup.pm
|
||||
SOAP::WSDL::Types:
|
||||
file: lib/SOAP/WSDL/Types.pm
|
||||
SOAP::WSDL::XSD::Builtin:
|
||||
file: lib/SOAP/WSDL/XSD/Builtin.pm
|
||||
SOAP::WSDL::XSD::ComplexType:
|
||||
file: lib/SOAP/WSDL/XSD/ComplexType.pm
|
||||
SOAP::WSDL::XSD::Element:
|
||||
file: lib/SOAP/WSDL/XSD/Element.pm
|
||||
SOAP::WSDL::XSD::Primitive:
|
||||
file: lib/SOAP/WSDL/XSD/Primitive.pm
|
||||
SOAP::WSDL::XSD::Schema:
|
||||
file: lib/SOAP/WSDL/XSD/Schema.pm
|
||||
SOAP::WSDL::XSD::Schema::Builtin:
|
||||
|
||||
11
TODO
11
TODO
@@ -1,14 +1,23 @@
|
||||
- support embedded atomic types by including a second (and third and fourth)
|
||||
package type_prefix::complex_type::element_name element package.
|
||||
Allow unlimited depth (though this is rather wicked).
|
||||
- fixup generated pod so it looks nice in SOAP::WSDL::Definitions.
|
||||
- remove benchmarks from tests. Create benchmark/ directory and store benchmarks in.
|
||||
- SOAP::WSDL::Definitions::create creates bad interface docs. Fix it.
|
||||
- add tests for SOAP::WSDL::Definitions::create
|
||||
- test for correct creation
|
||||
- test against web service (fullerdata.com?)
|
||||
- Improve docs
|
||||
- Partially DONE
|
||||
- Remove SOAP::Lite dependency - for now, just support HTTP(s) via LWP::UserAgent.
|
||||
- Partially DONE. SOAP::WSDL still uses SOAP::Schema
|
||||
- write inheritance Test for all XSD::Typelib::Builtin::* classes
|
||||
- Check & probably fix simpleType support.
|
||||
The WS at http://www.webservicex.net/genericbarcode.asmx?wsdl should make up a good example for simpleType
|
||||
definitions.
|
||||
- add default Fault11 typemap to generated typemaps
|
||||
- DONE
|
||||
- SOAP::WSDL::Definitions::create creates bad interface docs. Fix it.
|
||||
- DONE
|
||||
- update all Builtin Types to new constructor BEGIN block (Class::Std unfortunately is way slow)
|
||||
- DONE.
|
||||
- Remove useless (but on CPAN annoying) doc from Builtin::* classes
|
||||
|
||||
@@ -5,7 +5,7 @@ use Fcntl;
|
||||
use IO::File;
|
||||
use Pod::Usage;
|
||||
use Getopt::Long;
|
||||
use LWP::Simple qw(get);
|
||||
use LWP::UserAgent;
|
||||
use SOAP::WSDL::SAX::WSDLHandler;
|
||||
use XML::LibXML;
|
||||
|
||||
@@ -17,6 +17,7 @@ my %opt = (
|
||||
typemap_prefix => 'MyTypemaps::',
|
||||
interface_prefix => 'MyInterfaces::',
|
||||
base_path => 'lib/',
|
||||
proxy => undef
|
||||
);
|
||||
|
||||
GetOptions(\%opt,
|
||||
@@ -29,6 +30,7 @@ GetOptions(\%opt,
|
||||
base_path|b=s
|
||||
typemap_include|mi=s
|
||||
help|h
|
||||
proxy|x=s
|
||||
)
|
||||
);
|
||||
|
||||
@@ -40,7 +42,12 @@ pod2usage( -exit => 1 , verbose => 1 ) if not ($url);
|
||||
my $handler = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||
my $parser = XML::LibXML->new();
|
||||
|
||||
my $xml = get($url) or die "Could not load WSDL schema $url\n";
|
||||
local $ENV{HTTP_PROXY} = $opt{proxy} if $opt{proxy};
|
||||
my $lwp = LWP::UserAgent->new();
|
||||
my $response = $lwp->get($url);
|
||||
die $response->message(), "\n" if $response->code != 200;
|
||||
|
||||
my $xml = $response->content();
|
||||
|
||||
$parser->set_handler( $handler );
|
||||
$parser->parse_string( $xml );
|
||||
|
||||
@@ -13,7 +13,7 @@ use base qw(
|
||||
);
|
||||
|
||||
|
||||
sub get_xmlns { 'http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx' }
|
||||
sub get_xmlns { 'http://www.webserviceX.NET' }
|
||||
|
||||
__PACKAGE__->__set_name('string');
|
||||
__PACKAGE__->__set_nillable(true);
|
||||
|
||||
@@ -38,220 +38,29 @@ http://www.webservicex.net/globalweather.asmx
|
||||
my $GetCitiesByCountry = $interface->GetCitiesByCountry();
|
||||
|
||||
|
||||
=head1 Service GlobalWeather
|
||||
=head1 METHODS
|
||||
|
||||
=head2 Service information:
|
||||
=head2 GetWeather
|
||||
|
||||
Port name: GlobalWeatherSoap
|
||||
Binding: tns:GlobalWeatherSoap
|
||||
Location: http://www.webservicex.net/globalweather.asmx
|
||||
Get weather report for all major cities around the world.
|
||||
|
||||
=head2 SOAP Operations
|
||||
SYNOPSIS:
|
||||
|
||||
B<Note:>
|
||||
|
||||
Input, output and fault messages are stated as perl hash refs.
|
||||
|
||||
These are only for informational purposes - the actual implementation
|
||||
normally uses object trees, not hash refs, though the input messages
|
||||
may be passed to the respective methods as hash refs and will be
|
||||
converted to object trees automatically.
|
||||
|
||||
|
||||
=head3 GetWeather
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
$service->GetWeather({
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
});
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
=head2 GetCitiesByCountry
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
Get all major cities by country name(full / part).
|
||||
|
||||
SYNOPSIS:
|
||||
|
||||
$service->GetCitiesByCountry({
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
|
||||
=head3 GetCitiesByCountry
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
=head2 Service information:
|
||||
|
||||
Port name: GlobalWeatherHttpGet
|
||||
Binding: tns:GlobalWeatherHttpGet
|
||||
Location:
|
||||
|
||||
=head2 SOAP Operations
|
||||
|
||||
B<Note:>
|
||||
|
||||
Input, output and fault messages are stated as perl hash refs.
|
||||
|
||||
These are only for informational purposes - the actual implementation
|
||||
normally uses object trees, not hash refs, though the input messages
|
||||
may be passed to the respective methods as hash refs and will be
|
||||
converted to object trees automatically.
|
||||
|
||||
|
||||
=head3 GetWeather
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
|
||||
=head3 GetCitiesByCountry
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
=head2 Service information:
|
||||
|
||||
Port name: GlobalWeatherHttpPost
|
||||
Binding: tns:GlobalWeatherHttpPost
|
||||
Location:
|
||||
|
||||
=head2 SOAP Operations
|
||||
|
||||
B<Note:>
|
||||
|
||||
Input, output and fault messages are stated as perl hash refs.
|
||||
|
||||
These are only for informational purposes - the actual implementation
|
||||
normally uses object trees, not hash refs, though the input messages
|
||||
may be passed to the respective methods as hash refs and will be
|
||||
converted to object trees automatically.
|
||||
|
||||
|
||||
=head3 GetWeather
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
|
||||
=head3 GetCitiesByCountry
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
});
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -3,6 +3,14 @@ use strict;
|
||||
use warnings;
|
||||
|
||||
my %typemap = (
|
||||
# SOAP 1.1 fault typemap
|
||||
'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11',
|
||||
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::TOKEN',
|
||||
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
|
||||
# generated typemap
|
||||
'GetWeather' => 'MyElements::GetWeather',
|
||||
# atomic complex type (sequence)
|
||||
'GetWeather/CityName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
@@ -24,12 +32,9 @@ my %typemap = (
|
||||
'GetCitiesByCountryResponse/GetCitiesByCountryResult' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
|
||||
# end atomic complex type (sequence)
|
||||
Fault => 'SOAP::WSDL::SOAP::Typelib::Fault11',
|
||||
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
|
||||
|
||||
|
||||
|
||||
);
|
||||
|
||||
|
||||
@@ -1,19 +1,19 @@
|
||||
# Accessing the fortune cookie service at
|
||||
# Accessing the globalweather service at
|
||||
# www.webservicex.net/GlobalWeather/GlobalWeather.asmx
|
||||
#
|
||||
# Note that the GlobalWeather web service returns a (quoted) XML structure -
|
||||
# don't be surprised by the response's format.
|
||||
#
|
||||
# I have no connection to www.webservicex.net
|
||||
#
|
||||
# Use this script at your own risk.
|
||||
#
|
||||
# This script demonstrates the use of a interface generated by wsdl2perl.pl
|
||||
|
||||
use lib 'lib/';
|
||||
use MyInterfaces::GlobalWeather;
|
||||
my $webservice = MyInterfaces::GlobalWeather->new();
|
||||
my $weather = MyInterfaces::GlobalWeather->new();
|
||||
my $result = $weather->GetWeather({ CountryName => 'Germany', CityName => 'Munich' });
|
||||
|
||||
my $result = $webservice->GetWeather({ CountryName => 'Germany', CityName => 'Munich' });
|
||||
die $result->get_faultstring()->get_value() if not ($result); # boolean comparison overloaded
|
||||
|
||||
if ($result) {
|
||||
print $result->get_GetWeatherResult()->get_value(), "\n";
|
||||
}
|
||||
else {
|
||||
print $result;
|
||||
}
|
||||
print $result->get_GetWeatherResult()->get_value() "\n";
|
||||
|
||||
25
example/weather_wsdl.pl
Normal file
25
example/weather_wsdl.pl
Normal file
@@ -0,0 +1,25 @@
|
||||
# Accessing the globalweather service at
|
||||
# www.webservicex.net/GlobalWeather/GlobalWeather.asmx
|
||||
#
|
||||
# Note that the GlobalWeather web service returns a (quoted) XML structure -
|
||||
# don't be surprised by the response's format.
|
||||
#
|
||||
# I have no connection to www.webservicex.net
|
||||
# Use this script at your own risk.
|
||||
#
|
||||
# This script demonstrates the use of SOAP::WSDL in SOAP::Lite style.
|
||||
|
||||
use lib 'lib/';
|
||||
use lib '../lib';
|
||||
use SOAP::WSDL;
|
||||
use File::Basename qw(dirname);
|
||||
use File::Spec;
|
||||
my $path = File::Spec->rel2abs( dirname __FILE__);
|
||||
|
||||
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();
|
||||
|
||||
print $som->result();
|
||||
666
lib/SOAP/WSDL.pm
666
lib/SOAP/WSDL.pm
@@ -1,181 +1,188 @@
|
||||
package SOAP::WSDL;
|
||||
use strict;
|
||||
use warnings;
|
||||
use vars qw/$AUTOLOAD/;
|
||||
use vars qw($AUTOLOAD);
|
||||
use Carp;
|
||||
use Scalar::Util qw(blessed);
|
||||
use SOAP::WSDL::Client;
|
||||
use SOAP::WSDL::Envelope;
|
||||
use SOAP::WSDL::SAX::WSDLHandler;
|
||||
use base qw(SOAP::Lite);
|
||||
use Class::Std;
|
||||
use XML::LibXML;
|
||||
|
||||
use Data::Dumper;
|
||||
use LWP::UserAgent;
|
||||
our $VERSION='2.00_08';
|
||||
|
||||
our $VERSION='2.00_05';
|
||||
|
||||
BEGIN {
|
||||
eval {
|
||||
use XML::LibXML;
|
||||
};
|
||||
if ($@) {
|
||||
use XML::SAX::ParserFactory;
|
||||
}
|
||||
}
|
||||
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 %outputtree_of :ATTR(:name<outputtree>);
|
||||
my %outputhash_of :ATTR(:name<outputhash>);
|
||||
my %servicename_of :ATTR(:name<servicename>);
|
||||
my %portname_of :ATTR(:name<portname>);
|
||||
my %class_resolver_of :ATTR(:name<class_resolver>);
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
|
||||
die "$method not found";
|
||||
my %method_info_of :ATTR(:default<()>);
|
||||
my %port_of :ATTR(:default<()>);
|
||||
my %porttype_of :ATTR(:default<()>);
|
||||
my %binding_of :ATTR(:default<()>);
|
||||
my %service_of :ATTR(:default<()>);
|
||||
my %definitions_of :ATTR(:get<definitions> :default<()>);
|
||||
my %serialize_options_of :ATTR(:default<()>);
|
||||
my %explain_options_of :ATTR(:default<()>);
|
||||
|
||||
my %client_of :ATTR(:name<client> :default<()>);
|
||||
|
||||
my %LOOKUP = (
|
||||
no_dispatch => \%no_dispatch_of,
|
||||
class_resolver => \%class_resolver_of,
|
||||
wsdl => \%wsdl_of,
|
||||
proxy => \%proxy_of,
|
||||
readable => \%readable_of,
|
||||
autotype => \%autotype_of,
|
||||
outputxml => \%outputxml_of,
|
||||
outputtree => \%outputtree_of,
|
||||
outputhash => \%outputhash_of,
|
||||
portname => \%portname_of,
|
||||
servicename => \%servicename_of,
|
||||
);
|
||||
|
||||
for my $method (keys %LOOKUP ) {
|
||||
no strict qw(refs);
|
||||
*{ $method } = sub {
|
||||
my $self = shift;
|
||||
my $ident = ident $self;
|
||||
if (@_) {
|
||||
$LOOKUP{ $method }->{ $ident } = shift;
|
||||
return $self;
|
||||
}
|
||||
return $LOOKUP{ $method }->{ $ident };
|
||||
};
|
||||
}
|
||||
|
||||
sub outputtree {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ outputtree } if not @_;
|
||||
return $self->{ _WSDL }->{ outputtree } = shift;
|
||||
}
|
||||
|
||||
sub class_resolver {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ class_resolver } if not @_;
|
||||
return $self->{ _WSDL }->{ class_resolver } = shift;
|
||||
}
|
||||
|
||||
{
|
||||
no warnings qw(redefine);
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my %args_from = @_;
|
||||
my $self = \do { my $foo = undef };
|
||||
bless $self, $class;
|
||||
|
||||
for (keys %args_from) {
|
||||
my $method = $self->can("set_$_")
|
||||
or croak "unknown parameter $_ passed to new";
|
||||
$method->($self, $args_from{$_});
|
||||
}
|
||||
my $ident = ident $self;
|
||||
$self->wsdlinit() if ($wsdl_of{ $ident });
|
||||
|
||||
$client_of{ $ident } = SOAP::WSDL::Client->new();
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub wsdlinit {
|
||||
my $self = shift;
|
||||
my $self = shift;
|
||||
my $ident = ident $self;
|
||||
my %opt = @_;
|
||||
|
||||
my $wsdl_xml = SOAP::Schema->new( schema_url => $self->wsdl() )->access(
|
||||
$self->wsdl()
|
||||
);
|
||||
|
||||
my $filter;
|
||||
my $parser = eval { XML::LibXML->new() };
|
||||
if ($parser) {
|
||||
$filter = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||
$parser->set_handler( $filter );
|
||||
}
|
||||
else {
|
||||
$filter = SOAP::WSDL::SAX::WSDLHandler->new( base => 'XML::SAX::Base' );
|
||||
$parser = XML::SAX::ParserFactory->parser( Handler => $filter );
|
||||
}
|
||||
|
||||
$parser->parse_string( $wsdl_xml );
|
||||
|
||||
my $wsdl_definitions = $filter->get_data()
|
||||
or die "unable to parse WSDL";
|
||||
|
||||
|
||||
my $lwp = LWP::UserAgent->new();
|
||||
my $response = $lwp->get( $wsdl_of{ $ident } );
|
||||
croak $response->message() if ($response->code != 200);
|
||||
|
||||
# TODO: Port parser to expat and remove XML::LibXML dependency
|
||||
my $parser = XML::LibXML->new();
|
||||
my $filter = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||
$parser->set_handler( $filter );
|
||||
$parser->parse_string( $response->content() );
|
||||
|
||||
# sanity checks
|
||||
my $wsdl_definitions = $filter->get_data() or die "unable to parse WSDL";
|
||||
my $types = $wsdl_definitions->first_types()
|
||||
or die "unable to extract schema from WSDL";
|
||||
|
||||
my $ns = $wsdl_definitions->get_xmlns()
|
||||
or die "unable to extract XML Namespaces" . $wsdl_definitions->to_string;
|
||||
( %{ $ns } ) or die "unable to extract XML Namespaces";
|
||||
|
||||
# setup lookup variables
|
||||
$self->{ _WSDL }->{ wsdl_definitions } = $wsdl_definitions;
|
||||
$self->{ _WSDL }->{ serialize_options } = {
|
||||
$definitions_of{ $ident } = $wsdl_definitions;
|
||||
$serialize_options_of{ $ident } = {
|
||||
autotype => 0,
|
||||
readable => $self->readable(),
|
||||
typelib => $types,
|
||||
namespace => $ns,
|
||||
};
|
||||
$self->{ _WSDL }->{ explain_options } = {
|
||||
$explain_options_of{ $ident } = {
|
||||
readable => $self->readable(),
|
||||
wsdl => $wsdl_definitions,
|
||||
namespace => $ns,
|
||||
typelib => $types,
|
||||
};
|
||||
|
||||
$self->servicename($opt{servicename}) if $opt{servicename};
|
||||
$self->portname($opt{portname}) if $opt{portname};
|
||||
$servicename_of{ $ident } = $opt{servicename} if $opt{servicename};
|
||||
$portname_of{ $ident } = $opt{portname} if $opt{portname};
|
||||
return $self;
|
||||
} ## end sub wsdlinit
|
||||
|
||||
sub _wsdl_get_service {
|
||||
my $self = shift;
|
||||
my $service;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
if ( $self->{ _WSDL }->{ servicename } )
|
||||
{
|
||||
$service =
|
||||
$wsdl->find_service( $ns, $self->{ _WSDL }->{ servicename } );
|
||||
}
|
||||
else
|
||||
{
|
||||
$service = $wsdl->get_service()->[ 0 ];
|
||||
warn "no servicename specified - using " . $service->get_name();
|
||||
}
|
||||
return $self->{ _WSDL }->{ service } = $service;
|
||||
sub _wsdl_get_service :PRIVATE {
|
||||
my $ident = ident shift;
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
return $service_of{ $ident } = $servicename_of{ $ident }
|
||||
? $wsdl->find_service( $wsdl->get_targetNamespace() , $servicename_of{ $ident } )
|
||||
: $service_of{ $ident } = $wsdl->get_service()->[ 0 ];
|
||||
} ## end sub _wsdl_get_service
|
||||
|
||||
sub _wsdl_get_port {
|
||||
my $self = shift;
|
||||
my $service = $self->{ _WSDL }->{ service }
|
||||
|| $self->_wsdl_get_service();
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
my $port;
|
||||
if ( $self->{ _WSDL }->{ portname } )
|
||||
{
|
||||
$port = $service->get_port( $ns, $self->{ _WSDL }->{ portname } );
|
||||
}
|
||||
else
|
||||
{
|
||||
$port = $service->get_port()->[ 0 ];
|
||||
}
|
||||
$self->{ _WSDL }->{ port } = $port;
|
||||
|
||||
# preload portType
|
||||
$self->_wsdl_get_portType();
|
||||
|
||||
# Auto-set proxy - required before issuing call()
|
||||
$self->proxy( $port->get_location() );
|
||||
|
||||
return $port;
|
||||
sub _wsdl_get_port :PRIVATE {
|
||||
my $ident = ident shift;
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
return $port_of{ $ident } = $portname_of{ $ident }
|
||||
? $service_of{ $ident }->get_port( $ns, $portname_of{ $ident } )
|
||||
: $port_of{ $ident } = $service_of{ $ident }->get_port()->[ 0 ];
|
||||
} ## end sub _wsdl_get_port
|
||||
|
||||
sub _wsdl_get_binding {
|
||||
my $self = shift;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
my $port = $self->{ _WSDL }->{ port }
|
||||
|| $self->_wsdl_get_port();
|
||||
|
||||
my ( $prefix, $localname ) = split /:/, $port->get_binding();
|
||||
|
||||
# TODO lookup $ns instead of just using
|
||||
# the top element's targetns...
|
||||
my $binding = $wsdl->find_binding( $ns, $localname )
|
||||
sub _wsdl_get_binding :PRIVATE {
|
||||
my $self = shift;
|
||||
my $ident = ident $self;
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
my $port = $port_of{ $ident } || $self->_wsdl_get_port();
|
||||
$binding_of{ $ident } = $wsdl->find_binding( $wsdl->_expand( $port->get_binding() ) )
|
||||
or die "no binding found for ", $port->get_binding();
|
||||
return $self->{ _WSDL }->{ binding } = $binding;
|
||||
return $binding_of{ $ident };
|
||||
} ## end sub _wsdl_get_binding
|
||||
|
||||
sub _wsdl_get_portType {
|
||||
sub _wsdl_get_portType :PRIVATE {
|
||||
my $self = shift;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $binding = $self->{ _WSDL }->{ binding }
|
||||
|| $self->_wsdl_get_binding();
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
my ( $prefix, $localname ) = split /:/, $binding->get_type();
|
||||
my $portType = $wsdl->find_portType( $ns, $localname );
|
||||
$self->{ _WSDL }->{ portType } = $portType;
|
||||
return $portType;
|
||||
my $ident = ident $self;
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
my $binding = $binding_of{ $ident } || $self->_wsdl_get_binding();
|
||||
$porttype_of{ $ident } = $wsdl->find_portType( $wsdl->_expand( $binding->get_type() ) )
|
||||
or die "cannot find portType for " . $binding->get_type();
|
||||
return $porttype_of{ $ident };
|
||||
} ## end sub _wsdl_get_portType
|
||||
|
||||
|
||||
sub _wsdl_init_methods {
|
||||
my $self = shift;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
sub _wsdl_init_methods :PRIVATE {
|
||||
my $self = shift;
|
||||
my $ident = ident $self;
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
|
||||
# get bindings, portType, message, part(s)
|
||||
# - use cached values where possible for speed,
|
||||
# private methods if not for clear separation...
|
||||
my $binding = $self->{ _WSDL }->{ binding }
|
||||
|| $self->_wsdl_get_binding()
|
||||
$self->_wsdl_get_service if not ($service_of{ $ident });
|
||||
my $binding = $binding_of{ $ident } || $self->_wsdl_get_binding()
|
||||
|| die "Can't find binding";
|
||||
my $portType = $self->{ _WSDL }->{ portType }
|
||||
|| $self->_wsdl_get_portType()
|
||||
|| die "Can't find portType";
|
||||
my $portType = $porttype_of{ $ident } || $self->_wsdl_get_portType();
|
||||
|
||||
my $methodHashRef = {};
|
||||
$method_info_of{ $ident } = {};
|
||||
|
||||
foreach my $binding_operation (@{ $binding->get_operation() })
|
||||
{
|
||||
@@ -211,201 +218,60 @@ sub _wsdl_init_methods {
|
||||
}
|
||||
: undef;
|
||||
|
||||
$methodHashRef->{ $binding_operation->get_name() } = $method;
|
||||
$method_info_of{ $ident }->{ $binding_operation->get_name() } = $method;
|
||||
}
|
||||
|
||||
$self->{ _WSDL }->{ methodInfo } = $methodHashRef;
|
||||
|
||||
return $methodHashRef;
|
||||
|
||||
return $method_info_of{ $ident };
|
||||
}
|
||||
|
||||
|
||||
sub call {
|
||||
my $self = shift;
|
||||
my $self = shift;
|
||||
my $ident = ident $self;
|
||||
my $method = shift;
|
||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
||||
|
||||
my $content = q{};
|
||||
my $envelope;
|
||||
my $methodInfo;
|
||||
|
||||
if (blessed $data
|
||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
||||
{
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
||||
|
||||
# TODO replace by something derived from binding - this is just a
|
||||
# workaround...
|
||||
$methodInfo->{ soap_action }
|
||||
= join '/', $data->get_xmlns(), $method;
|
||||
}
|
||||
else {
|
||||
my $methodLookup = $self->{ _WSDL }->{ methodInfo }
|
||||
|| $self->_wsdl_init_methods();
|
||||
|
||||
$methodInfo = $methodLookup->{ $method };
|
||||
my $partListRef = $methodInfo->{ parts };
|
||||
|
||||
# set serializer options
|
||||
# TODO allow custom options here
|
||||
my $opt = $self->{ _WSDL }->{ serialize_options };
|
||||
|
||||
# set response target namespace
|
||||
# TODO make rpc-encoded encoding recognise this namespace
|
||||
# $opt->{ targetNamespace } = $soap_binding_operation ?
|
||||
# $operation->input()->namespace() : undef;
|
||||
|
||||
# serialize content
|
||||
# TODO create surrounding element for rpc-encoded messages
|
||||
foreach my $part ( @{ $partListRef } ) {
|
||||
$content .= $part->serialize( $method, $data, $opt );
|
||||
}
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $content , $opt );
|
||||
};
|
||||
|
||||
|
||||
if ( $self->no_dispatch() ) {
|
||||
return $envelope;
|
||||
} ## end if ( $self->no_dispatch...
|
||||
|
||||
# get response via transport layer
|
||||
# TODO remove dependency from SOAP::Lite and use a
|
||||
# SAX-based filter using XML::LibXML to get the
|
||||
# result.
|
||||
# Filter should have the following methods:
|
||||
# - result: returns the result of the call (like SOAP::Lite, but as
|
||||
# perl data structure)
|
||||
# - header: returns the content of the SOAP header
|
||||
# - fault: returns the result of the call if a SOAP fault is sent back
|
||||
# by the server. Retuns undef (nothing) if the call has been
|
||||
# processed without errors.
|
||||
my $response = $self->transport->send_receive(
|
||||
context => $self, # this is provided for context
|
||||
endpoint => $self->endpoint(),
|
||||
action => $methodInfo->{ soap_action }, # SOAPAction from binding
|
||||
envelope => $envelope, # use custom content
|
||||
);
|
||||
|
||||
return $response if ($self->outputxml() );
|
||||
|
||||
if ($self->outputtree()) {
|
||||
|
||||
my ($parser, $handler); # replace by globals - singleton is faster
|
||||
if (not $parser) {
|
||||
require SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
require SOAP::WSDL::SAX::MessageHandler;
|
||||
require XML::LibXML;
|
||||
$handler = SOAP::WSDL::SAX::MessageHandler->new(
|
||||
{ class_resolver => $self->class_resolver() },
|
||||
);
|
||||
$parser = XML::LibXML->new();
|
||||
$parser->set_handler( $handler);
|
||||
}
|
||||
|
||||
# if we had no success (Transport layer error status code)
|
||||
# or if transport layer failed
|
||||
if (! $self->transport->is_success() ) {
|
||||
# Try deserializing response - there may be some
|
||||
if ($response) {
|
||||
eval { $parser->parse_string( $response ) };
|
||||
return $handler->get_data if not $@;
|
||||
};
|
||||
|
||||
# generate & return fault if we cannot serialize response
|
||||
# or have none...
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => 'Error sending / receiving message: '
|
||||
. $self->transport->message()
|
||||
});
|
||||
}
|
||||
|
||||
eval { $parser->parse_string( $response ) };
|
||||
|
||||
# return fault if we cannot deserialize response
|
||||
if ($@) {
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => "Error deserializing message: $@. \n"
|
||||
. "Message was: \n$response"
|
||||
});
|
||||
}
|
||||
|
||||
return $handler->get_data();
|
||||
}
|
||||
|
||||
# deserialize and store result
|
||||
my $result = $self->{ '_call' } =
|
||||
eval { $self->deserializer->deserialize( $response ) }
|
||||
if $response;
|
||||
|
||||
if (
|
||||
!$self->transport->is_success || # transport fault
|
||||
$@ || # not deserializible
|
||||
# fault message even if transport OK
|
||||
# or no transport error (for example, fo TCP, POP3, IO implementations)
|
||||
UNIVERSAL::isa( $result => 'SOAP::SOM' ) && $result->fault
|
||||
) {
|
||||
return $self->{ '_call' } = (
|
||||
$self->on_fault->( $self, ($@)
|
||||
? $@ . ( $response || '' )
|
||||
: $result
|
||||
) || $result
|
||||
);
|
||||
} ## end if ( !$self->transport...
|
||||
|
||||
return unless $response; # nothing to do for one-ways
|
||||
return $result;
|
||||
} ## end sub call
|
||||
|
||||
$self->wsdlinit() if not ($definitions_of{ $ident });
|
||||
$self->_wsdl_init_methods() if not ($method_info_of{ $ident });
|
||||
|
||||
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 );
|
||||
|
||||
my $response = (blessed $data)
|
||||
? $client->call( $method, $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] } );
|
||||
$content .= $part->serialize( $method, $data,
|
||||
{
|
||||
%{ $serialize_options_of{ $ident } },
|
||||
readable => $readable_of{ $ident },
|
||||
} );
|
||||
}
|
||||
$client->call($method, $content);
|
||||
};
|
||||
|
||||
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 );
|
||||
}
|
||||
|
||||
sub explain {
|
||||
my $self = shift;
|
||||
my $opt = $self->{ _WSDL }->{ explain_options };
|
||||
|
||||
return $self->{ _WSDL }->{ wsdl_definitions }->explain( $opt );
|
||||
} ## end sub explain
|
||||
|
||||
sub _load_method {
|
||||
my $method = shift;
|
||||
no strict "refs";
|
||||
*$method = sub {
|
||||
my $self = shift;
|
||||
return ( @_ ) ? $self->{ _WSDL }->{ $method } = shift
|
||||
: $self->{ _WSDL }->{ $method }
|
||||
};
|
||||
} ## end sub _load_method
|
||||
|
||||
&_load_method( 'no_dispatch' );
|
||||
&_load_method( 'wsdl' );
|
||||
|
||||
sub servicename {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ servicename } if ( not @_ );
|
||||
$self->{ _WSDL }->{ servicename } = shift;
|
||||
|
||||
my $ns = $self->{ _WSDL }->{ wsdl_definitions }->get_targetNamespace();
|
||||
|
||||
$self->{ _WSDL }->{ service } =
|
||||
$self->{ _WSDL }->{ wsdl_definitions }
|
||||
->find_service( $ns, $self->{ _WSDL }->{ servicename } )
|
||||
or die "No such service: " . $self->{ _WSDL }->{ servicename };
|
||||
return $self;
|
||||
} ## end sub servicename
|
||||
|
||||
sub portname {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ portname } if ( not @_ );
|
||||
$self->{ _WSDL }->{ portname } = shift;
|
||||
|
||||
my $ns = $self->{ _WSDL }->{ wsdl_definitions }->get_targetNamespace();
|
||||
|
||||
$self->{ _WSDL }->{ port } =
|
||||
$self->{ _WSDL }->{ service }
|
||||
->find_port( $ns, $self->{ _WSDL }->{ portname } )
|
||||
or die "No such port: " . $self->{ _WSDL }->{ portname };
|
||||
return $self;
|
||||
} ## end sub portname
|
||||
my $ident = ident shift;
|
||||
my $opt = $explain_options_of{ $ident };
|
||||
return $definitions_of{ $ident }->explain( $opt );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
@@ -416,32 +282,53 @@ __END__
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL - SOAP with WSDL support
|
||||
|
||||
=head1 Overview
|
||||
|
||||
For creating Perl classes instrumenting a web service with a WSDL definition,
|
||||
read L<SOAP::WSDL::Manual>.
|
||||
|
||||
For using an interpreting (thus slow and somewhat troublesome) WSDL based
|
||||
SOAP client, which mimics L<SOAP::Lite|SOAP::Lite>'s API, read on.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file://bla.wsdl',
|
||||
readable => 1,
|
||||
)->wsdlinit();
|
||||
);
|
||||
|
||||
my $result = $soap->call('MyMethod', %data);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL provides easy access to Web Services with WSDL descriptions.
|
||||
|
||||
SOAP::WSDL provides easy access to Web Services with WSDL descriptions.
|
||||
|
||||
The WSDL is parsed and stored in memory.
|
||||
|
||||
Your data is serialized according to the rules in the WSDL and sent via
|
||||
SOAP::Lite's transport mechanism.
|
||||
Your data is serialized according to the rules in the WSDL.
|
||||
|
||||
The only transport mechanisms currently supported are http and https.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 new
|
||||
|
||||
Constructor. All parameters passed are passed to the corresponding methods.
|
||||
|
||||
=head2 call
|
||||
|
||||
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).
|
||||
|
||||
my $result = $soap->call('method', %data);
|
||||
|
||||
=head2 wsdlinit
|
||||
|
||||
Reads the WSDL file and initializes SOAP::WSDL for working with it.
|
||||
|
||||
Must be called after the wsdl URL has been set, and before calling one of
|
||||
Is called automatically from call() if not called directly before.
|
||||
|
||||
servicename
|
||||
portname
|
||||
@@ -455,14 +342,6 @@ wsdlinit:
|
||||
portname => 'MyPort'
|
||||
);
|
||||
|
||||
=head2 call
|
||||
|
||||
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).
|
||||
|
||||
my $result = $soap->call('method', %data);
|
||||
|
||||
=head1 CONFIGURATION METHODS
|
||||
|
||||
=head2 outputtree
|
||||
@@ -515,8 +394,6 @@ SOAP::WSDL::XSD::ComplexType on how to build / generate one.
|
||||
Sets the service to operate on. If no service is set via servicename, the
|
||||
first service found is used.
|
||||
|
||||
Must be called after calling wsdlinit().
|
||||
|
||||
Returns the soap object, so you can chain calls like
|
||||
|
||||
$soap->servicename->('Name')->portname('Port');
|
||||
@@ -528,8 +405,6 @@ Returns the soap object, so you can chain calls like
|
||||
Sets the port to operate on. If no port is set via portname, the
|
||||
first port found is used.
|
||||
|
||||
Must be called after calling wsdlinit().
|
||||
|
||||
Returns the soap object, so you can chain calls like
|
||||
|
||||
$soap->portname('Port')->call('MyMethod', %data);
|
||||
@@ -539,12 +414,25 @@ Returns the soap object, so you can chain calls like
|
||||
When set, call() returns the plain request XML instead of dispatching the
|
||||
SOAP call to the SOAP service. Handy for testing/debugging.
|
||||
|
||||
=head2 _wsdl_init_methods
|
||||
|
||||
Creates a lookup table containing the information required for all methods
|
||||
specified for the service/port selected.
|
||||
|
||||
The lookup table is used by L<call|call>.
|
||||
=head1 ACCESS TO SOAP::WSDL's internals
|
||||
|
||||
=head2 get_client / set_client
|
||||
|
||||
Returns the SOAP client implementation used (normally a SOAP::WSDL::Client
|
||||
object).
|
||||
|
||||
Useful for enabling tracing:
|
||||
|
||||
# enable tracing via 'warn'
|
||||
$soap->get_client->set_trace(1);
|
||||
|
||||
# enable tracing via a custom facility -
|
||||
# Log::Log4perl in this case...
|
||||
$soap->get_client->set_trace(sub { Log::Log4perl->get_logger->info(@_) } );
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
See the examples/ directory.
|
||||
|
||||
=head1 Differences to previous versions
|
||||
|
||||
@@ -560,7 +448,8 @@ it's content.
|
||||
The object tree has two main functions: It knows how to serialize data passed
|
||||
as hash ref, and how to render the WSDL elements found into perl classes.
|
||||
|
||||
Yup your're right, there's a builting code generation facility.
|
||||
Yup your're right, there's a builting code generation facility. Read
|
||||
L<SOAP::WSDL::Manual> for using it.
|
||||
|
||||
=item * no_dispatch
|
||||
|
||||
@@ -581,33 +470,80 @@ You may pass the servicename and portname as attributes to wsdlinit, though.
|
||||
=back
|
||||
|
||||
=head1 Differences to SOAP::Lite
|
||||
|
||||
=head3 Output formats
|
||||
|
||||
In contrast to SOAP::Lite, SOAP::WSDL supports the following output formats:
|
||||
|
||||
=over
|
||||
|
||||
=item * SOAP::SOM objects.
|
||||
|
||||
This is the default. SOAP::Lite is required for outputting SOAP::SOM objects.
|
||||
|
||||
=item * Object trees.
|
||||
|
||||
This is the recommended output format.
|
||||
You need a class resolver (typemap) for outputting object trees.
|
||||
See L<class_resolver|class_resolver> above.
|
||||
|
||||
=item * Hash refs
|
||||
|
||||
This is for convnience: A single hash ref containing the content of the
|
||||
SOAP body.
|
||||
|
||||
=item * xml
|
||||
|
||||
See below.
|
||||
|
||||
=back
|
||||
|
||||
=head3 outputxml
|
||||
|
||||
=head2 Auto-Dispatching
|
||||
SOAP::Lite returns only the content of the SOAP body when outputxml is set
|
||||
to true. SOAP::WSDL returns the complete XML response.
|
||||
|
||||
=head3 Auto-Dispatching
|
||||
|
||||
SOAP::WSDL does B<does not> support auto-dispatching.
|
||||
|
||||
This is on purpose: You may easily create interface classes by using
|
||||
SOAP::WSDL and implementing something like
|
||||
SOAP::WSDL::Client and implementing something like
|
||||
|
||||
sub mySoapMethod {
|
||||
my $self = shift;
|
||||
$soap_wsdl_client->call( mySoapMethod, @_);
|
||||
}
|
||||
|
||||
You may even do this in a class factory - SOAP::WSDL provides the methods
|
||||
for generating such interfaces.
|
||||
|
||||
SOAP::Lite's autodispatching mechanism is - though convenient - a constant
|
||||
source of errors: Every typo in a method name gets caught by AUTOLOAD and
|
||||
may lead to unpredictable results.
|
||||
You may even do this in a class factory - see L<wsdl2perl.pl> for creating
|
||||
such interfaces.
|
||||
|
||||
=head3 Debugging / Tracing
|
||||
|
||||
While SOAP::Lite features a global tracing facility, SOAP::WSDL
|
||||
allows to switch tracing on/of on a per-object base.
|
||||
|
||||
This has to be done in the SOAP client used by SOAP::WSDL - see
|
||||
L<get_client|get_client> for an example and L<SOAP::WSDL::Client> for
|
||||
details.
|
||||
|
||||
=head1 Bugs and Limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * readable
|
||||
|
||||
readable() must be called before calling wsdlinit. This is a bug.
|
||||
|
||||
=item * SOAP Headers are not supported
|
||||
|
||||
There's no way to use SOAP Headers with SOAP::WSDL yet.
|
||||
|
||||
=item * Apache SOAP datatypes are not supported
|
||||
|
||||
You currently can't use SOAP::WSDL with Apache SOAP datatypes like map.
|
||||
|
||||
If you want this changed, email me a copy of the specs, please.
|
||||
|
||||
=item * outputhash
|
||||
|
||||
outputhash is not implemented yet.
|
||||
|
||||
=item * Unsupported XML Schema definitions
|
||||
|
||||
@@ -619,7 +555,7 @@ The following XML Schema definitions are not supported:
|
||||
simpleContent
|
||||
complexContent
|
||||
|
||||
=item * Serialization of hash refs dos not work for ambiguous values
|
||||
=item * Serialization of hash refs dos not work for ambiguos values
|
||||
|
||||
If you have list elements with multiple occurences allowed, SOAP::WSDL
|
||||
has no means of finding out which variant you meant.
|
||||
@@ -629,11 +565,11 @@ Passing in item => [1,2,3] could serialize to
|
||||
<item>1 2</item><item>3</item>
|
||||
<item>1</item><item>2 3</item>
|
||||
|
||||
Ambiguos data can be avoided by passing an object tree as data.
|
||||
Ambiguos data can be avoided by passing an objects as data.
|
||||
|
||||
=item * XML Schema facets
|
||||
|
||||
Almost all XML schema facets are not yet implemented. The only facets
|
||||
Almost no XML schema facets are implemented yet. The only facets
|
||||
currently implemented are:
|
||||
|
||||
fixed
|
||||
@@ -651,7 +587,25 @@ The following facets have no influence yet:
|
||||
enumeration
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 ACKNOWLEDGMENTS
|
||||
|
||||
There are many people out there who fostered SOAP::WSDL's developement.
|
||||
I would like to thank them all (and apologize to all those I have forgotten).
|
||||
|
||||
Giovanni S. Fois wrote a improved version of SOAP::WSDL (which eventually became v1.23)
|
||||
|
||||
Damian A. Martinez Gelabert, Dennis S. Hennen, Dan Horne, Peter Orvos, Marc Overmeer,
|
||||
Jon Robens, Isidro Vila Verde and Glenn Wood spotted bugs and/or
|
||||
suggested improvements in the 1.2x releases.
|
||||
|
||||
Andreas 'ACID' Specht constantly asked for better performance.
|
||||
|
||||
Numerous people sent me their real-world WSDL files for testing. Thank you.
|
||||
|
||||
Paul Kulchenko and Byrne Reese wrote and maintained SOAP::Lite and thus provided a
|
||||
base (and counterpart) for SOAP::WSDL.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
@@ -661,7 +615,7 @@ the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
@@ -6,7 +6,8 @@ use Class::Std::Storable;
|
||||
use List::Util qw(first);
|
||||
|
||||
my %id_of :ATTR(:name<id> :default<()>);
|
||||
my %name_of :ATTR(:name<name> :default<()>);
|
||||
my %name_of :ATTR(:name<name> :default<()>);
|
||||
my %documentation_of :ATTR(:name<documentation> :default<()>);
|
||||
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
|
||||
my %xmlns_of :ATTR(:name<xmlns> :default<{}>);
|
||||
my %parent_of :ATTR(:name<parent> :default<()>);
|
||||
|
||||
@@ -2,26 +2,45 @@ package SOAP::WSDL::Client;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Scalar::Util qw(blessed);
|
||||
use SOAP::WSDL::Envelope;
|
||||
use SOAP::Lite;
|
||||
|
||||
use Class::Std::Storable;
|
||||
use LWP::UserAgent;
|
||||
use HTTP::Request;
|
||||
use Scalar::Util qw(blessed);
|
||||
|
||||
use SOAP::WSDL::Envelope;
|
||||
use SOAP::WSDL::Expat::MessageParser;
|
||||
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
|
||||
# Package globals for speed...
|
||||
my $PARSER;
|
||||
my $MESSAGE_HANDLER;
|
||||
|
||||
|
||||
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
|
||||
my %no_dispatch_of :ATTR(:name<no_dispatch> :default<()>);
|
||||
my %outputxml_of :ATTR(:name<outputxml> :default<()>);
|
||||
my %proxy_of :ATTR(:name<proxy> :default<()>);
|
||||
|
||||
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
|
||||
|
||||
# TODO remove when preparing 2.01
|
||||
sub outputtree { warn 'outputtree is deprecated and'
|
||||
. 'will be removed before reaching v2.01 !' }
|
||||
|
||||
|
||||
sub get_trace {
|
||||
my $ident = ident $_[0];
|
||||
return $trace_of{ $ident }
|
||||
? ref $trace_of{ $ident } eq 'CODE'
|
||||
? $trace_of{ $ident }
|
||||
: sub { warn @_ }
|
||||
: ()
|
||||
}
|
||||
|
||||
# Mimic SOAP::Lite's behaviour for getter/setter routines
|
||||
SUBFACTORY: {
|
||||
no strict qw(refs);
|
||||
for (qw(class_resolver no_dispatch outputxml proxy)) {
|
||||
@@ -43,83 +62,84 @@ BEGIN {
|
||||
|
||||
sub call {
|
||||
my $self = shift;
|
||||
my $method = shift;
|
||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
||||
my $content = q{};
|
||||
my ($envelope, $soap_action);
|
||||
my $method = shift;
|
||||
my $ident = ident $self;
|
||||
my $data = ref $_[0]
|
||||
? $_[0]
|
||||
: (@_>1)
|
||||
? { @_ }
|
||||
: $_[0];
|
||||
|
||||
my $soap_action;
|
||||
my $trace_sub = $self->get_trace();
|
||||
my $envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
||||
|
||||
if (blessed $data
|
||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
||||
{
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
||||
# TODO replace by something derived from binding - this is just a
|
||||
# workaround...
|
||||
$soap_action = join '/', $data->get_xmlns(), $method;
|
||||
}
|
||||
else {
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
||||
# $soap_action = $self->on_action( $method );
|
||||
}
|
||||
|
||||
# TODO add something like SOAP::Lite's on_action mechanism
|
||||
$soap_action = $on_action_of{$ident}->( $self, $method ) if ($on_action_of{$ident});
|
||||
}
|
||||
|
||||
return $envelope if $self->no_dispatch();
|
||||
|
||||
# warn $envelope;
|
||||
|
||||
# get response via transport layer
|
||||
# TODO remove dependency from SOAP::Lite and use a
|
||||
# SAX-based filter using XML::LibXML to get the
|
||||
# result.
|
||||
# Filter should have the following methods:
|
||||
# maybe we should return a result with the following methods:
|
||||
# - result: returns the result of the call (like SOAP::Lite, but as
|
||||
# perl data structure)
|
||||
# object tree)
|
||||
# - header: returns the content of the SOAP header
|
||||
# - fault: returns the result of the call if a SOAP fault is sent back
|
||||
# by the server. Retuns undef (nothing) if the call has been
|
||||
# processed without errors.
|
||||
my $soap = SOAP::Lite->new()->proxy( $self->get_proxy() );
|
||||
my $response = $soap->transport->send_receive(
|
||||
context => $self, # this is provided for context
|
||||
endpoint => $soap->endpoint(),
|
||||
action => $soap_action, # SOAPAction, should be from binding
|
||||
envelope => $envelope, # use custom content
|
||||
);
|
||||
|
||||
# warn 'Received ' . length($response) . ' bytes of content';
|
||||
return $response if ($self->outputxml() );
|
||||
my $ua = LWP::UserAgent->new();
|
||||
my $request = HTTP::Request->new( 'POST',
|
||||
$self->get_proxy(),
|
||||
[ 'Content-Type', $content_type_of{ $ident },
|
||||
'Content-Length', length($envelope),
|
||||
'SOAPAction', $soap_action,
|
||||
],
|
||||
$envelope );
|
||||
|
||||
|
||||
$trace_sub->( $request->as_string() ) if $trace_of{ $ident }; # if for speed
|
||||
my $response = $ua->request( $request );
|
||||
$trace_sub->( $response->as_string() ) if $trace_of{ $ident }; # if for speed
|
||||
|
||||
return $response->content() if ($self->outputxml() );
|
||||
|
||||
$PARSER->class_resolver( $self->get_class_resolver() );
|
||||
|
||||
# if we had no success (Transport layer error status code)
|
||||
# or if transport layer failed
|
||||
if (! $soap->transport->is_success() ) {
|
||||
# or if transport layer failed
|
||||
if ($response->code() != 200) {
|
||||
# Try deserializing response - there may be some
|
||||
if ($response) {
|
||||
eval { $PARSER->parse( $response ); };
|
||||
if ($@) {
|
||||
warn "could not deserialize response: $@";
|
||||
}
|
||||
else {
|
||||
return $PARSER->get_data();
|
||||
}
|
||||
if ($response->content) {
|
||||
eval { $PARSER->parse( $response->content() ); };
|
||||
return $PARSER->get_data() if (not $@);
|
||||
warn "could not deserialize response: $@";
|
||||
};
|
||||
|
||||
|
||||
require SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
# generate & return fault if we cannot serialize response
|
||||
# or have none...
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
return $fault_class_of{$ident}->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => 'Error sending / receiving message: '
|
||||
. $soap->transport->message()
|
||||
. $response->message()
|
||||
#$soap->transport->message()
|
||||
});
|
||||
}
|
||||
eval { $PARSER->parse( $response ) };
|
||||
eval { $PARSER->parse( $response->content() ) };
|
||||
|
||||
# return fault if we cannot deserialize response
|
||||
if ($@) {
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
return $fault_class_of{$ident}->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => "Error deserializing message: $@. \n"
|
||||
@@ -133,6 +153,52 @@ sub call {
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Client - SOAP::WSDL's SOAP Client
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 call
|
||||
|
||||
=head2 Configuration methods
|
||||
|
||||
=head3 outputxml
|
||||
|
||||
$soap->outputxml(1);
|
||||
|
||||
When set, call() returns the raw XML of the SOAP Envelope.
|
||||
|
||||
=head3 set_content_type
|
||||
|
||||
$soap->set_content_type('application/xml; charset: utf8');
|
||||
|
||||
Sets the content type and character encoding.
|
||||
|
||||
You probably should not use a character encoding different from utf8:
|
||||
SOAP::WSDL::Client will not convert the request into a different encoding
|
||||
(yet).
|
||||
|
||||
To leave out the encoding, just set the content type without appendet charset
|
||||
like in
|
||||
|
||||
text/xml
|
||||
|
||||
Default:
|
||||
|
||||
text/xml; charset: utf8
|
||||
|
||||
=head3 set_trace
|
||||
|
||||
$soap->set_trace(1);
|
||||
$soap->set_trace( sub { Log::Log4perl::get_logger()->debug( @_ ) } );
|
||||
|
||||
When set to a true value, tracing (via warn) is enabled.
|
||||
|
||||
When set to a code reference, this function will be called on every
|
||||
trace call, making it really easy for you to set up log4perl logging
|
||||
or whatever you need.
|
||||
|
||||
=head2 Features different from SOAP::Lite
|
||||
|
||||
@@ -145,7 +211,7 @@ Nonetheless SOAP::WSDL mimics part of SOAP::Lite's API and behaviour,
|
||||
so SOAP::Lite users can switch without looking up every method call in the
|
||||
documentation.
|
||||
|
||||
A few things are quite differentl from SOAP::Lite, though:
|
||||
A few things are quite different from SOAP::Lite, though:
|
||||
|
||||
=head3 SOAP request data
|
||||
|
||||
@@ -197,9 +263,28 @@ SOAP::WSDL::Client and implementing something like
|
||||
$soap_wsdl_client->call( mySoapMethod, @_);
|
||||
}
|
||||
|
||||
You may even do this in a class factory - SOAP::WSDL provides the methods
|
||||
for generating such interfaces.
|
||||
You may even do this in a class factory - see L<wsdl2perl.pl> for creating
|
||||
such interfaces.
|
||||
|
||||
=head3 Debugging / Tracing
|
||||
|
||||
While SOAP::Lite features a global tracing facility, SOAP::WSDL::Client
|
||||
allows to switch tracing on/of on a per-object base.
|
||||
|
||||
See L<set_trace|set_trace> on how to enable tracing.
|
||||
|
||||
=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>
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
package SOAP::WSDL::Definitions;
|
||||
use utf8;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
@@ -49,8 +50,7 @@ sub explain {
|
||||
my $txt = '';
|
||||
|
||||
for my $service (@{ $self->get_service() }) {
|
||||
$txt .= $service->explain( $opt );
|
||||
$txt .= "\n";
|
||||
$txt .= $service->explain( $opt ) . "\n";
|
||||
}
|
||||
return $txt;
|
||||
}
|
||||
@@ -101,49 +101,62 @@ sub create {
|
||||
sub _create_interface {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $service_name = $opt->{ service }->get_name();
|
||||
my $file_name = "$opt->{ base_path }/$opt->{ interface_prefix }/$service_name.pm";
|
||||
$file_name =~s{::}{/}gms;
|
||||
my $path = dirname $file_name;
|
||||
my $name = basename $file_name;
|
||||
my $service_name = $opt->{ service }->get_name();
|
||||
$service_name =~s{\.}{\:\:}xmsg;
|
||||
# TODO: iterate over ports.
|
||||
# - ignore non-SOAP ports
|
||||
# - generate interface for all SOAP ports...
|
||||
my $binding = $self->find_binding( $self->_expand( $opt->{ service }->first_port()->get_binding() ) );
|
||||
my $portType = $self->find_portType( $self->_expand( $binding->get_type() ) );
|
||||
my $portType_operation_from_ref = $portType->get_operation();
|
||||
my $porttype = $self->find_portType( $self->_expand( $binding->get_type() ) );
|
||||
|
||||
my $port_operation_ref = $porttype->get_operation();
|
||||
my $operation_ref = $binding->get_operation();
|
||||
$operation_ref = [ $operation_ref ] if ref $operation_ref ne 'ARRAY';
|
||||
my %operations = map {
|
||||
do {
|
||||
my $operation_name = $_->get_name();
|
||||
my $port_op = first { $_->get_name eq $operation_name } @{ $portType_operation_from_ref };
|
||||
my $input = $port_op->first_input()->get_message();
|
||||
my $message = $self->find_message( $self->_expand( $input ) );
|
||||
my $parts = $message->get_part;
|
||||
( $operation_name => [
|
||||
map {
|
||||
do {
|
||||
my $name;
|
||||
($name = $_->get_element())
|
||||
? do {
|
||||
my ($prefix, $localname) = split m{:}xms , $name;
|
||||
"$opt->{ element_prefix }$localname";
|
||||
}
|
||||
: ($name = $_->get_type())
|
||||
? do {
|
||||
my ($prefix, $localname) = split m{:}xms , $name;
|
||||
"$opt->{ type_prefix }$localname";
|
||||
}
|
||||
: ()
|
||||
}
|
||||
} @{ $parts }
|
||||
] );
|
||||
};
|
||||
} @{ $operation_ref };
|
||||
|
||||
# use Data::Dumper;
|
||||
# die Dumper \%operations;
|
||||
|
||||
|
||||
# make up operations map - name => [ part types / elements class names ]
|
||||
#
|
||||
my %operations = ();
|
||||
for my $operation ( @{ $operation_ref } ) {
|
||||
my $operation_name = $operation->get_name();
|
||||
my $port_op = first { $_->get_name() eq $operation_name } @{ $port_operation_ref };
|
||||
|
||||
$operations{ $operation_name }->{ documentation } = $port_op->get_documentation();
|
||||
|
||||
my %msg_from = (
|
||||
'input' => ($port_op->first_input() ) ? $port_op->first_input()->get_message() : undef,
|
||||
'output' => ($port_op->first_output()) ? $port_op->first_output()->get_message(): undef,
|
||||
'fault' => ($port_op->first_fault()) ? $port_op->first_fault()->get_message() : undef,
|
||||
);
|
||||
|
||||
for my $msg (keys %msg_from) {
|
||||
next if not $msg_from{ $msg };
|
||||
for my $part (@{ $self->find_message( $self->_expand( $msg_from{$msg} ) )->get_part }) {
|
||||
my $name;
|
||||
if (my $element_name = $part->get_element() ) {
|
||||
$name = $element_name;
|
||||
push @{ $operations{ $operation_name }->{$msg}->{ types } },
|
||||
$self->first_types()->find_element( $self->_expand( $element_name ) )
|
||||
->explain({ wsdl => $self , anonymous => 1 });
|
||||
|
||||
}
|
||||
elsif (my $type_name = $part->get_element() ) {
|
||||
push @{ $operations{ $operation_name }->{$msg}->{ types } },
|
||||
$self->first_types()->find_type( $self->_expand( $element_name ) )
|
||||
->explain({ wsdl => $self });
|
||||
$name = $type_name;
|
||||
}
|
||||
my ($prefix, $localname) = split m{:}xms , $name;
|
||||
push @{ $operations{ $operation_name }->{$msg}->{ class } },
|
||||
"$opt->{ element_prefix }$localname";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# use Data::Dumper;
|
||||
# die Dumper \%operations;
|
||||
|
||||
my $template = <<'EOT';
|
||||
package [% interface_prefix %][% service.get_name %];
|
||||
package [% interface_prefix %][% service.get_name.replace('\.', '::') %];
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use [% typemap_prefix %][% service.get_name %];
|
||||
@@ -153,7 +166,7 @@ sub new {
|
||||
my $class = shift;
|
||||
my $arg_ref = shift || {};
|
||||
my $self = $class->SUPER::new({
|
||||
class_resolver => '[% typemap_prefix %][% service.get_name %]',
|
||||
class_resolver => '[% typemap_prefix %][% service.get_name.replace('\.', '::') %]',
|
||||
proxy => '[% service.first_port.get_location %]',
|
||||
%{ $arg_ref }
|
||||
});
|
||||
@@ -162,7 +175,7 @@ sub new {
|
||||
|
||||
__PACKAGE__->__create_methods(
|
||||
[% FOREACH name = operations.keys -%]
|
||||
[% name %] => [ [% FOREACH class = operations.$name %]'[% class %]', [% END %]],
|
||||
[% name %] => [ [% FOREACH class = operations.$name.input.class %]'[% class %]', [% END %]],
|
||||
[% END %]
|
||||
);
|
||||
|
||||
@@ -183,17 +196,38 @@ __END__
|
||||
my $[% operations.keys.1 %] = $interface->[% operations.keys.1 %]();
|
||||
|
||||
|
||||
[% service.explain({ wsdl => wsdl }) %]
|
||||
=head1 METHODS
|
||||
[% FOREACH name=operations.keys;
|
||||
operation=operations.$name;
|
||||
%]
|
||||
=head2 [% name %]
|
||||
|
||||
[% operation.documentation %]
|
||||
|
||||
SYNOPSIS:
|
||||
|
||||
$service->[% name %]({
|
||||
[% FOREACH type = operation.input.types; type; END %] });
|
||||
|
||||
[% END %]
|
||||
|
||||
=cut
|
||||
|
||||
EOT
|
||||
|
||||
require Template;
|
||||
my $file_name = "$opt->{ base_path }/$opt->{ interface_prefix }/$service_name.pm";
|
||||
$file_name =~s{::}{/}gms;
|
||||
my $path = dirname $file_name;
|
||||
my $name = basename $file_name;
|
||||
my $tt = Template->new(
|
||||
OUTPUT_PATH => $path,
|
||||
);
|
||||
$tt->process(\$template, { %{ $opt }, operations => \%operations, binding => $binding, wsdl => $self }, $name)
|
||||
$tt->process(\$template,
|
||||
{ %{ $opt }, operations => \%operations, binding => $binding, wsdl => $self },
|
||||
$name,
|
||||
binmode => ':utf8'
|
||||
)
|
||||
or die $tt->error();
|
||||
return 1;
|
||||
}
|
||||
@@ -203,7 +237,8 @@ EOT
|
||||
sub _create_typemap {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $service_name = $opt->{ service }->get_name();
|
||||
my $service_name = $opt->{ service }->get_name();
|
||||
$service_name =~s{\.}{\:\:}xmsg;
|
||||
my $file_name = "$opt->{ base_path }/$opt->{ typemap_prefix }/$service_name.pm";
|
||||
$file_name =~s{::}{/}gms;
|
||||
my $path = dirname $file_name;
|
||||
@@ -212,11 +247,19 @@ sub _create_typemap {
|
||||
my $typemap = $opt->{ service }->to_typemap( { %{ $opt }, wsdl => $self } );
|
||||
|
||||
my $template = <<'EOT';
|
||||
package [% typemap_prefix %][% service.get_name %];
|
||||
package [% typemap_prefix %][% service.get_name.replace('\.', '::') %];
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my %typemap = (
|
||||
my %typemap = (
|
||||
# SOAP 1.1 fault typemap
|
||||
'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11',
|
||||
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::TOKEN',
|
||||
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
|
||||
# generated typemap
|
||||
[% typemap %]
|
||||
[% custom_types %]
|
||||
);
|
||||
@@ -237,7 +280,11 @@ EOT
|
||||
my $tt = Template->new(
|
||||
OUTPUT_PATH => $path,
|
||||
);
|
||||
$tt->process(\$template, { %{ $opt }, typemap => $typemap }, $name)
|
||||
$tt->process(\$template,
|
||||
{ %{ $opt }, typemap => $typemap },
|
||||
$name,
|
||||
binmode => ':utf8',
|
||||
)
|
||||
or die $tt->error();
|
||||
|
||||
}
|
||||
|
||||
@@ -5,23 +5,23 @@ use warnings;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use XML::Parser::Expat;
|
||||
|
||||
=pod
|
||||
|
||||
=head2 new
|
||||
|
||||
=over
|
||||
|
||||
=item SYNOPSIS
|
||||
|
||||
my $obj = ->new();
|
||||
|
||||
=item DESCRIPTION
|
||||
|
||||
Constructor.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
=pod
|
||||
|
||||
=head2 new
|
||||
|
||||
=over
|
||||
|
||||
=item SYNOPSIS
|
||||
|
||||
my $obj = ->new();
|
||||
|
||||
=item DESCRIPTION
|
||||
|
||||
Constructor.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
@@ -37,106 +37,131 @@ sub class_resolver {
|
||||
my $self = shift;
|
||||
$self->{ class_resolver } = shift;
|
||||
}
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my $xml = shift;
|
||||
|
||||
sub _initialize {
|
||||
my $self = shift;
|
||||
|
||||
$self->{ data } = undef;
|
||||
|
||||
my $characters;
|
||||
my $current = '__STOP__';
|
||||
my $ignore = [ 'Envelope', 'Body' ];
|
||||
my $list = [];
|
||||
my $namespace = {};
|
||||
my $path = [];
|
||||
my $current = undef;
|
||||
my $ignore = [ 'Envelope', 'Body' ]; # top level elements to ignore
|
||||
my $list = []; # node list
|
||||
my $path = []; # current path (without
|
||||
# number)
|
||||
my $skip = 0; # skip elements
|
||||
my $parser = XML::Parser::Expat->new();
|
||||
|
||||
# use "globals" for speed
|
||||
my ($_prefix, $_localname, $_element, $_method,
|
||||
$_class, $_parser, %_attrs) = ();
|
||||
|
||||
no strict qw(refs);
|
||||
$parser->setHandlers(
|
||||
Start => sub {
|
||||
my ($parser, $element, %attrs) = @_;
|
||||
my ($prefix, $localname) = split m{:}xms , $element;
|
||||
# for non-prefixed elements
|
||||
if (not $localname) {
|
||||
$localname = $element;
|
||||
$prefix = q{};
|
||||
}
|
||||
($_parser, $_element, %_attrs) = @_;
|
||||
($_prefix, $_localname) = split m{:}xms , $_element;
|
||||
|
||||
$_localname ||= $_element; # for non-prefixed elements
|
||||
|
||||
# ignore top level elements
|
||||
if (@{ $ignore } && $localname eq $ignore->[0]) {
|
||||
if (@{ $ignore } && $_localname eq $ignore->[0]) {
|
||||
shift @{ $ignore };
|
||||
return;
|
||||
}
|
||||
# empty characters
|
||||
$characters = q{};
|
||||
|
||||
push @{ $path }, $localname; # step down...
|
||||
push @{ $list }, $current; # remember current
|
||||
|
||||
|
||||
push @{ $path }, $_localname; # step down in path
|
||||
return if $skip; # skip inside __SKIP__
|
||||
|
||||
# resolve class of this element
|
||||
my $class = $self->{ class_resolver }->get_class( $path )
|
||||
$_class = $self->{ class_resolver }->get_class( $path )
|
||||
or die "Cannot resolve class for "
|
||||
. join('/', @{ $path }) . " via $self->{ class_resolver }";
|
||||
|
||||
|
||||
if ($_class eq '__SKIP__') {
|
||||
$skip = join '/', @{ $path };
|
||||
return;
|
||||
}
|
||||
|
||||
push @$list, $current; # step down in tree ()remember current)
|
||||
|
||||
$characters = q{}; # empty characters
|
||||
|
||||
# Check whether we have a primitive - we implement them as classes
|
||||
# TODO replace with UNIVERSAL->isa()
|
||||
# match is a bit faster if the string does not match, but WAY slower
|
||||
# if $class matches...
|
||||
# if (not $class=~m{^SOAP::WSDL::XSD::Typelib::Builtin}xms) {
|
||||
|
||||
if (index $class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
|
||||
|
||||
|
||||
if (index $_class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
|
||||
# check wheter there is a CODE reference for $class::new.
|
||||
# If not, require it - all classes required here MUST
|
||||
# define new()
|
||||
# This is the same as $class->can('new'), but it's way faster
|
||||
*{ "$class\::new" }{ CODE }
|
||||
or eval "require $class" ## no critic qw(ProhibitStringyEval)
|
||||
*{ "$_class\::new" }{ CODE }
|
||||
or eval "require $_class" ## no critic qw(ProhibitStringyEval)
|
||||
or die $@;
|
||||
}
|
||||
# create object
|
||||
# set current object
|
||||
$current = $class->new({ %attrs });
|
||||
|
||||
$current = $_class->new({ %_attrs }); # set new current object
|
||||
|
||||
# remember top level element
|
||||
defined $self->{ data }
|
||||
or ($self->{ data } = $current);
|
||||
},
|
||||
|
||||
Char => sub {
|
||||
return if $skip;
|
||||
$characters .= $_[1];
|
||||
},
|
||||
|
||||
End => sub {
|
||||
my $element = $_[1];
|
||||
$_element = $_[1];
|
||||
|
||||
my ($prefix, $localname) = split m{:}xms , $element;
|
||||
# for non-prefixed elements
|
||||
if (not $localname) {
|
||||
$localname = $element;
|
||||
$prefix = q{};
|
||||
($_prefix, $_localname) = split m{:}xms , $_element;
|
||||
$_localname ||= $_element; # for non-prefixed elements
|
||||
|
||||
pop @{ $path }; # step up in path
|
||||
|
||||
if ($skip) {
|
||||
return if $skip ne join '/', @{ $path }, $_localname;
|
||||
$skip = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
# This one easily handles ignores for us, too...
|
||||
return if not ref $list->[-1];
|
||||
return if not ref $$list[-1];
|
||||
|
||||
if ( $current
|
||||
->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType') ) {
|
||||
# set characters in current if we are a simple type
|
||||
# we may have characters in complexTypes with simpleContent,
|
||||
# too - maybe we should rely on the presence of characters ?
|
||||
# may get a speedup by defining a ident method in anySimpleType
|
||||
# and looking it up via exists &$class::ident;
|
||||
if ( $current->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType') ) {
|
||||
$current->set_value( $characters );
|
||||
}
|
||||
# currently doesn't work, as anyType does not implement value -
|
||||
# maybe change ?
|
||||
# $current->set_value( $characters ) if ($characters);
|
||||
|
||||
# set appropriate attribute in last element
|
||||
# multiple values must be implemented in base class
|
||||
my $method = "add_$localname";
|
||||
|
||||
$list->[-1]->$method( $current );
|
||||
|
||||
# step up in path
|
||||
pop @{ $path };
|
||||
|
||||
# step up in object hierarchy...
|
||||
$current = pop @{ $list };
|
||||
$_method = "add_$_localname";
|
||||
$$list[-1]->$_method( $current );
|
||||
|
||||
$current = pop @$list; # step up in object hierarchy...
|
||||
}
|
||||
);
|
||||
|
||||
$parser->parse( $xml );
|
||||
return $parser;
|
||||
}
|
||||
|
||||
sub parse {
|
||||
$_[0]->_initialize->parse( $_[1] );
|
||||
return $_[0]->{ data };
|
||||
}
|
||||
|
||||
sub parsefile {
|
||||
$_[0]->_initialize->parsefile( $_[1] );
|
||||
return $_[0]->{ data };
|
||||
}
|
||||
|
||||
sub get_data {
|
||||
@@ -144,7 +169,6 @@ sub get_data {
|
||||
return $self->{ data };
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
@@ -167,6 +191,13 @@ Real fast expat based SOAP message parser.
|
||||
|
||||
See L<SOAP::WSDL::Parser> for details.
|
||||
|
||||
=head2 Skipping unwanted items
|
||||
|
||||
Sometimes there's unneccessary information transported in SOAP messages.
|
||||
|
||||
To skip XML nodes (including all child nodes), just edit the type map for
|
||||
the message and set the type map entry to '__SKIP__'.
|
||||
|
||||
=head1 Bugs and Limitations
|
||||
|
||||
=over
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
|
||||
SOAP::WSDL::Manual - accessing WSDL based web services
|
||||
|
||||
=head1 Intro: Accessing a WSDL-based web service
|
||||
=head1 Accessing a WSDL-based web service
|
||||
|
||||
=head2 Quick walk-through for the unpatient
|
||||
|
||||
@@ -57,6 +57,152 @@ classes and returned to the user as objects.
|
||||
To find out which class a particular XML node should be, SOAP::WSDL uses
|
||||
typemaps. For every Web service, there's also a typemap created.
|
||||
|
||||
=head2 Interface class creation
|
||||
|
||||
To create interface classes, follow the steps above from
|
||||
L<Quick walk-through for the unpatient|Quick walk-through for the unpatient>.
|
||||
|
||||
If this works fine for you, skip the next paragraphs. If not, read on.
|
||||
|
||||
The steps to instrument a web service with SOAP::WSDL perl bindings
|
||||
(in detail) are as follows:
|
||||
|
||||
=over
|
||||
|
||||
=item * Gather web service information
|
||||
|
||||
You'll need to know at least a URL pointing to the web service's WSDL
|
||||
definition.
|
||||
|
||||
If you already know more - like which methods the service provides, or
|
||||
how the XML messages look like, that's fine. All these things will help you
|
||||
later.
|
||||
|
||||
=item * Create WSDL bindings
|
||||
|
||||
perl wsdl2perl.pl -b base_dir URL
|
||||
|
||||
This will generate the perl bindings in the directory specified by base_dir.
|
||||
|
||||
For more options, see L<wsdl2perl.pl> - you may want to specify class
|
||||
prefixes for XML type and element classes, type maps and interface classes,
|
||||
and you may even want to add custom typemap elements.
|
||||
|
||||
=item * Check the result
|
||||
|
||||
There should be a bunch of classes for types (in the MyTypes:: namespace by
|
||||
default), elements (in MyElements::), and at least one typemap
|
||||
(in MyTypemaps::) and one interface class (in MyInterfaces::).
|
||||
|
||||
If you don't already know the details of the web service you're going to
|
||||
instrument, it's now time to read the perldoc of the generated interface
|
||||
classes. It will tell you what methods each service provides, and which
|
||||
parameters they take.
|
||||
|
||||
If the WSDL definition is informative about what these methods do,
|
||||
the included perldoc will be, too.
|
||||
|
||||
=item * Write a perl script (or module) accessing the web service.
|
||||
|
||||
use MyInterface::SERVICE_NAME;
|
||||
my $service = MyInterface::SERVICE_NAME->new();
|
||||
|
||||
my $result = $service->SERVICE_METHOD();
|
||||
die $result if not $result;
|
||||
print $result;
|
||||
|
||||
The above handling of errors ("die $result if not $result") may look a bit
|
||||
strange - it is due to the nature of
|
||||
L<SOAP::WSDL::SOAP::Typelib::Fault11|SOAP::WSDL::SOAP::Typelib::Fault11>
|
||||
objects SOAP::WSDL uses for signalling failure.
|
||||
|
||||
These objects are false in boolean context, but serialize to their XML structure
|
||||
on stringification.
|
||||
|
||||
You may, of course, access individual fault properties, too. To get a list of
|
||||
fault properties, see L<SOAP::WSDL::SOAP::Typelib::Fault11>
|
||||
|
||||
=back
|
||||
|
||||
=head2 Adding missing information
|
||||
|
||||
Sometimes, WSDL definitions are incomplete. In most of these cases, proper
|
||||
fault definitions are missing. This means that though the specification sais
|
||||
nothing about it, Fault messages include extra elements in the
|
||||
E<lt>detailE<gt> section, or faults are even indicated by non-fault messages.
|
||||
|
||||
There are two steps you need to perform for adding additional information.
|
||||
|
||||
=over
|
||||
|
||||
=item * Provide required type classes
|
||||
|
||||
For each extra data type used in the XML messages, a type class has to be
|
||||
created.
|
||||
|
||||
It is strongly discouraged to use the same namespace for hand-written and
|
||||
generated classes - while generated classes may be many, you probably will
|
||||
only implement a few by hand. These (precious) few classes may get lost
|
||||
in the mass of (cheap) generated ones. Just imagine one of your co-workers
|
||||
(or even yourself) deleting the whole bunch and re-generating everything
|
||||
- oops - almost everything. You got the point.
|
||||
|
||||
For simplicity, you probably just want to use builtin types wherever
|
||||
possible - you are probably not interested in whether a fault detail's
|
||||
error code is presented to you as a simpleType ranging from 1 to 10
|
||||
(which you have to write) or as a int (which is a builtin type ready
|
||||
to use).
|
||||
|
||||
Using builtin types for simpleType definitions may greatly reduce the
|
||||
number of additional classes you need to implement.
|
||||
|
||||
If the extra type classes you need include E<lt>complexType E<gt>
|
||||
or E<lt>element /E<gt> definitions, see
|
||||
L<SOAP::WSDL::SOAP::Typelib::ComplexType> and
|
||||
L<SOAP::WSDL::SOAP::Typelib::Element> on how to create ComplexType
|
||||
and Element type classes.
|
||||
|
||||
=item * Provide a typemap snippet to wsdl2perl.pl
|
||||
|
||||
SOAP::WSDL uses typemaps for finding out into which class' object
|
||||
a XML node should be transformed.
|
||||
|
||||
Typemaps basically map the path of every XML element inside the Body
|
||||
tag to a perl class.
|
||||
|
||||
Typemap snippets have to look like this (which is actually the
|
||||
default Fault typemap included in every generated one):
|
||||
|
||||
'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11',
|
||||
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyType',
|
||||
|
||||
The lines are hash key - value pairs. The keys are the XPath
|
||||
expression relative to the Body element.
|
||||
|
||||
If you don't know about XPath: They are just the names of the XML
|
||||
tags, starting from the one inside E<lt>BodyE<gt> up to the current
|
||||
one joined by /.
|
||||
|
||||
One line for every XML node is required.
|
||||
|
||||
You may use all builtin, generated or custom type class names as
|
||||
values.
|
||||
|
||||
Use wsdl2perl.pl -mi=FILE to include custom typemap snippets.
|
||||
|
||||
Your extra statements are included last, so they override potential
|
||||
typemap statements with the same keys.
|
||||
|
||||
=back
|
||||
|
||||
=head1 Accessing a web service without a WSDL definition
|
||||
|
||||
=head1 Troubleshooting
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<SOAP::WSDL::Manual::Glossary> The meaning of all these words
|
||||
|
||||
@@ -7,7 +7,7 @@ SOAP::WSDL::Manual::Glossary - Those acronyms and stuff
|
||||
=head2 web service
|
||||
|
||||
Web services are RPC (Remote Procedure Call) interfaces accessible via
|
||||
the internet, typically via HTTP(S).
|
||||
some internet protocol, typically via HTTP(S).
|
||||
|
||||
=head2 SOAP
|
||||
|
||||
@@ -21,7 +21,7 @@ SOAP services accessible via postcards.
|
||||
|
||||
Despite it's name, SOAP has nothing more to do with objects than
|
||||
cars have with pets - SOAP messages may, but not neccessarily do
|
||||
carry object, very much like your car may, but does not need to
|
||||
carry objects, very much like your car may, but does not need to
|
||||
carry your pet.
|
||||
|
||||
=head2 WSDL
|
||||
|
||||
@@ -3,7 +3,10 @@ use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw/SOAP::WSDL::Base/;
|
||||
|
||||
|
||||
# this class may be used for both soap::operation and wsdl::operation.
|
||||
# which one it is depends on context...
|
||||
|
||||
my %operation_of :ATTR(:name<operation> :default<()>);
|
||||
my %input_of :ATTR(:name<input> :default<()>);
|
||||
my %output_of :ATTR(:name<output> :default<()>);
|
||||
|
||||
@@ -90,6 +90,29 @@ A class resolver package might look like this:
|
||||
};
|
||||
1;
|
||||
|
||||
=head3 Skipping unwanted items
|
||||
|
||||
Sometimes there's unneccessary information transported in SOAP messages.
|
||||
|
||||
To skip XML nodes (including all child nodes), just edit the type map for
|
||||
the message and set the type map entry to '__SKIP__'.
|
||||
|
||||
In the example above, EnqueueMessage/StuffIDontNeed and all child elements
|
||||
are skipped.
|
||||
|
||||
my %class_list = (
|
||||
'EnqueueMessage' => 'Typelib::TEnqueueMessage',
|
||||
'EnqueueMessage/MMessage' => 'Typelib::TMessage',
|
||||
'EnqueueMessage/MMessage/MRecipientURI' => 'SOAP::WSDL::XSD::Builtin::anyURI',
|
||||
'EnqueueMessage/MMessage/MMessageContent' => 'SOAP::WSDL::XSD::Builtin::string',
|
||||
'EnqueueMessage/StuffIDontNeed' => '__SKIP__',
|
||||
'EnqueueMessage/StuffIDontNeed/Foo' => 'SOAP::WSDL::XSD::Builtin::string',
|
||||
'EnqueueMessage/StuffIDontNeed/Bar' => 'SOAP::WSDL::XSD::Builtin::string',
|
||||
);
|
||||
|
||||
Note that only SOAP::WSDL::Expat::MessageParser implements skipping elements
|
||||
at the time of writing.
|
||||
|
||||
=head3 Creating type lib classes
|
||||
|
||||
Every element must have a correspondent one in the type library.
|
||||
|
||||
@@ -3,13 +3,13 @@ use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Class::Std::Storable;
|
||||
# use base qw(XML::SAX::Base);
|
||||
use SOAP::WSDL::TypeLookup;
|
||||
|
||||
my %tree_of :ATTR(:name<tree> :default<{}>);
|
||||
my %order_of :ATTR(:name<order> :default<[]>);
|
||||
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
|
||||
my %current_of :ATTR(:name<current> :default<()>);
|
||||
my %characters_of :ATTR();
|
||||
|
||||
{
|
||||
# we have to implement our own new - we need a blessed Hash ref as $self
|
||||
@@ -34,7 +34,6 @@ my %current_of :ATTR(:name<current> :default<()>);
|
||||
# ...we ignore em all...
|
||||
no strict qw(refs);
|
||||
foreach my $method ( qw(
|
||||
characters
|
||||
processing_instruction
|
||||
ignorable_whitespace
|
||||
set_document_locator
|
||||
@@ -87,7 +86,8 @@ sub start_element {
|
||||
$element->{ NamespaceURI },
|
||||
$element->{ LocalName }
|
||||
);
|
||||
|
||||
|
||||
$characters_of{ $ident } = q{};
|
||||
return if not $action;
|
||||
|
||||
if ($action->{ type } eq 'CLASS') {
|
||||
@@ -138,28 +138,41 @@ sub start_element {
|
||||
: values %{ $element->{ Attributes } } );
|
||||
}
|
||||
}
|
||||
|
||||
sub characters {
|
||||
$characters_of{ ident $_[0] } .= $_[1]->{ Data };
|
||||
}
|
||||
|
||||
sub end_element {
|
||||
my ($self, $element) = @_;
|
||||
my ($self, $element) = @_;
|
||||
my $ident = ident $self;
|
||||
|
||||
my $action = SOAP::WSDL::TypeLookup->lookup(
|
||||
$element->{ NamespaceURI },
|
||||
$element->{ LocalName }
|
||||
) || {};
|
||||
my $action = SOAP::WSDL::TypeLookup->lookup(
|
||||
$element->{ NamespaceURI },
|
||||
$element->{ LocalName }
|
||||
) || {};
|
||||
|
||||
if ($action->{ type } && $action->{ type } eq 'CLASS' )
|
||||
{
|
||||
$current_of{ $ident } = pop @{ $order_of{ $ident } };
|
||||
}
|
||||
return if not ($action->{ type });
|
||||
if ( $action->{ type } eq 'CLASS' ) {
|
||||
$current_of{ $ident } = pop @{ $order_of{ $ident } };
|
||||
}
|
||||
elsif ($action->{ type } eq 'CONTENT' ) {
|
||||
my $method = $action->{ method };
|
||||
no strict qw(refs);
|
||||
# strip of leading and trailing whitespace
|
||||
$characters_of{ $ident } =~s{ ^ \s+ (.+) \s+ $ }{$1}xms;
|
||||
# replace multi whitespace by one
|
||||
$characters_of{ $ident } =~s{ \s+ }{ }xmsg;
|
||||
$current_of{ $ident }->$method( $characters_of{ $ident } );
|
||||
}
|
||||
}
|
||||
|
||||
sub fatal_error {
|
||||
die @_;
|
||||
die @_;
|
||||
}
|
||||
|
||||
sub get_data {
|
||||
my $self = shift;
|
||||
return $tree_of{ ident $self };
|
||||
my $self = shift;
|
||||
return $tree_of{ ident $self };
|
||||
}
|
||||
1;
|
||||
|
||||
@@ -1,129 +1,157 @@
|
||||
package SOAP::WSDL::TypeLookup;
|
||||
|
||||
my %TYPES = (
|
||||
# wsdl:
|
||||
'http://schemas.xmlsoap.org/wsdl/' => {
|
||||
binding => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Binding',
|
||||
},
|
||||
definitions => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Definitions',
|
||||
},
|
||||
portType => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::PortType',
|
||||
},
|
||||
types => {
|
||||
type => 'SKIP',
|
||||
},
|
||||
message => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Message',
|
||||
},
|
||||
part => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Part',
|
||||
},
|
||||
service => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Service',
|
||||
},
|
||||
port => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Port',
|
||||
},
|
||||
operation => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Operation',
|
||||
},
|
||||
input => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::OpMessage',
|
||||
},
|
||||
output => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::OpMessage',
|
||||
},
|
||||
fault => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::OpMessage',
|
||||
},
|
||||
types => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Types',
|
||||
}
|
||||
},
|
||||
# soap:
|
||||
'http://schemas.xmlsoap.org/wsdl/soap/' => {
|
||||
operation => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::SoapOperation',
|
||||
},
|
||||
binding => {
|
||||
type => 'PARENT',
|
||||
},
|
||||
body => {
|
||||
type => 'PARENT',
|
||||
},
|
||||
address => {
|
||||
type => 'PARENT',
|
||||
}
|
||||
},
|
||||
'http://www.w3c.org/2001/XMLSchema' => {
|
||||
schema => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::Schema',
|
||||
},
|
||||
element => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::Element',
|
||||
},
|
||||
simpleType => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::SimpleType',
|
||||
},
|
||||
complexType => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::ComplexType',
|
||||
},
|
||||
# wsdl:
|
||||
'http://schemas.xmlsoap.org/wsdl/' => {
|
||||
binding => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Binding',
|
||||
},
|
||||
definitions => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Definitions',
|
||||
},
|
||||
portType => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::PortType',
|
||||
},
|
||||
message => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Message',
|
||||
},
|
||||
part => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Part',
|
||||
},
|
||||
service => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Service',
|
||||
},
|
||||
port => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Port',
|
||||
},
|
||||
operation => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Operation',
|
||||
},
|
||||
input => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::OpMessage',
|
||||
},
|
||||
output => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::OpMessage',
|
||||
},
|
||||
fault => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::OpMessage',
|
||||
},
|
||||
types => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Types',
|
||||
},
|
||||
documentation => {
|
||||
type => 'CONTENT',
|
||||
method => 'set_documentation',
|
||||
}
|
||||
},
|
||||
# soap:
|
||||
'http://schemas.xmlsoap.org/wsdl/soap/' => {
|
||||
operation => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::SoapOperation',
|
||||
},
|
||||
binding => {
|
||||
type => 'PARENT',
|
||||
},
|
||||
body => {
|
||||
type => 'PARENT',
|
||||
},
|
||||
address => {
|
||||
type => 'PARENT',
|
||||
}
|
||||
},
|
||||
'http://www.w3.org/2001/XMLSchema' => {
|
||||
schema => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::Schema',
|
||||
},
|
||||
attribute => {
|
||||
type => 'SKIP' # not implemented yet
|
||||
},
|
||||
attributeGroup => {
|
||||
type => 'SKIP', # not implemented yet
|
||||
},
|
||||
key => {
|
||||
type => 'SKIP', # not implemented yet
|
||||
},
|
||||
keyref => {
|
||||
type => 'SKIP', # not implemented yet
|
||||
},
|
||||
unique => {
|
||||
type => 'SKIP', # not implemented yet
|
||||
},
|
||||
notation => {
|
||||
type => 'SKIP', # not implemented yet
|
||||
},
|
||||
annotation => {
|
||||
type => 'SKIP', # not implemented yet
|
||||
},
|
||||
appinfo => {
|
||||
type => 'SKIP', # not implemented yet
|
||||
},
|
||||
description => {
|
||||
type => 'SKIP', # not implemented yet
|
||||
},
|
||||
element => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::Element',
|
||||
},
|
||||
simpleType => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::SimpleType',
|
||||
},
|
||||
complexType => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::ComplexType',
|
||||
},
|
||||
simpleContent => {
|
||||
type => 'METHOD',
|
||||
method => 'set_contentModel',
|
||||
value => 'simpleContent'
|
||||
},
|
||||
complexContent => {
|
||||
type => 'METHOD',
|
||||
method => 'set_contentModel',
|
||||
value => 'complexContent'
|
||||
},
|
||||
restriction => {
|
||||
type => 'METHOD',
|
||||
method => 'set_restriction',
|
||||
},
|
||||
complexContent => {
|
||||
list => {
|
||||
type => 'METHOD',
|
||||
method => 'set_contentModel',
|
||||
value => 'complexContent'
|
||||
method => 'set_list',
|
||||
},
|
||||
union => {
|
||||
type => 'METHOD',
|
||||
method => 'set_union',
|
||||
},
|
||||
enumeration => {
|
||||
type => 'METHOD',
|
||||
method => 'push_enumeration',
|
||||
},
|
||||
restriction => {
|
||||
type => 'METHOD',
|
||||
method => 'set_restriction',
|
||||
},
|
||||
list => {
|
||||
type => 'METHOD',
|
||||
method => 'set_list',
|
||||
},
|
||||
union => {
|
||||
type => 'METHOD',
|
||||
method => 'set_union',
|
||||
},
|
||||
enumeration => {
|
||||
type => 'METHOD',
|
||||
method => 'push_enumeration',
|
||||
},
|
||||
group => {
|
||||
type => 'METHOD',
|
||||
method => 'set_flavor',
|
||||
value => 'all',
|
||||
},
|
||||
all => {
|
||||
type => 'METHOD',
|
||||
method => 'set_flavor',
|
||||
value => 'all',
|
||||
},
|
||||
all => {
|
||||
type => 'METHOD',
|
||||
method => 'set_flavor',
|
||||
value => 'all',
|
||||
},
|
||||
choice => {
|
||||
type => 'METHOD',
|
||||
method => 'set_flavor',
|
||||
@@ -133,16 +161,10 @@ my %TYPES = (
|
||||
type => 'METHOD',
|
||||
method => 'set_flavor',
|
||||
value => 'sequence',
|
||||
},
|
||||
|
||||
},
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# thei're equal (typo ?)
|
||||
$TYPES{ 'http://www.w3.org/2001/XMLSchema' } = $TYPES{
|
||||
'http://www.w3c.org/2001/XMLSchema'
|
||||
};
|
||||
|
||||
|
||||
sub lookup {
|
||||
my $self = shift;
|
||||
|
||||
46
lib/SOAP/WSDL/XSD/Builtin.pm
Normal file
46
lib/SOAP/WSDL/XSD/Builtin.pm
Normal file
@@ -0,0 +1,46 @@
|
||||
package SOAP::WSDL::XSD::Builtin;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
use Data::Dumper;
|
||||
|
||||
sub serialize {
|
||||
my ($self, $name, $value, $opt) = @_;
|
||||
my $xml;
|
||||
$opt->{ indent } ||= "";
|
||||
$opt->{ attributes } ||= [];
|
||||
|
||||
$xml .= $opt->{ indent } if ($opt->{ readable });
|
||||
$xml .= '<' . join ' ', $name, @{ $opt->{ attributes } };
|
||||
if ( $opt->{ autotype }) {
|
||||
my $ns = $self->get_targetNamespace();
|
||||
my $prefix = $opt->{ namespace }->{ $ns }
|
||||
|| die 'No prefix found for namespace '. $ns;
|
||||
$xml .= ' type="' . $prefix . ':'
|
||||
. $self->get_name() . '"' if ($self->get_name() );
|
||||
}
|
||||
|
||||
if (defined $value) {
|
||||
$xml .= '>';
|
||||
$xml .= "$value";
|
||||
$xml .= '</' . $name . '>' ;
|
||||
}
|
||||
else {
|
||||
$xml .= '/>';
|
||||
}
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub explain {
|
||||
my ($self, $opt, $name ) = @_;
|
||||
$opt->{ indent } = q{} if not defined $opt->{ indent };
|
||||
return "$opt->{ indent }'$name' => \$someValue,\n"
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
warn "# builtin";
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -127,16 +127,15 @@ sub explain {
|
||||
|
||||
return q{} if not $flavor; # empty complexType
|
||||
$opt->{ indent } ||= q{ };
|
||||
my $xml = q{};
|
||||
$xml .= "$opt->{indent}\'$name'=> " if $name;
|
||||
my $xml = q{};
|
||||
$xml .= "$opt->{indent}\'$name'=> {\n" if $name;
|
||||
|
||||
if ( ($flavor eq "sequence") or ($flavor eq "all") ) {
|
||||
$xml .= "{\n";
|
||||
$opt->{ indent } .= " ";
|
||||
$xml .= join q{}, map { $_->explain( $opt ) }
|
||||
@{ $self->get_element() };
|
||||
$opt->{ indent } .= " ";
|
||||
for my $element (@{ $self->get_element() }) {
|
||||
$xml .= $element->explain( $opt )
|
||||
}
|
||||
$opt->{ indent } =~s/\s{2}$//; # step back
|
||||
$xml .= "$opt->{ indent }},\n";
|
||||
}
|
||||
elsif ($flavor eq "complexContent")
|
||||
{
|
||||
@@ -150,6 +149,11 @@ sub explain {
|
||||
{
|
||||
warn "found unsupported complexType definition $flavor";
|
||||
}
|
||||
|
||||
|
||||
# if we're called inside a element...
|
||||
$xml .= "$opt->{indent}},\n" if $name;
|
||||
|
||||
return $xml;
|
||||
}
|
||||
|
||||
@@ -300,26 +304,3 @@ sub _check_value {
|
||||
}
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * attribute definitions
|
||||
|
||||
Attribute definitions are ignored
|
||||
|
||||
=item * abstract, block, final, mixed
|
||||
|
||||
Handling of these attribute is not implemented yet.
|
||||
|
||||
=item * simpleContent, complexContent, extension, restriction, group, choice
|
||||
|
||||
Handling of these child elements is not implemented yet
|
||||
|
||||
=item * explain may produce erroneous results
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
@@ -111,18 +111,24 @@ sub serialize {
|
||||
sub explain {
|
||||
my ($self, $opt, $name) = @_;
|
||||
my $type;
|
||||
my $text = q{};
|
||||
my $text = q{};
|
||||
|
||||
# if we have a simple / complexType, explain right here
|
||||
if ($type = $self->first_simpleType() )
|
||||
{
|
||||
$text .= $type->explain( $opt, $self->get_name() );
|
||||
return $text;
|
||||
if ($opt->{ anonymous }) {
|
||||
delete $opt->{ anonymous };
|
||||
return $type->explain( $opt, undef );
|
||||
}
|
||||
return $type->explain( $opt, $self->get_name() );
|
||||
}
|
||||
elsif ($type = $self->first_complexType() )
|
||||
{
|
||||
$text .= $type->explain( $opt, $self->get_name() );
|
||||
return $text;
|
||||
if ($opt->{ anonymous }) {
|
||||
delete $opt->{ anonymous };
|
||||
return $type->explain( $opt, undef );
|
||||
}
|
||||
return $type->explain( $opt, $self->get_name() );
|
||||
}
|
||||
|
||||
# return if it's not a derived type - we don't handle
|
||||
@@ -137,12 +143,15 @@ sub explain {
|
||||
$ns_map{ $prefix }, $localname
|
||||
);
|
||||
|
||||
use Data::Dumper;
|
||||
use Data::Dumper;
|
||||
die "no type for $prefix:$localname ($ns_map{ $prefix })"
|
||||
. Dumper $opt->{ wsdl }->first_types()->first_schema()->_DUMP
|
||||
|
||||
if (not $type);
|
||||
|
||||
if (not $type);
|
||||
|
||||
if ($opt->{ anonymous }) {
|
||||
delete $opt->{ anonymous };
|
||||
return $text .= $type->explain( $opt, undef );
|
||||
}
|
||||
return $text .= $type->explain( $opt, $self->get_name() );
|
||||
return 'ERROR: '. $@;
|
||||
}
|
||||
@@ -369,47 +378,4 @@ EOT
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Element - XSD Element representation
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Represents a XML Schema Definition's Element element for serializing into
|
||||
various forms.
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * block
|
||||
|
||||
Handling of the block attribute is not implemented yet.
|
||||
|
||||
=item * final
|
||||
|
||||
Handling of the final attribute is not implemented yet.
|
||||
|
||||
=item * substitutionGroup
|
||||
|
||||
Handling of the substitutionGroup attribute is not implemented yet
|
||||
|
||||
=item * explain may produce erroneous results
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
This module is part of SOAP-WSDL. See SOAP::WSDL for license.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Insert @ instead of whitespace into e-mail.
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -1,50 +0,0 @@
|
||||
package SOAP::WSDL::XSD::Primitive;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
use Data::Dumper;
|
||||
|
||||
sub serialize
|
||||
{
|
||||
my ($self, $name, $value, $opt) = @_;
|
||||
my $xml;
|
||||
$opt->{ indent } ||= "";
|
||||
$opt->{ attributes } ||= [];
|
||||
|
||||
$xml .= $opt->{ indent } if ($opt->{ readable });
|
||||
$xml .= '<' . join ' ', $name, @{ $opt->{ attributes } };
|
||||
if ( $opt->{ autotype })
|
||||
{
|
||||
my $ns = $self->get_targetNamespace();
|
||||
my $prefix = $opt->{ namespace }->{ $ns }
|
||||
|| die 'No prefix found for namespace '. $ns;
|
||||
$xml .= ' type="' . $prefix . ':'
|
||||
. $self->get_name() . '"' if ($self->get_name() );
|
||||
}
|
||||
|
||||
if (defined $value)
|
||||
{
|
||||
$xml .= '>';
|
||||
$xml .= "$value";
|
||||
$xml .= '</' . $name . '>' ;
|
||||
}
|
||||
else
|
||||
{
|
||||
$xml .= '/>';
|
||||
}
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub explain
|
||||
{
|
||||
my ($self, $opt, $name ) = @_;
|
||||
$opt->{ indent } ||= "";
|
||||
return "$opt->{ indent }'$name' => \$someValue,\n"
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
warn "# primitive";
|
||||
}
|
||||
1;
|
||||
@@ -3,11 +3,11 @@ use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Schema;
|
||||
use SOAP::WSDL::XSD::Primitive;
|
||||
use SOAP::WSDL::XSD::Builtin;
|
||||
use base qw(SOAP::WSDL::XSD::Schema);
|
||||
|
||||
# all builtin types - add validation (e.g. content restrictions) later...
|
||||
my %PRIMITIVES = (
|
||||
my %BUILTINS = (
|
||||
'string' => {},
|
||||
'boolean' => {},
|
||||
'decimal' => {},
|
||||
@@ -50,9 +50,9 @@ sub START {
|
||||
my $self = shift;
|
||||
my @args = @_;
|
||||
|
||||
while (my ($name, $value) = each %PRIMITIVES )
|
||||
while (my ($name, $value) = each %BUILTINS )
|
||||
{
|
||||
$self->push_type( SOAP::WSDL::XSD::Primitive->new({
|
||||
$self->push_type( SOAP::WSDL::XSD::Builtin->new({
|
||||
name => $name,
|
||||
targetNamespace => 'http://www.w3.org/2001/XMLSchema',
|
||||
} )
|
||||
|
||||
@@ -43,8 +43,7 @@ sub set_union {
|
||||
}
|
||||
}
|
||||
|
||||
sub push_enumeration
|
||||
{
|
||||
sub push_enumeration {
|
||||
my $self = shift;
|
||||
my @attr = @_;
|
||||
my @attributes = @_;
|
||||
@@ -101,13 +100,9 @@ sub _serialize_single {
|
||||
}
|
||||
|
||||
sub explain {
|
||||
my ($self, $opt, $name) = @_;
|
||||
my $perl;
|
||||
$opt->{ indent } ||= "";
|
||||
$perl .= $opt->{ indent } if ($opt->{ readable });
|
||||
$perl .= q{'} . $name . q{' => $someValue };
|
||||
$perl .= "\n" if ($opt->{ readable });
|
||||
return $perl;
|
||||
my ($self, $opt, $name ) = @_;
|
||||
$opt->{ indent } = q{} if not defined $opt->{ indent };
|
||||
return "$opt->{ indent }'$name' => \$someValue,\n"
|
||||
}
|
||||
|
||||
sub _check_value {
|
||||
@@ -155,25 +150,4 @@ EOT
|
||||
return $code;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * simpleContent, complexContent
|
||||
|
||||
These child elements are not implemented yet
|
||||
|
||||
=item * union
|
||||
|
||||
union simpleType definitions probalbly serialize wrong
|
||||
|
||||
=item * explain may produce erroneous results
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
@@ -205,7 +205,26 @@ byte integer objects.
|
||||
|
||||
=head2 SOAP::WSDL::XSD::Typelib::Builtin::date
|
||||
|
||||
date values are automatically converted into XML date strings during setting:
|
||||
|
||||
YYYY-MM-DD+zz:zz
|
||||
|
||||
The time zone is set to the local time zone if not included.
|
||||
|
||||
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
|
||||
|
||||
=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.
|
||||
|
||||
All input variants supported by Date::Parse are supported. Note that
|
||||
set_value is around 100 times slower when setting non-XML-time strings
|
||||
|
||||
=head2 SOAP::WSDL::XSD::Typelib::Builtin::decimal
|
||||
|
||||
@@ -237,6 +256,8 @@ decimal is the base of all non-float numbers
|
||||
|
||||
=head2 SOAP::WSDL::XSD::Typelib::Builtin::IDREFS
|
||||
|
||||
List of SOAP::WSDL::XSD::Typelib::Builtin::IDREF objects.
|
||||
|
||||
Derived by SOAP::WSDL::XSD::Typelib::Builtin::list.
|
||||
|
||||
=head2 SOAP::WSDL::XSD::Typelib::Builtin::int
|
||||
@@ -273,6 +294,18 @@ Derived by SOAP::WSDL::XSD::Typelib::Builtin::list.
|
||||
|
||||
=head2 SOAP::WSDL::XSD::Typelib::Builtin::time
|
||||
|
||||
time values are automatically converted into XML time strings during setting:
|
||||
|
||||
hh:mm:ss.nnnnnnn+zz:zz
|
||||
hh:mm:ss+zz:zz
|
||||
|
||||
The time zone is set to the local time zone if not included. The optional
|
||||
nanoseconds part is not included in converted values, as it would always be 0.
|
||||
|
||||
All input variants supported by Date::Parse are supported. You may even pass
|
||||
in dateTime strings - the date part will be ignored. Note that
|
||||
set_value is around 100 times slower when setting non-XML-time strings
|
||||
|
||||
=head2 SOAP::WSDL::XSD::Typelib::Builtin::token
|
||||
|
||||
=head2 SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte
|
||||
|
||||
@@ -2,6 +2,9 @@ package SOAP::WSDL::XSD::Typelib::Builtin::date;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Date::Parse;
|
||||
use Date::Format;
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
@@ -31,5 +34,32 @@ BEGIN {
|
||||
|
||||
}
|
||||
|
||||
sub set_value {
|
||||
# use set_value from base class if we have a XML-DateTime format
|
||||
#2037-12-31T00:00:00.0000000+01:00
|
||||
if (
|
||||
$_[1] =~ m{ ^\d{4} \- \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.
|
||||
else {
|
||||
# strptime sets empty values to undef - and strftime doesn't like that...
|
||||
my @time_from = map { ! defined $_ ? 0 : $_ } strptime($_[1]);
|
||||
my $time_str = strftime( '%Y-%m-%d%z', @time_from );
|
||||
substr $time_str, -2, 0, ':';
|
||||
$_[0]->SUPER::set_value($time_str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
@@ -3,6 +3,8 @@ use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
use Date::Parse;
|
||||
use Date::Format;
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
@@ -30,8 +32,31 @@ BEGIN {
|
||||
}
|
||||
return $self;
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub set_value {
|
||||
# use set_value from base class if we have a XML-DateTime format
|
||||
#2037-12-31T00:00:00.0000000+01:00
|
||||
if (
|
||||
$_[1] =~ m{ ^\d{4} \- \d{2} \- \d{2}
|
||||
T \d{2} \: \d{2} \: \d{2} (:? \. \d{1,7} )?
|
||||
[\+\-] \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 leave out the optional nanoseconds part, as it would always be empty.
|
||||
else {
|
||||
# strptime sets empty values to undef - and strftime doesn't like that...
|
||||
my @time_from = map { ! defined $_ ? 0 : $_ } strptime($_[1]);
|
||||
my $time_str = strftime( '%Y-%m-%dT%H:%M:%S%z', @time_from );
|
||||
substr $time_str, -2, 0, ':';
|
||||
$_[0]->SUPER::set_value($time_str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
@@ -1,6 +1,8 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::time;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Date::Parse;
|
||||
use Date::Format;
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
@@ -30,4 +32,30 @@ BEGIN {
|
||||
};
|
||||
}
|
||||
|
||||
sub set_value {
|
||||
# use set_value from base class if we have a XML-Time format
|
||||
# 00:00:00.0000000+01:00
|
||||
if (
|
||||
$_[1] =~ m{ ^ \d{2} \: \d{2} \: \d{2} (:? \. \d{1,7} )?
|
||||
[\+\-] \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 leave out the optional nanoseconds part, as it would always be empty.
|
||||
else {
|
||||
# strptime sets empty values to undef - and strftime doesn't like that...
|
||||
# we even need to set it to 1 to prevent a "Day '0' out of range 1..31" warning...
|
||||
my @time_from = map { ! defined $_ ? 1 : $_ } strptime($_[1]);
|
||||
my $time_str = strftime( '%H:%M:%S%z', @time_from );
|
||||
substr $time_str, -2, 0, ':';
|
||||
$_[0]->SUPER::set_value($time_str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
@@ -29,46 +29,70 @@ sub _factory {
|
||||
my $type = $CLASSES_OF{ $class }->{ $name }
|
||||
or die "No class given for $name";
|
||||
|
||||
# require all types here - this is a slow check -
|
||||
# TODO speedup
|
||||
$type->isa('UNIVERSAL')
|
||||
or eval "require $type"
|
||||
or croak $@;
|
||||
|
||||
my $is_list = $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list');
|
||||
|
||||
*{ "$class\::set_$name" } = sub {
|
||||
my ($self, $value) = @_;
|
||||
|
||||
=pod
|
||||
|
||||
=for developers
|
||||
|
||||
The structure below looks rather weird, but is optimized for performance.
|
||||
|
||||
We could use sub calls for sure, but these are much slower. And the logic
|
||||
is not that easy:
|
||||
|
||||
# we accept:
|
||||
# a) objects
|
||||
# b) scalars
|
||||
# c) list refs
|
||||
# d) hash refs
|
||||
# e) mixed stuff of all of the above, so we have to
|
||||
# set our element to
|
||||
# a) value if it's an object
|
||||
# b) New object with value for simple values
|
||||
# c 1) New object with value for list values and list type
|
||||
# c 2) List ref of new objects with value for list values and non-list type
|
||||
# c + e) List ref of objects for list values (list of objects) and non-list type
|
||||
# d) New object with values passed to new for HASH references
|
||||
#
|
||||
# Die on non-ARRAY/HASH references - if you can define semantics
|
||||
# for GLOB references, feel free to add them.
|
||||
$attribute_ref->{ ident $self } = blessed $value
|
||||
? $value
|
||||
: ref $value
|
||||
? ref $value eq 'ARRAY'
|
||||
? $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list')
|
||||
? $type->new({ value => $value })
|
||||
: [ map {
|
||||
blessed($_)
|
||||
? ($_->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
||||
? $_
|
||||
: croak 'cannot use non-XSD object as value'
|
||||
: $type->new({ value => $_ })
|
||||
} @{ $value }
|
||||
]
|
||||
: ref $value eq 'HASH'
|
||||
we accept:
|
||||
a) objects
|
||||
b) scalars
|
||||
c) list refs
|
||||
d) hash refs
|
||||
e) mixed stuff of all of the above, so we have to set our element to
|
||||
a) value if it's an object
|
||||
b) New object of expected class with value for simple values
|
||||
c 1) New object with value for list values and list type
|
||||
c 2) List ref of new objects with value for list values and non-list type
|
||||
c + e 1) List ref of objects for list values (list of objects) and non-list type
|
||||
c + e 2) List ref of new objects for list values (list of hashes) and non-list type
|
||||
where the hash ref is passed to new as argument
|
||||
d) New object with values passed to new for HASH references
|
||||
|
||||
We throw an error on
|
||||
a) list refs of list refs - don't know what to do with this (maybe use for lists of list types ?)
|
||||
b) wrong object types
|
||||
c) non-blessed non-ARRAY/HASH references - if you can define semantics
|
||||
for GLOB references, feel free to add them.
|
||||
d) we should also die for non-blessed non-ARRAY/HASH references in lists but don't do yet - oh my !
|
||||
|
||||
=cut
|
||||
|
||||
my $is_ref = ref $value;
|
||||
$attribute_ref->{ ident $self } = ($is_ref)
|
||||
? $is_ref eq 'ARRAY'
|
||||
? $is_list
|
||||
? $type->new({ value => $value })
|
||||
: [ map {
|
||||
ref $_
|
||||
? ref $_ eq 'HASH'
|
||||
? $type->new($_)
|
||||
: ref $_ eq $type
|
||||
? $_
|
||||
: croak "cannot use " . ref($_) . " reference as value for $name - $type required"
|
||||
: $type->new({ value => $_ })
|
||||
} @{ $value }
|
||||
]
|
||||
: $is_ref eq 'HASH'
|
||||
? $type->new( $value )
|
||||
: die 'Cannot use non-ARRAY/HASH as data'
|
||||
: $is_ref eq $type
|
||||
? $value
|
||||
: die 'Cannot use non-ARRAY/HASH as data'
|
||||
: $type->new({ value => $value });
|
||||
};
|
||||
|
||||
@@ -176,7 +200,7 @@ __END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType - ComplexType XML Schema definitions
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType - complexType base class
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
|
||||
@@ -63,27 +63,71 @@ sub end_tag {
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Element - element base clase
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This example creates a class for this XML schema definition:
|
||||
|
||||
<element name="MyElement" type="xsd:string" nillable="1"
|
||||
minOccurs="1" maxOccurs="1"/>
|
||||
|
||||
package MyElement;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use base (
|
||||
'SOAP::WSDL::XSD::Typelib::Element',
|
||||
'SOAP::WSDL::XSD::Typelib::Element',
|
||||
'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
);
|
||||
|
||||
__PACKAGE__->__set_name('MyElementName');
|
||||
__PACKAGE__->__set_nillable(1);
|
||||
__PACKAGE__->__set_minOccurs(1);
|
||||
__PACKAGE__->__set_maxOccurs(1);
|
||||
__PACKAGE__->__set_ref(1);
|
||||
__PACKAGE__->__set_ref(0);
|
||||
|
||||
Now we create this XML schema definition type class:
|
||||
|
||||
<element name="MyElement2" ref="tns:MyElement"/>
|
||||
|
||||
package MyElement2;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use base (
|
||||
'SOAP::WSDL::XSD::Typelib::Element',
|
||||
'MyElement'
|
||||
);
|
||||
|
||||
__PACKAGE__->__set_name('MyElementName');
|
||||
__PACKAGE__->__set_nillable(0);
|
||||
__PACKAGE__->__set_ref(1);
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
=over
|
||||
|
||||
=item * type="Foo"
|
||||
|
||||
Implemented via inheritance.
|
||||
|
||||
=item * ref="Foo"
|
||||
|
||||
Implemented via inheritance, too. Calling
|
||||
|
||||
__PACKAGE__->__set_ref(1) is highly encouraged, though it has no
|
||||
effect yet - it will probably be needed for serialization to XML
|
||||
Schema definitions some day.
|
||||
|
||||
=back
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
=over
|
||||
|
||||
=item * minOccurs maxOccurs ref not implemented
|
||||
=item * minOccurs maxOccurs not implemented
|
||||
|
||||
These attributes are not yet supported, though they may be set as class
|
||||
properties via __PACKAGE__->__set_FOO methods.
|
||||
|
||||
@@ -17,7 +17,7 @@ __END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType - simple type base class
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType - simpleType base class
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
|
||||
@@ -16,7 +16,7 @@ my @modules = qw(
|
||||
SOAP::WSDL::PortType
|
||||
SOAP::WSDL::Types
|
||||
SOAP::WSDL::SAX::WSDLHandler
|
||||
SOAP::WSDL::XSD::Primitive
|
||||
SOAP::WSDL::XSD::Builtin
|
||||
SOAP::WSDL::XSD::ComplexType
|
||||
SOAP::WSDL::XSD::SimpleType
|
||||
SOAP::WSDL::XSD::Element
|
||||
|
||||
@@ -174,7 +174,7 @@ sub xml
|
||||
targetNamespace="urn:myNamespace"
|
||||
xmlns="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:tns="urn:myNamespace"
|
||||
xmlns:xsd="http://www.w3c.org/2001/XMLSchema"
|
||||
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
>
|
||||
|
||||
@@ -37,7 +37,7 @@ $pod->output_string( \$output );
|
||||
$pod->parse_string_document( $soap->explain() );
|
||||
|
||||
# print $output;
|
||||
|
||||
|
||||
SKIP: {
|
||||
skip_without_test_xml();
|
||||
is_xml( $soap->call( 'EnqueueMessage' , EnqueueMessage => {
|
||||
@@ -48,10 +48,6 @@ SKIP: {
|
||||
}
|
||||
)
|
||||
, q{<SOAP-ENV:Envelope
|
||||
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:tns="http://www.example.org/MessageGateway2/"
|
||||
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
|
||||
<SOAP-ENV:Body ><EnqueueMessage xmlns="http://www.example.org/MessageGateway2/"><MMessage>
|
||||
<MRecipientURI>mailto:test@example.com</MRecipientURI>
|
||||
|
||||
@@ -15,7 +15,7 @@ my $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file:///' . $path .'/t/acceptance/wsdl/008_complexType.wsdl'
|
||||
)->wsdlinit();
|
||||
|
||||
my $wsdl = $soap->{ _WSDL }->{ wsdl_definitions };
|
||||
my $wsdl = $soap->get_definitions;
|
||||
my $schema = $wsdl->first_types();
|
||||
my $type = $schema->find_type('Test' , 'testComplexTypeAll');
|
||||
my $element = $type->get_element()->[0];
|
||||
|
||||
30
t/018_generator.t
Normal file
30
t/018_generator.t
Normal file
@@ -0,0 +1,30 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 1;
|
||||
use lib '../lib';
|
||||
use XML::LibXML;
|
||||
use SOAP::WSDL::SAX::WSDLHandler;
|
||||
use SOAP::WSDL::SAX::MessageHandler;
|
||||
use File::Path;
|
||||
use File::Basename;
|
||||
|
||||
my $path = dirname __FILE__;
|
||||
|
||||
my $filter = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||
my $parser = XML::LibXML->new();
|
||||
$parser->set_handler( $filter );
|
||||
$parser->parse_file( "$path/../example/wsdl/globalweather.xml" );
|
||||
|
||||
my $wsdl;
|
||||
ok( $wsdl = $filter->get_data() , "get object tree");
|
||||
|
||||
$wsdl->create({
|
||||
base_path => "$path/testlib",
|
||||
typemap_prefix => "Test::Typemap::",
|
||||
type_prefix => "Test::Type::",
|
||||
element_prefix => "Test::Element::",
|
||||
interface_prefix => "Test::Interface::",
|
||||
});
|
||||
|
||||
rmtree "$path/testlib";
|
||||
22
t/098_pod.t
22
t/098_pod.t
@@ -2,26 +2,18 @@ use Test::More;
|
||||
eval "use Test::Pod 1.00";
|
||||
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
|
||||
|
||||
use Cwd;
|
||||
|
||||
my $dir = cwd;
|
||||
|
||||
if ( $dir =~ /t$/ )
|
||||
{
|
||||
@directories = ('../lib/', '../bin/');
|
||||
# perl Build test or make test run from top-level dir.
|
||||
if ( -d '../t/' ) {
|
||||
@directories = ('../lib/');
|
||||
}
|
||||
else
|
||||
{
|
||||
@directories = ();
|
||||
else {
|
||||
@directories = (); # empty - will work automatically
|
||||
}
|
||||
|
||||
my @files = all_pod_files(
|
||||
@directories
|
||||
);
|
||||
my @files = all_pod_files(@directories);
|
||||
|
||||
plan tests => scalar(@files);
|
||||
|
||||
foreach my $module (@files)
|
||||
{
|
||||
foreach my $module (@files){
|
||||
pod_file_ok( $module )
|
||||
}
|
||||
@@ -1,4 +1,4 @@
|
||||
use Test::More tests => 10;
|
||||
use Test::More tests => 7;
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
@@ -26,22 +26,10 @@ ok( $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
|
||||
), 'Instantiated object' );
|
||||
|
||||
ok( $soap->wsdlinit(), 'parsed WSDL' );
|
||||
|
||||
ok( ($soap->servicename('testService') ), 'set service' );
|
||||
ok( ($soap->portname('testPort') ) ,'set portname');
|
||||
|
||||
ok( ($soap->portname() eq 'testPort' ),
|
||||
"Found first port definition" );
|
||||
|
||||
ok( ($soap->portname('testPort2') ),
|
||||
"Found second port definition (based on URL)" );
|
||||
|
||||
ok( ($soap->portname('testPort3') ),
|
||||
"Found third port definition (based on Name)" );
|
||||
ok( ($soap->portname('testPort2') ) ,'set portname');
|
||||
ok( $soap->wsdlinit(), 'parsed WSDL' );
|
||||
|
||||
ok( $soap->wsdlinit( servicename => 'testService', portname => 'testPort'), 'parsed WSDL' );
|
||||
|
||||
$soap->_wsdl_init_methods();
|
||||
|
||||
ok( ($soap->portname() eq 'testPort' ), 'found port passed to wsdlinit');
|
||||
@@ -59,14 +59,12 @@ TODO: {
|
||||
|
||||
eval
|
||||
{
|
||||
$xml = $soap->serializer->method(
|
||||
$soap->call('test',
|
||||
$xml = $soap->call('test',
|
||||
testAll => {
|
||||
Test1 => 'Test 1',
|
||||
Test2 => [ 'Test 2', 'Test 3' ]
|
||||
}
|
||||
)
|
||||
);
|
||||
);
|
||||
};
|
||||
|
||||
ok( ($@ =~m/illegal\snumber\sof\selements/),
|
||||
@@ -74,13 +72,11 @@ ok( ($@ =~m/illegal\snumber\sof\selements/),
|
||||
);
|
||||
|
||||
eval {
|
||||
$xml = $soap->serializer->method(
|
||||
$soap->call('test',
|
||||
$xml = $soap->call('test',
|
||||
testAll => {
|
||||
Test1 => 'Test 1',
|
||||
}
|
||||
)
|
||||
)
|
||||
);
|
||||
};
|
||||
ok($@, 'Died on illegal number of elements (not enough)');
|
||||
|
||||
|
||||
@@ -35,8 +35,6 @@ ok( $soap->wsdlinit(
|
||||
servicename => 'testService',
|
||||
), 'parsed WSDL' );
|
||||
$soap->no_dispatch(1);
|
||||
$soap->serializer()->envprefix('SOAP-ENV');
|
||||
$soap->serializer()->encprefix('SOAP-ENC');
|
||||
|
||||
#4
|
||||
ok $xml = $soap->call('test',
|
||||
@@ -46,33 +44,32 @@ ok $xml = $soap->call('test',
|
||||
}
|
||||
), 'Serialized complexType';
|
||||
|
||||
#5
|
||||
eval
|
||||
{
|
||||
$xml = $soap->serializer->method(
|
||||
$soap->call('test',
|
||||
testSequence => {
|
||||
Test1 => 'Test 1',
|
||||
}
|
||||
)
|
||||
);
|
||||
};
|
||||
ok( ($@),
|
||||
"Died on illegal number of elements"
|
||||
);
|
||||
|
||||
#6
|
||||
eval
|
||||
{
|
||||
$xml = $soap->serializer->method(
|
||||
$soap->call('test',
|
||||
testSequence => {
|
||||
Test1 => 'Test 1',
|
||||
Test2 => [ 1, 2, 3, ]
|
||||
}
|
||||
)
|
||||
);
|
||||
};
|
||||
ok( ($@),
|
||||
"Died on illegal number of elements"
|
||||
);
|
||||
TODO: {
|
||||
local $TODO = "not implemented yet";
|
||||
#5
|
||||
eval
|
||||
{
|
||||
$xml = $soap->call('test',
|
||||
testSequence => {
|
||||
Test1 => 'Test 1',
|
||||
}
|
||||
);
|
||||
};
|
||||
ok( ($@),
|
||||
"Died on illegal number of elements"
|
||||
);
|
||||
|
||||
#6
|
||||
eval
|
||||
{
|
||||
$xml = $soap->call('test',
|
||||
testSequence => {
|
||||
Test1 => 'Test 1',
|
||||
Test2 => [ 1, 2, 3, ]
|
||||
}
|
||||
);
|
||||
};
|
||||
ok( ($@),
|
||||
"Died on illegal number of elements"
|
||||
);
|
||||
};
|
||||
25
t/SOAP/WSDL/XSD/Typelib/Builtin/002_dateTime.t
Normal file
25
t/SOAP/WSDL/XSD/Typelib/Builtin/002_dateTime.t
Normal file
@@ -0,0 +1,25 @@
|
||||
use Test::More tests => 2;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib '../lib';
|
||||
|
||||
use_ok('SOAP::WSDL::XSD::Typelib::Builtin::dateTime');
|
||||
my $obj;
|
||||
|
||||
$obj = SOAP::WSDL::XSD::Typelib::Builtin::dateTime->new();
|
||||
|
||||
$obj->set_value( '2037-12-31' );
|
||||
|
||||
is $obj->get_value() , '2037-12-31T00:00:00+01:00', 'conversion';
|
||||
|
||||
$obj->set_value('2037-12-31T00:00:00.0000000+01:00');
|
||||
|
||||
|
||||
|
||||
# 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') },
|
||||
#~ }
|
||||
25
t/SOAP/WSDL/XSD/Typelib/Builtin/002_time.t
Normal file
25
t/SOAP/WSDL/XSD/Typelib/Builtin/002_time.t
Normal file
@@ -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') },
|
||||
#~ }
|
||||
18
t/SOAP/WSDL/XSD/Typelib/Builtin/003_date.t
Normal file
18
t/SOAP/WSDL/XSD/Typelib/Builtin/003_date.t
Normal file
@@ -0,0 +1,18 @@
|
||||
use Test::More tests => 3;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib '../lib';
|
||||
|
||||
use_ok('SOAP::WSDL::XSD::Typelib::Builtin::date');
|
||||
my $obj;
|
||||
|
||||
$obj = SOAP::WSDL::XSD::Typelib::Builtin::date->new();
|
||||
|
||||
$obj->set_value( '2037/12/31' );
|
||||
|
||||
is $obj->get_value() , '2037-12-31+01:00', 'conversion';
|
||||
|
||||
|
||||
$obj->set_value( '2037-12-31' );
|
||||
is $obj->get_value() , '2037-12-31', 'no conversion on match';
|
||||
|
||||
Reference in New Issue
Block a user