Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
312f3d6bbd |
@@ -2,30 +2,33 @@ use Module::Build;
|
|||||||
Module::Build->new(
|
Module::Build->new(
|
||||||
dist_abstract => 'SOAP with WSDL support',
|
dist_abstract => 'SOAP with WSDL support',
|
||||||
dist_name => 'SOAP-WSDL',
|
dist_name => 'SOAP-WSDL',
|
||||||
dist_version => '2.00_07',
|
dist_version => '2.00_08',
|
||||||
module_name => 'SOAP::WSDL',
|
module_name => 'SOAP::WSDL',
|
||||||
license => 'artistic',
|
license => 'artistic',
|
||||||
requires => {
|
requires => {
|
||||||
'Class::Std' => q/v0.0.8/,
|
'Class::Std' => q/v0.0.8/,
|
||||||
'Class::Std::Storable' => 0,
|
'Class::Std::Storable' => 0,
|
||||||
'SOAP::Lite' => 0,
|
'Date::Parse' => 0,
|
||||||
|
'Date::Format' => 0,
|
||||||
|
'LWP::UserAgent' => 0,
|
||||||
'List::Util' => 0,
|
'List::Util' => 0,
|
||||||
'File::Basename' => 0,
|
'File::Basename' => 0,
|
||||||
'File::Path' => 0,
|
'File::Path' => 0,
|
||||||
'XML::XPath' => 0,
|
|
||||||
'XML::LibXML' => 0,
|
'XML::LibXML' => 0,
|
||||||
'XML::SAX::Base' => 0,
|
'XML::SAX::Base' => 0,
|
||||||
'XML::SAX::ParserFactory' => 0,
|
'XML::SAX::ParserFactory' => 0,
|
||||||
'XML::Parser::Expat' => 0,
|
'XML::Parser::Expat' => 0,
|
||||||
},
|
},
|
||||||
buildrequires => {
|
buildrequires => {
|
||||||
|
'Date::Parse' => 0,
|
||||||
|
'Date::Format' => 0,
|
||||||
'Benchmark' => 0,
|
'Benchmark' => 0,
|
||||||
'Cwd' => 0,
|
'Cwd' => 0,
|
||||||
'Test::More' => 0,
|
'Test::More' => 0,
|
||||||
'SOAP::Lite' => 0,
|
|
||||||
'Class::Std' => 0.0.8,
|
'Class::Std' => 0.0.8,
|
||||||
'Class::Std::Storable' => 0,
|
'Class::Std::Storable' => 0,
|
||||||
'List::Util' => 0,
|
'List::Util' => 0,
|
||||||
|
'LWP::UserAgent' => 0,
|
||||||
'File::Basename' => 0,
|
'File::Basename' => 0,
|
||||||
'File::Path' => 0,
|
'File::Path' => 0,
|
||||||
'XML::Simple' => 0,
|
'XML::Simple' => 0,
|
||||||
@@ -34,7 +37,6 @@ Module::Build->new(
|
|||||||
'XML::SAX::Base' => 0,
|
'XML::SAX::Base' => 0,
|
||||||
'XML::SAX::ParserFactory' => 0,
|
'XML::SAX::ParserFactory' => 0,
|
||||||
'Pod::Simple::Text' => 0,
|
'Pod::Simple::Text' => 0,
|
||||||
'XML::SAX::ParserFactory' => 0,
|
|
||||||
},
|
},
|
||||||
recursive_test_files => 1,
|
recursive_test_files => 1,
|
||||||
)->create_build_script;
|
)->create_build_script;
|
||||||
|
|||||||
@@ -21,6 +21,7 @@ example/lib/MyInterfaces/GlobalWeather.pm
|
|||||||
example/lib/MyTypemaps/FullerData_x0020_Fortune_x0020_Cookie.pm
|
example/lib/MyTypemaps/FullerData_x0020_Fortune_x0020_Cookie.pm
|
||||||
example/lib/MyTypemaps/GlobalWeather.pm
|
example/lib/MyTypemaps/GlobalWeather.pm
|
||||||
example/weather.pl
|
example/weather.pl
|
||||||
|
example/weather_wsdl.pl
|
||||||
example/wsdl/FortuneCookie.xml
|
example/wsdl/FortuneCookie.xml
|
||||||
example/wsdl/genericbarcode.xml
|
example/wsdl/genericbarcode.xml
|
||||||
example/wsdl/globalweather.xml
|
example/wsdl/globalweather.xml
|
||||||
@@ -50,9 +51,9 @@ lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
|
|||||||
lib/SOAP/WSDL/SoapOperation.pm
|
lib/SOAP/WSDL/SoapOperation.pm
|
||||||
lib/SOAP/WSDL/TypeLookup.pm
|
lib/SOAP/WSDL/TypeLookup.pm
|
||||||
lib/SOAP/WSDL/Types.pm
|
lib/SOAP/WSDL/Types.pm
|
||||||
|
lib/SOAP/WSDL/XSD/Builtin.pm
|
||||||
lib/SOAP/WSDL/XSD/ComplexType.pm
|
lib/SOAP/WSDL/XSD/ComplexType.pm
|
||||||
lib/SOAP/WSDL/XSD/Element.pm
|
lib/SOAP/WSDL/XSD/Element.pm
|
||||||
lib/SOAP/WSDL/XSD/Primitive.pm
|
|
||||||
lib/SOAP/WSDL/XSD/Schema.pm
|
lib/SOAP/WSDL/XSD/Schema.pm
|
||||||
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
||||||
lib/SOAP/WSDL/XSD/SimpleType.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/Element.pm
|
||||||
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||||
LICENSE
|
LICENSE
|
||||||
MANIFEST
|
MANIFEST This list of files
|
||||||
META.yml
|
META.yml
|
||||||
README
|
README
|
||||||
t/001_use.t
|
t/001_use.t
|
||||||
@@ -126,6 +127,7 @@ t/014_sax_typelib.t
|
|||||||
t/015_to_typemap.t
|
t/015_to_typemap.t
|
||||||
t/016_client_object.t
|
t/016_client_object.t
|
||||||
t/017_generator.t
|
t/017_generator.t
|
||||||
|
t/018_generator.t
|
||||||
t/020_storable.t
|
t/020_storable.t
|
||||||
t/098_pod.t
|
t/098_pod.t
|
||||||
t/acceptance/results/03_complexType-all.xml
|
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/11_helloworld.NET.t
|
||||||
t/SOAP/WSDL/12_binding.pl
|
t/SOAP/WSDL/12_binding.pl
|
||||||
t/SOAP/WSDL/XSD/Typelib/Builtin/001_string.t
|
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
|
TODO
|
||||||
|
|||||||
@@ -1,21 +1,22 @@
|
|||||||
---
|
---
|
||||||
name: SOAP-WSDL
|
name: SOAP-WSDL
|
||||||
version: 2.00_07
|
version: 2.00_08
|
||||||
author:
|
author:
|
||||||
abstract: SOAP with WSDL support
|
abstract: SOAP with WSDL support
|
||||||
license: artistic
|
license: artistic
|
||||||
requires:
|
requires:
|
||||||
Class::Std: v0.0.8
|
Class::Std: v0.0.8
|
||||||
Class::Std::Storable: 0
|
Class::Std::Storable: 0
|
||||||
|
Date::Format: 0
|
||||||
|
Date::Parse: 0
|
||||||
File::Basename: 0
|
File::Basename: 0
|
||||||
File::Path: 0
|
File::Path: 0
|
||||||
|
LWP::UserAgent: 0
|
||||||
List::Util: 0
|
List::Util: 0
|
||||||
SOAP::Lite: 0
|
|
||||||
XML::LibXML: 0
|
XML::LibXML: 0
|
||||||
XML::Parser::Expat: 0
|
XML::Parser::Expat: 0
|
||||||
XML::SAX::Base: 0
|
XML::SAX::Base: 0
|
||||||
XML::SAX::ParserFactory: 0
|
XML::SAX::ParserFactory: 0
|
||||||
XML::XPath: 0
|
|
||||||
generated_by: Module::Build version 0.2808
|
generated_by: Module::Build version 0.2808
|
||||||
meta-spec:
|
meta-spec:
|
||||||
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
||||||
@@ -23,7 +24,7 @@ meta-spec:
|
|||||||
provides:
|
provides:
|
||||||
SOAP::WSDL:
|
SOAP::WSDL:
|
||||||
file: lib/SOAP/WSDL.pm
|
file: lib/SOAP/WSDL.pm
|
||||||
version: 2.00_05
|
version: 2.00_08
|
||||||
SOAP::WSDL::Base:
|
SOAP::WSDL::Base:
|
||||||
file: lib/SOAP/WSDL/Base.pm
|
file: lib/SOAP/WSDL/Base.pm
|
||||||
SOAP::WSDL::Binding:
|
SOAP::WSDL::Binding:
|
||||||
@@ -64,12 +65,12 @@ provides:
|
|||||||
file: lib/SOAP/WSDL/TypeLookup.pm
|
file: lib/SOAP/WSDL/TypeLookup.pm
|
||||||
SOAP::WSDL::Types:
|
SOAP::WSDL::Types:
|
||||||
file: lib/SOAP/WSDL/Types.pm
|
file: lib/SOAP/WSDL/Types.pm
|
||||||
|
SOAP::WSDL::XSD::Builtin:
|
||||||
|
file: lib/SOAP/WSDL/XSD/Builtin.pm
|
||||||
SOAP::WSDL::XSD::ComplexType:
|
SOAP::WSDL::XSD::ComplexType:
|
||||||
file: lib/SOAP/WSDL/XSD/ComplexType.pm
|
file: lib/SOAP/WSDL/XSD/ComplexType.pm
|
||||||
SOAP::WSDL::XSD::Element:
|
SOAP::WSDL::XSD::Element:
|
||||||
file: lib/SOAP/WSDL/XSD/Element.pm
|
file: lib/SOAP/WSDL/XSD/Element.pm
|
||||||
SOAP::WSDL::XSD::Primitive:
|
|
||||||
file: lib/SOAP/WSDL/XSD/Primitive.pm
|
|
||||||
SOAP::WSDL::XSD::Schema:
|
SOAP::WSDL::XSD::Schema:
|
||||||
file: lib/SOAP/WSDL/XSD/Schema.pm
|
file: lib/SOAP/WSDL/XSD/Schema.pm
|
||||||
SOAP::WSDL::XSD::Schema::Builtin:
|
SOAP::WSDL::XSD::Schema::Builtin:
|
||||||
|
|||||||
@@ -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.
|
- 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
|
- add tests for SOAP::WSDL::Definitions::create
|
||||||
- test for correct creation
|
- test for correct creation
|
||||||
- test against web service (fullerdata.com?)
|
- test against web service (fullerdata.com?)
|
||||||
- Improve docs
|
- Improve docs
|
||||||
|
- Partially DONE
|
||||||
- Remove SOAP::Lite dependency - for now, just support HTTP(s) via LWP::UserAgent.
|
- 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
|
- write inheritance Test for all XSD::Typelib::Builtin::* classes
|
||||||
- Check & probably fix simpleType support.
|
- Check & probably fix simpleType support.
|
||||||
The WS at http://www.webservicex.net/genericbarcode.asmx?wsdl should make up a good example for simpleType
|
The WS at http://www.webservicex.net/genericbarcode.asmx?wsdl should make up a good example for simpleType
|
||||||
definitions.
|
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)
|
- update all Builtin Types to new constructor BEGIN block (Class::Std unfortunately is way slow)
|
||||||
- DONE.
|
- DONE.
|
||||||
- Remove useless (but on CPAN annoying) doc from Builtin::* classes
|
- Remove useless (but on CPAN annoying) doc from Builtin::* classes
|
||||||
|
|||||||
+9
-2
@@ -5,7 +5,7 @@ use Fcntl;
|
|||||||
use IO::File;
|
use IO::File;
|
||||||
use Pod::Usage;
|
use Pod::Usage;
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
use LWP::Simple qw(get);
|
use LWP::UserAgent;
|
||||||
use SOAP::WSDL::SAX::WSDLHandler;
|
use SOAP::WSDL::SAX::WSDLHandler;
|
||||||
use XML::LibXML;
|
use XML::LibXML;
|
||||||
|
|
||||||
@@ -17,6 +17,7 @@ my %opt = (
|
|||||||
typemap_prefix => 'MyTypemaps::',
|
typemap_prefix => 'MyTypemaps::',
|
||||||
interface_prefix => 'MyInterfaces::',
|
interface_prefix => 'MyInterfaces::',
|
||||||
base_path => 'lib/',
|
base_path => 'lib/',
|
||||||
|
proxy => undef
|
||||||
);
|
);
|
||||||
|
|
||||||
GetOptions(\%opt,
|
GetOptions(\%opt,
|
||||||
@@ -29,6 +30,7 @@ GetOptions(\%opt,
|
|||||||
base_path|b=s
|
base_path|b=s
|
||||||
typemap_include|mi=s
|
typemap_include|mi=s
|
||||||
help|h
|
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 $handler = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||||
my $parser = XML::LibXML->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->set_handler( $handler );
|
||||||
$parser->parse_string( $xml );
|
$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_name('string');
|
||||||
__PACKAGE__->__set_nillable(true);
|
__PACKAGE__->__set_nillable(true);
|
||||||
|
|||||||
@@ -38,220 +38,29 @@ http://www.webservicex.net/globalweather.asmx
|
|||||||
my $GetCitiesByCountry = $interface->GetCitiesByCountry();
|
my $GetCitiesByCountry = $interface->GetCitiesByCountry();
|
||||||
|
|
||||||
|
|
||||||
=head1 Service GlobalWeather
|
=head1 METHODS
|
||||||
|
|
||||||
=head2 Service information:
|
=head2 GetWeather
|
||||||
|
|
||||||
Port name: GlobalWeatherSoap
|
Get weather report for all major cities around the world.
|
||||||
Binding: tns:GlobalWeatherSoap
|
|
||||||
Location: http://www.webservicex.net/globalweather.asmx
|
|
||||||
|
|
||||||
=head2 SOAP Operations
|
SYNOPSIS:
|
||||||
|
|
||||||
B<Note:>
|
$service->GetWeather({
|
||||||
|
|
||||||
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,
|
'CityName' => $someValue,
|
||||||
'CountryName' => $someValue,
|
'CountryName' => $someValue,
|
||||||
},
|
});
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
B<Output Message:>
|
=head2 GetCitiesByCountry
|
||||||
|
|
||||||
{
|
Get all major cities by country name(full / part).
|
||||||
'GetWeather'=> {
|
|
||||||
'CityName' => $someValue,
|
SYNOPSIS:
|
||||||
|
|
||||||
|
$service->GetCitiesByCountry({
|
||||||
'CountryName' => $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: 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;
|
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
|
||||||
'GetWeather' => 'MyElements::GetWeather',
|
'GetWeather' => 'MyElements::GetWeather',
|
||||||
# atomic complex type (sequence)
|
# atomic complex type (sequence)
|
||||||
'GetWeather/CityName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
'GetWeather/CityName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||||
@@ -24,12 +32,9 @@ my %typemap = (
|
|||||||
'GetCitiesByCountryResponse/GetCitiesByCountryResult' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
'GetCitiesByCountryResponse/GetCitiesByCountryResult' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||||
|
|
||||||
# end atomic complex type (sequence)
|
# 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',
|
|
||||||
|
|
||||||
);
|
);
|
||||||
|
|
||||||
|
|||||||
+10
-10
@@ -1,19 +1,19 @@
|
|||||||
# Accessing the fortune cookie service at
|
# Accessing the globalweather service at
|
||||||
# www.webservicex.net/GlobalWeather/GlobalWeather.asmx
|
# 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
|
# I have no connection to www.webservicex.net
|
||||||
#
|
|
||||||
# Use this script at your own risk.
|
# Use this script at your own risk.
|
||||||
|
#
|
||||||
|
# This script demonstrates the use of a interface generated by wsdl2perl.pl
|
||||||
|
|
||||||
use lib 'lib/';
|
use lib 'lib/';
|
||||||
use MyInterfaces::GlobalWeather;
|
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";
|
||||||
print $result->get_GetWeatherResult()->get_value(), "\n";
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
print $result;
|
|
||||||
}
|
|
||||||
|
|||||||
@@ -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();
|
||||||
+310
-356
@@ -1,181 +1,188 @@
|
|||||||
package SOAP::WSDL;
|
package SOAP::WSDL;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use vars qw/$AUTOLOAD/;
|
use vars qw($AUTOLOAD);
|
||||||
|
use Carp;
|
||||||
use Scalar::Util qw(blessed);
|
use Scalar::Util qw(blessed);
|
||||||
|
use SOAP::WSDL::Client;
|
||||||
use SOAP::WSDL::Envelope;
|
use SOAP::WSDL::Envelope;
|
||||||
use SOAP::WSDL::SAX::WSDLHandler;
|
use SOAP::WSDL::SAX::WSDLHandler;
|
||||||
use base qw(SOAP::Lite);
|
use Class::Std;
|
||||||
|
use XML::LibXML;
|
||||||
|
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
our $VERSION='2.00_08';
|
||||||
|
|
||||||
our $VERSION='2.00_05';
|
my %no_dispatch_of :ATTR(:name<no_dispatch>);
|
||||||
|
my %wsdl_of :ATTR(:name<wsdl>);
|
||||||
BEGIN {
|
my %proxy_of :ATTR(:name<proxy>);
|
||||||
eval {
|
my %readable_of :ATTR(:name<readable>);
|
||||||
use XML::LibXML;
|
my %autotype_of :ATTR(:name<autotype>);
|
||||||
};
|
my %outputxml_of :ATTR(:name<outputxml>);
|
||||||
if ($@) {
|
my %outputtree_of :ATTR(:name<outputtree>);
|
||||||
use XML::SAX::ParserFactory;
|
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_info_of :ATTR(:default<()>);
|
||||||
my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
|
my %port_of :ATTR(:default<()>);
|
||||||
die "$method not found";
|
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 @_;
|
no warnings qw(redefine);
|
||||||
return $self->{ _WSDL }->{ outputtree } = shift;
|
sub new {
|
||||||
}
|
my $class = shift;
|
||||||
|
my %args_from = @_;
|
||||||
sub class_resolver {
|
my $self = \do { my $foo = undef };
|
||||||
my $self = shift;
|
bless $self, $class;
|
||||||
return $self->{ _WSDL }->{ class_resolver } if not @_;
|
|
||||||
return $self->{ _WSDL }->{ class_resolver } = shift;
|
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 {
|
sub wsdlinit {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
my $ident = ident $self;
|
||||||
my %opt = @_;
|
my %opt = @_;
|
||||||
|
|
||||||
my $wsdl_xml = SOAP::Schema->new( schema_url => $self->wsdl() )->access(
|
my $lwp = LWP::UserAgent->new();
|
||||||
$self->wsdl()
|
my $response = $lwp->get( $wsdl_of{ $ident } );
|
||||||
);
|
croak $response->message() if ($response->code != 200);
|
||||||
|
|
||||||
my $filter;
|
# TODO: Port parser to expat and remove XML::LibXML dependency
|
||||||
my $parser = eval { XML::LibXML->new() };
|
my $parser = XML::LibXML->new();
|
||||||
if ($parser) {
|
my $filter = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||||
$filter = SOAP::WSDL::SAX::WSDLHandler->new();
|
$parser->set_handler( $filter );
|
||||||
$parser->set_handler( $filter );
|
$parser->parse_string( $response->content() );
|
||||||
}
|
|
||||||
else {
|
# sanity checks
|
||||||
$filter = SOAP::WSDL::SAX::WSDLHandler->new( base => 'XML::SAX::Base' );
|
my $wsdl_definitions = $filter->get_data() or die "unable to parse WSDL";
|
||||||
$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 $types = $wsdl_definitions->first_types()
|
my $types = $wsdl_definitions->first_types()
|
||||||
or die "unable to extract schema from WSDL";
|
or die "unable to extract schema from WSDL";
|
||||||
|
|
||||||
my $ns = $wsdl_definitions->get_xmlns()
|
my $ns = $wsdl_definitions->get_xmlns()
|
||||||
or die "unable to extract XML Namespaces" . $wsdl_definitions->to_string;
|
or die "unable to extract XML Namespaces" . $wsdl_definitions->to_string;
|
||||||
( %{ $ns } ) or die "unable to extract XML Namespaces";
|
( %{ $ns } ) or die "unable to extract XML Namespaces";
|
||||||
|
|
||||||
# setup lookup variables
|
# setup lookup variables
|
||||||
$self->{ _WSDL }->{ wsdl_definitions } = $wsdl_definitions;
|
$definitions_of{ $ident } = $wsdl_definitions;
|
||||||
$self->{ _WSDL }->{ serialize_options } = {
|
$serialize_options_of{ $ident } = {
|
||||||
autotype => 0,
|
autotype => 0,
|
||||||
readable => $self->readable(),
|
|
||||||
typelib => $types,
|
typelib => $types,
|
||||||
namespace => $ns,
|
namespace => $ns,
|
||||||
};
|
};
|
||||||
$self->{ _WSDL }->{ explain_options } = {
|
$explain_options_of{ $ident } = {
|
||||||
readable => $self->readable(),
|
readable => $self->readable(),
|
||||||
wsdl => $wsdl_definitions,
|
wsdl => $wsdl_definitions,
|
||||||
namespace => $ns,
|
namespace => $ns,
|
||||||
typelib => $types,
|
typelib => $types,
|
||||||
};
|
};
|
||||||
|
|
||||||
$self->servicename($opt{servicename}) if $opt{servicename};
|
$servicename_of{ $ident } = $opt{servicename} if $opt{servicename};
|
||||||
$self->portname($opt{portname}) if $opt{portname};
|
$portname_of{ $ident } = $opt{portname} if $opt{portname};
|
||||||
return $self;
|
return $self;
|
||||||
} ## end sub wsdlinit
|
} ## end sub wsdlinit
|
||||||
|
|
||||||
sub _wsdl_get_service {
|
sub _wsdl_get_service :PRIVATE {
|
||||||
my $self = shift;
|
my $ident = ident shift;
|
||||||
my $service;
|
my $wsdl = $definitions_of{ $ident };
|
||||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
return $service_of{ $ident } = $servicename_of{ $ident }
|
||||||
my $ns = $wsdl->get_targetNamespace();
|
? $wsdl->find_service( $wsdl->get_targetNamespace() , $servicename_of{ $ident } )
|
||||||
if ( $self->{ _WSDL }->{ servicename } )
|
: $service_of{ $ident } = $wsdl->get_service()->[ 0 ];
|
||||||
{
|
|
||||||
$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;
|
|
||||||
} ## end sub _wsdl_get_service
|
} ## end sub _wsdl_get_service
|
||||||
|
|
||||||
sub _wsdl_get_port {
|
sub _wsdl_get_port :PRIVATE {
|
||||||
my $self = shift;
|
my $ident = ident shift;
|
||||||
my $service = $self->{ _WSDL }->{ service }
|
my $wsdl = $definitions_of{ $ident };
|
||||||
|| $self->_wsdl_get_service();
|
my $ns = $wsdl->get_targetNamespace();
|
||||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
return $port_of{ $ident } = $portname_of{ $ident }
|
||||||
my $ns = $wsdl->get_targetNamespace();
|
? $service_of{ $ident }->get_port( $ns, $portname_of{ $ident } )
|
||||||
my $port;
|
: $port_of{ $ident } = $service_of{ $ident }->get_port()->[ 0 ];
|
||||||
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;
|
|
||||||
} ## end sub _wsdl_get_port
|
} ## end sub _wsdl_get_port
|
||||||
|
|
||||||
sub _wsdl_get_binding {
|
sub _wsdl_get_binding :PRIVATE {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
my $ident = ident $self;
|
||||||
my $ns = $wsdl->get_targetNamespace();
|
my $wsdl = $definitions_of{ $ident };
|
||||||
my $port = $self->{ _WSDL }->{ port }
|
my $port = $port_of{ $ident } || $self->_wsdl_get_port();
|
||||||
|| $self->_wsdl_get_port();
|
$binding_of{ $ident } = $wsdl->find_binding( $wsdl->_expand( $port->get_binding() ) )
|
||||||
|
|
||||||
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 )
|
|
||||||
or die "no binding found for ", $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
|
} ## end sub _wsdl_get_binding
|
||||||
|
|
||||||
sub _wsdl_get_portType {
|
sub _wsdl_get_portType :PRIVATE {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
my $ident = ident $self;
|
||||||
my $binding = $self->{ _WSDL }->{ binding }
|
my $wsdl = $definitions_of{ $ident };
|
||||||
|| $self->_wsdl_get_binding();
|
my $binding = $binding_of{ $ident } || $self->_wsdl_get_binding();
|
||||||
my $ns = $wsdl->get_targetNamespace();
|
$porttype_of{ $ident } = $wsdl->find_portType( $wsdl->_expand( $binding->get_type() ) )
|
||||||
my ( $prefix, $localname ) = split /:/, $binding->get_type();
|
or die "cannot find portType for " . $binding->get_type();
|
||||||
my $portType = $wsdl->find_portType( $ns, $localname );
|
return $porttype_of{ $ident };
|
||||||
$self->{ _WSDL }->{ portType } = $portType;
|
|
||||||
return $portType;
|
|
||||||
} ## end sub _wsdl_get_portType
|
} ## end sub _wsdl_get_portType
|
||||||
|
|
||||||
|
|
||||||
sub _wsdl_init_methods {
|
sub _wsdl_init_methods :PRIVATE {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
my $ident = ident $self;
|
||||||
|
my $wsdl = $definitions_of{ $ident };
|
||||||
my $ns = $wsdl->get_targetNamespace();
|
my $ns = $wsdl->get_targetNamespace();
|
||||||
|
|
||||||
# get bindings, portType, message, part(s)
|
# get bindings, portType, message, part(s)
|
||||||
# - use cached values where possible for speed,
|
# - use cached values where possible for speed,
|
||||||
# private methods if not for clear separation...
|
# private methods if not for clear separation...
|
||||||
my $binding = $self->{ _WSDL }->{ binding }
|
$self->_wsdl_get_service if not ($service_of{ $ident });
|
||||||
|| $self->_wsdl_get_binding()
|
my $binding = $binding_of{ $ident } || $self->_wsdl_get_binding()
|
||||||
|| die "Can't find binding";
|
|| die "Can't find binding";
|
||||||
my $portType = $self->{ _WSDL }->{ portType }
|
my $portType = $porttype_of{ $ident } || $self->_wsdl_get_portType();
|
||||||
|| $self->_wsdl_get_portType()
|
|
||||||
|| die "Can't find portType";
|
|
||||||
|
|
||||||
my $methodHashRef = {};
|
$method_info_of{ $ident } = {};
|
||||||
|
|
||||||
foreach my $binding_operation (@{ $binding->get_operation() })
|
foreach my $binding_operation (@{ $binding->get_operation() })
|
||||||
{
|
{
|
||||||
@@ -211,201 +218,60 @@ sub _wsdl_init_methods {
|
|||||||
}
|
}
|
||||||
: undef;
|
: undef;
|
||||||
|
|
||||||
$methodHashRef->{ $binding_operation->get_name() } = $method;
|
$method_info_of{ $ident }->{ $binding_operation->get_name() } = $method;
|
||||||
}
|
}
|
||||||
|
|
||||||
$self->{ _WSDL }->{ methodInfo } = $methodHashRef;
|
return $method_info_of{ $ident };
|
||||||
|
|
||||||
return $methodHashRef;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub call {
|
sub call {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
my $ident = ident $self;
|
||||||
my $method = shift;
|
my $method = shift;
|
||||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
my $data = ref $_[0] ? $_[0] : { @_ };
|
||||||
|
|
||||||
my $content = q{};
|
$self->wsdlinit() if not ($definitions_of{ $ident });
|
||||||
my $envelope;
|
$self->_wsdl_init_methods() if not ($method_info_of{ $ident });
|
||||||
my $methodInfo;
|
|
||||||
|
my $client = $client_of{ $ident };
|
||||||
if (blessed $data
|
$client->set_proxy( $proxy_of{ $ident } || $port_of{ $ident }->get_location() );
|
||||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
$client->set_no_dispatch( $no_dispatch_of{ $ident } );
|
||||||
{
|
$client->set_outputxml( $outputtree_of{ $ident } ? 0 : 1 );
|
||||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
|
||||||
|
my $response = (blessed $data)
|
||||||
# TODO replace by something derived from binding - this is just a
|
? $client->call( $method, $data )
|
||||||
# workaround...
|
: do {
|
||||||
$methodInfo->{ soap_action }
|
|
||||||
= join '/', $data->get_xmlns(), $method;
|
my $content = '';
|
||||||
}
|
# TODO support RPC-encoding: Top-Level element + namespace...
|
||||||
else {
|
foreach my $part ( @{ $method_info_of{ $ident }->{ $method }->{ parts } } ) {
|
||||||
my $methodLookup = $self->{ _WSDL }->{ methodInfo }
|
$client->set_on_action( sub { $part->get_targetNamespace() . '/' . $_[1] } );
|
||||||
|| $self->_wsdl_init_methods();
|
$content .= $part->serialize( $method, $data,
|
||||||
|
{
|
||||||
$methodInfo = $methodLookup->{ $method };
|
%{ $serialize_options_of{ $ident } },
|
||||||
my $partListRef = $methodInfo->{ parts };
|
readable => $readable_of{ $ident },
|
||||||
|
} );
|
||||||
# set serializer options
|
}
|
||||||
# TODO allow custom options here
|
$client->call($method, $content);
|
||||||
my $opt = $self->{ _WSDL }->{ serialize_options };
|
};
|
||||||
|
|
||||||
# set response target namespace
|
return $response if (
|
||||||
# TODO make rpc-encoded encoding recognise this namespace
|
$outputxml_of{ $ident }
|
||||||
# $opt->{ targetNamespace } = $soap_binding_operation ?
|
# || $outputhash_of{ $ident }
|
||||||
# $operation->input()->namespace() : undef;
|
|| $outputtree_of{ $ident }
|
||||||
|
|| $no_dispatch_of{ $ident } );
|
||||||
# serialize content
|
|
||||||
# TODO create surrounding element for rpc-encoded messages
|
return unless $response; # nothing to do for one-ways
|
||||||
foreach my $part ( @{ $partListRef } ) {
|
# now convert into SOAP::SOM - bah !
|
||||||
$content .= $part->serialize( $method, $data, $opt );
|
require SOAP::Lite;
|
||||||
}
|
return SOAP::Deserializer->new()->deserialize( $response );
|
||||||
$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
|
|
||||||
|
|
||||||
sub explain {
|
sub explain {
|
||||||
my $self = shift;
|
my $ident = ident shift;
|
||||||
my $opt = $self->{ _WSDL }->{ explain_options };
|
my $opt = $explain_options_of{ $ident };
|
||||||
|
return $definitions_of{ $ident }->explain( $opt );
|
||||||
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
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
@@ -416,32 +282,53 @@ __END__
|
|||||||
=head1 NAME
|
=head1 NAME
|
||||||
|
|
||||||
SOAP::WSDL - SOAP with WSDL support
|
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
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
my $soap = SOAP::WSDL->new(
|
my $soap = SOAP::WSDL->new(
|
||||||
wsdl => 'file://bla.wsdl',
|
wsdl => 'file://bla.wsdl',
|
||||||
readable => 1,
|
readable => 1,
|
||||||
)->wsdlinit();
|
);
|
||||||
|
|
||||||
my $result = $soap->call('MyMethod', %data);
|
my $result = $soap->call('MyMethod', %data);
|
||||||
|
|
||||||
=head1 DESCRIPTION
|
=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.
|
The WSDL is parsed and stored in memory.
|
||||||
|
|
||||||
Your data is serialized according to the rules in the WSDL and sent via
|
Your data is serialized according to the rules in the WSDL.
|
||||||
SOAP::Lite's transport mechanism.
|
|
||||||
|
The only transport mechanisms currently supported are http and https.
|
||||||
|
|
||||||
=head1 METHODS
|
=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
|
=head2 wsdlinit
|
||||||
|
|
||||||
Reads the WSDL file and initializes SOAP::WSDL for working with it.
|
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
|
servicename
|
||||||
portname
|
portname
|
||||||
@@ -455,14 +342,6 @@ wsdlinit:
|
|||||||
portname => 'MyPort'
|
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
|
=head1 CONFIGURATION METHODS
|
||||||
|
|
||||||
=head2 outputtree
|
=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
|
Sets the service to operate on. If no service is set via servicename, the
|
||||||
first service found is used.
|
first service found is used.
|
||||||
|
|
||||||
Must be called after calling wsdlinit().
|
|
||||||
|
|
||||||
Returns the soap object, so you can chain calls like
|
Returns the soap object, so you can chain calls like
|
||||||
|
|
||||||
$soap->servicename->('Name')->portname('Port');
|
$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
|
Sets the port to operate on. If no port is set via portname, the
|
||||||
first port found is used.
|
first port found is used.
|
||||||
|
|
||||||
Must be called after calling wsdlinit().
|
|
||||||
|
|
||||||
Returns the soap object, so you can chain calls like
|
Returns the soap object, so you can chain calls like
|
||||||
|
|
||||||
$soap->portname('Port')->call('MyMethod', %data);
|
$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
|
When set, call() returns the plain request XML instead of dispatching the
|
||||||
SOAP call to the SOAP service. Handy for testing/debugging.
|
SOAP call to the SOAP service. Handy for testing/debugging.
|
||||||
|
|
||||||
=head2 _wsdl_init_methods
|
=head1 ACCESS TO SOAP::WSDL's internals
|
||||||
|
|
||||||
Creates a lookup table containing the information required for all methods
|
=head2 get_client / set_client
|
||||||
specified for the service/port selected.
|
|
||||||
|
Returns the SOAP client implementation used (normally a SOAP::WSDL::Client
|
||||||
The lookup table is used by L<call|call>.
|
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
|
=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
|
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.
|
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
|
=item * no_dispatch
|
||||||
|
|
||||||
@@ -581,33 +470,80 @@ You may pass the servicename and portname as attributes to wsdlinit, though.
|
|||||||
=back
|
=back
|
||||||
|
|
||||||
=head1 Differences to SOAP::Lite
|
=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.
|
SOAP::WSDL does B<does not> support auto-dispatching.
|
||||||
|
|
||||||
This is on purpose: You may easily create interface classes by using
|
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 {
|
sub mySoapMethod {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
$soap_wsdl_client->call( mySoapMethod, @_);
|
$soap_wsdl_client->call( mySoapMethod, @_);
|
||||||
}
|
}
|
||||||
|
|
||||||
You may even do this in a class factory - SOAP::WSDL provides the methods
|
You may even do this in a class factory - see L<wsdl2perl.pl> for creating
|
||||||
for generating such interfaces.
|
such interfaces.
|
||||||
|
|
||||||
SOAP::Lite's autodispatching mechanism is - though convenient - a constant
|
=head3 Debugging / Tracing
|
||||||
source of errors: Every typo in a method name gets caught by AUTOLOAD and
|
|
||||||
may lead to unpredictable results.
|
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
|
=head1 Bugs and Limitations
|
||||||
|
|
||||||
=over
|
=over
|
||||||
|
|
||||||
=item * readable
|
=item * SOAP Headers are not supported
|
||||||
|
|
||||||
readable() must be called before calling wsdlinit. This is a bug.
|
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
|
=item * Unsupported XML Schema definitions
|
||||||
|
|
||||||
@@ -619,7 +555,7 @@ The following XML Schema definitions are not supported:
|
|||||||
simpleContent
|
simpleContent
|
||||||
complexContent
|
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
|
If you have list elements with multiple occurences allowed, SOAP::WSDL
|
||||||
has no means of finding out which variant you meant.
|
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 2</item><item>3</item>
|
||||||
<item>1</item><item>2 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
|
=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:
|
currently implemented are:
|
||||||
|
|
||||||
fixed
|
fixed
|
||||||
@@ -651,7 +587,25 @@ The following facets have no influence yet:
|
|||||||
enumeration
|
enumeration
|
||||||
|
|
||||||
=back
|
=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
|
=head1 LICENSE
|
||||||
|
|
||||||
Copyright 2004-2007 Martin Kutter.
|
Copyright 2004-2007 Martin Kutter.
|
||||||
@@ -661,7 +615,7 @@ the same terms as perl itself
|
|||||||
|
|
||||||
=head1 AUTHOR
|
=head1 AUTHOR
|
||||||
|
|
||||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
|||||||
@@ -6,7 +6,8 @@ use Class::Std::Storable;
|
|||||||
use List::Util qw(first);
|
use List::Util qw(first);
|
||||||
|
|
||||||
my %id_of :ATTR(:name<id> :default<()>);
|
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 %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
|
||||||
my %xmlns_of :ATTR(:name<xmlns> :default<{}>);
|
my %xmlns_of :ATTR(:name<xmlns> :default<{}>);
|
||||||
my %parent_of :ATTR(:name<parent> :default<()>);
|
my %parent_of :ATTR(:name<parent> :default<()>);
|
||||||
|
|||||||
+135
-50
@@ -2,26 +2,45 @@ package SOAP::WSDL::Client;
|
|||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use Carp;
|
use Carp;
|
||||||
use Scalar::Util qw(blessed);
|
|
||||||
use SOAP::WSDL::Envelope;
|
|
||||||
use SOAP::Lite;
|
|
||||||
use Class::Std::Storable;
|
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::Expat::MessageParser;
|
||||||
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||||
|
|
||||||
# Package globals for speed...
|
# Package globals for speed...
|
||||||
my $PARSER;
|
my $PARSER;
|
||||||
my $MESSAGE_HANDLER;
|
|
||||||
|
|
||||||
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
|
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
|
||||||
my %no_dispatch_of :ATTR(:name<no_dispatch> :default<()>);
|
my %no_dispatch_of :ATTR(:name<no_dispatch> :default<()>);
|
||||||
my %outputxml_of :ATTR(:name<outputxml> :default<()>);
|
my %outputxml_of :ATTR(:name<outputxml> :default<()>);
|
||||||
my %proxy_of :ATTR(:name<proxy> :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
|
# TODO remove when preparing 2.01
|
||||||
sub outputtree { warn 'outputtree is deprecated and'
|
sub outputtree { warn 'outputtree is deprecated and'
|
||||||
. 'will be removed before reaching v2.01 !' }
|
. '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: {
|
SUBFACTORY: {
|
||||||
no strict qw(refs);
|
no strict qw(refs);
|
||||||
for (qw(class_resolver no_dispatch outputxml proxy)) {
|
for (qw(class_resolver no_dispatch outputxml proxy)) {
|
||||||
@@ -43,83 +62,84 @@ BEGIN {
|
|||||||
|
|
||||||
sub call {
|
sub call {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $method = shift;
|
my $method = shift;
|
||||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
my $ident = ident $self;
|
||||||
my $content = q{};
|
my $data = ref $_[0]
|
||||||
my ($envelope, $soap_action);
|
? $_[0]
|
||||||
|
: (@_>1)
|
||||||
|
? { @_ }
|
||||||
|
: $_[0];
|
||||||
|
|
||||||
|
my $soap_action;
|
||||||
|
my $trace_sub = $self->get_trace();
|
||||||
|
my $envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
||||||
|
|
||||||
if (blessed $data
|
if (blessed $data
|
||||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
&& $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
|
# TODO replace by something derived from binding - this is just a
|
||||||
# workaround...
|
# workaround...
|
||||||
$soap_action = join '/', $data->get_xmlns(), $method;
|
$soap_action = join '/', $data->get_xmlns(), $method;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
$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();
|
return $envelope if $self->no_dispatch();
|
||||||
|
|
||||||
# warn $envelope;
|
|
||||||
|
|
||||||
# get response via transport layer
|
# get response via transport layer
|
||||||
# TODO remove dependency from SOAP::Lite and use a
|
# maybe we should return a result with the following methods:
|
||||||
# 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
|
# - 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
|
# - header: returns the content of the SOAP header
|
||||||
# - fault: returns the result of the call if a SOAP fault is sent back
|
# - 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
|
# by the server. Retuns undef (nothing) if the call has been
|
||||||
# processed without errors.
|
# processed without errors.
|
||||||
my $soap = SOAP::Lite->new()->proxy( $self->get_proxy() );
|
my $ua = LWP::UserAgent->new();
|
||||||
my $response = $soap->transport->send_receive(
|
my $request = HTTP::Request->new( 'POST',
|
||||||
context => $self, # this is provided for context
|
$self->get_proxy(),
|
||||||
endpoint => $soap->endpoint(),
|
[ 'Content-Type', $content_type_of{ $ident },
|
||||||
action => $soap_action, # SOAPAction, should be from binding
|
'Content-Length', length($envelope),
|
||||||
envelope => $envelope, # use custom content
|
'SOAPAction', $soap_action,
|
||||||
);
|
],
|
||||||
|
$envelope );
|
||||||
# warn 'Received ' . length($response) . ' bytes of content';
|
|
||||||
return $response if ($self->outputxml() );
|
|
||||||
|
$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() );
|
$PARSER->class_resolver( $self->get_class_resolver() );
|
||||||
|
|
||||||
# if we had no success (Transport layer error status code)
|
# if we had no success (Transport layer error status code)
|
||||||
# or if transport layer failed
|
# or if transport layer failed
|
||||||
if (! $soap->transport->is_success() ) {
|
if ($response->code() != 200) {
|
||||||
# Try deserializing response - there may be some
|
# Try deserializing response - there may be some
|
||||||
if ($response) {
|
if ($response->content) {
|
||||||
eval { $PARSER->parse( $response ); };
|
eval { $PARSER->parse( $response->content() ); };
|
||||||
if ($@) {
|
return $PARSER->get_data() if (not $@);
|
||||||
warn "could not deserialize response: $@";
|
warn "could not deserialize response: $@";
|
||||||
}
|
|
||||||
else {
|
|
||||||
return $PARSER->get_data();
|
|
||||||
}
|
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
require SOAP::WSDL::SOAP::Typelib::Fault11;
|
|
||||||
# generate & return fault if we cannot serialize response
|
# generate & return fault if we cannot serialize response
|
||||||
# or have none...
|
# or have none...
|
||||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
return $fault_class_of{$ident}->new({
|
||||||
faultcode => 'soap:Server',
|
faultcode => 'soap:Server',
|
||||||
faultactor => 'urn:localhost',
|
faultactor => 'urn:localhost',
|
||||||
faultstring => 'Error sending / receiving message: '
|
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
|
# return fault if we cannot deserialize response
|
||||||
if ($@) {
|
if ($@) {
|
||||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
return $fault_class_of{$ident}->new({
|
||||||
faultcode => 'soap:Server',
|
faultcode => 'soap:Server',
|
||||||
faultactor => 'urn:localhost',
|
faultactor => 'urn:localhost',
|
||||||
faultstring => "Error deserializing message: $@. \n"
|
faultstring => "Error deserializing message: $@. \n"
|
||||||
@@ -133,6 +153,52 @@ sub call {
|
|||||||
1;
|
1;
|
||||||
|
|
||||||
=pod
|
=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
|
=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
|
so SOAP::Lite users can switch without looking up every method call in the
|
||||||
documentation.
|
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
|
=head3 SOAP request data
|
||||||
|
|
||||||
@@ -197,9 +263,28 @@ SOAP::WSDL::Client and implementing something like
|
|||||||
$soap_wsdl_client->call( mySoapMethod, @_);
|
$soap_wsdl_client->call( mySoapMethod, @_);
|
||||||
}
|
}
|
||||||
|
|
||||||
You may even do this in a class factory - SOAP::WSDL provides the methods
|
You may even do this in a class factory - see L<wsdl2perl.pl> for creating
|
||||||
for generating such interfaces.
|
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
|
=cut
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -1,4 +1,5 @@
|
|||||||
package SOAP::WSDL::Definitions;
|
package SOAP::WSDL::Definitions;
|
||||||
|
use utf8;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use Carp;
|
use Carp;
|
||||||
@@ -49,8 +50,7 @@ sub explain {
|
|||||||
my $txt = '';
|
my $txt = '';
|
||||||
|
|
||||||
for my $service (@{ $self->get_service() }) {
|
for my $service (@{ $self->get_service() }) {
|
||||||
$txt .= $service->explain( $opt );
|
$txt .= $service->explain( $opt ) . "\n";
|
||||||
$txt .= "\n";
|
|
||||||
}
|
}
|
||||||
return $txt;
|
return $txt;
|
||||||
}
|
}
|
||||||
@@ -101,49 +101,62 @@ sub create {
|
|||||||
sub _create_interface {
|
sub _create_interface {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $opt = shift;
|
my $opt = shift;
|
||||||
my $service_name = $opt->{ service }->get_name();
|
my $service_name = $opt->{ service }->get_name();
|
||||||
my $file_name = "$opt->{ base_path }/$opt->{ interface_prefix }/$service_name.pm";
|
$service_name =~s{\.}{\:\:}xmsg;
|
||||||
$file_name =~s{::}{/}gms;
|
# TODO: iterate over ports.
|
||||||
my $path = dirname $file_name;
|
# - ignore non-SOAP ports
|
||||||
my $name = basename $file_name;
|
# - generate interface for all SOAP ports...
|
||||||
my $binding = $self->find_binding( $self->_expand( $opt->{ service }->first_port()->get_binding() ) );
|
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 = $self->find_portType( $self->_expand( $binding->get_type() ) );
|
||||||
my $portType_operation_from_ref = $portType->get_operation();
|
|
||||||
|
my $port_operation_ref = $porttype->get_operation();
|
||||||
my $operation_ref = $binding->get_operation();
|
my $operation_ref = $binding->get_operation();
|
||||||
$operation_ref = [ $operation_ref ] if ref $operation_ref ne 'ARRAY';
|
|
||||||
my %operations = map {
|
# make up operations map - name => [ part types / elements class names ]
|
||||||
do {
|
#
|
||||||
my $operation_name = $_->get_name();
|
my %operations = ();
|
||||||
my $port_op = first { $_->get_name eq $operation_name } @{ $portType_operation_from_ref };
|
for my $operation ( @{ $operation_ref } ) {
|
||||||
my $input = $port_op->first_input()->get_message();
|
my $operation_name = $operation->get_name();
|
||||||
my $message = $self->find_message( $self->_expand( $input ) );
|
my $port_op = first { $_->get_name() eq $operation_name } @{ $port_operation_ref };
|
||||||
my $parts = $message->get_part;
|
|
||||||
( $operation_name => [
|
$operations{ $operation_name }->{ documentation } = $port_op->get_documentation();
|
||||||
map {
|
|
||||||
do {
|
my %msg_from = (
|
||||||
my $name;
|
'input' => ($port_op->first_input() ) ? $port_op->first_input()->get_message() : undef,
|
||||||
($name = $_->get_element())
|
'output' => ($port_op->first_output()) ? $port_op->first_output()->get_message(): undef,
|
||||||
? do {
|
'fault' => ($port_op->first_fault()) ? $port_op->first_fault()->get_message() : undef,
|
||||||
my ($prefix, $localname) = split m{:}xms , $name;
|
);
|
||||||
"$opt->{ element_prefix }$localname";
|
|
||||||
}
|
for my $msg (keys %msg_from) {
|
||||||
: ($name = $_->get_type())
|
next if not $msg_from{ $msg };
|
||||||
? do {
|
for my $part (@{ $self->find_message( $self->_expand( $msg_from{$msg} ) )->get_part }) {
|
||||||
my ($prefix, $localname) = split m{:}xms , $name;
|
my $name;
|
||||||
"$opt->{ type_prefix }$localname";
|
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 ) )
|
||||||
} @{ $parts }
|
->explain({ wsdl => $self , anonymous => 1 });
|
||||||
] );
|
|
||||||
};
|
}
|
||||||
} @{ $operation_ref };
|
elsif (my $type_name = $part->get_element() ) {
|
||||||
|
push @{ $operations{ $operation_name }->{$msg}->{ types } },
|
||||||
# use Data::Dumper;
|
$self->first_types()->find_type( $self->_expand( $element_name ) )
|
||||||
# die Dumper \%operations;
|
->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';
|
my $template = <<'EOT';
|
||||||
package [% interface_prefix %][% service.get_name %];
|
package [% interface_prefix %][% service.get_name.replace('\.', '::') %];
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use [% typemap_prefix %][% service.get_name %];
|
use [% typemap_prefix %][% service.get_name %];
|
||||||
@@ -153,7 +166,7 @@ sub new {
|
|||||||
my $class = shift;
|
my $class = shift;
|
||||||
my $arg_ref = shift || {};
|
my $arg_ref = shift || {};
|
||||||
my $self = $class->SUPER::new({
|
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 %]',
|
proxy => '[% service.first_port.get_location %]',
|
||||||
%{ $arg_ref }
|
%{ $arg_ref }
|
||||||
});
|
});
|
||||||
@@ -162,7 +175,7 @@ sub new {
|
|||||||
|
|
||||||
__PACKAGE__->__create_methods(
|
__PACKAGE__->__create_methods(
|
||||||
[% FOREACH name = operations.keys -%]
|
[% FOREACH name = operations.keys -%]
|
||||||
[% name %] => [ [% FOREACH class = operations.$name %]'[% class %]', [% END %]],
|
[% name %] => [ [% FOREACH class = operations.$name.input.class %]'[% class %]', [% END %]],
|
||||||
[% END %]
|
[% END %]
|
||||||
);
|
);
|
||||||
|
|
||||||
@@ -183,17 +196,38 @@ __END__
|
|||||||
my $[% operations.keys.1 %] = $interface->[% operations.keys.1 %]();
|
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
|
=cut
|
||||||
|
|
||||||
EOT
|
EOT
|
||||||
|
|
||||||
require Template;
|
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(
|
my $tt = Template->new(
|
||||||
OUTPUT_PATH => $path,
|
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();
|
or die $tt->error();
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -203,7 +237,8 @@ EOT
|
|||||||
sub _create_typemap {
|
sub _create_typemap {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $opt = 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";
|
my $file_name = "$opt->{ base_path }/$opt->{ typemap_prefix }/$service_name.pm";
|
||||||
$file_name =~s{::}{/}gms;
|
$file_name =~s{::}{/}gms;
|
||||||
my $path = dirname $file_name;
|
my $path = dirname $file_name;
|
||||||
@@ -212,11 +247,19 @@ sub _create_typemap {
|
|||||||
my $typemap = $opt->{ service }->to_typemap( { %{ $opt }, wsdl => $self } );
|
my $typemap = $opt->{ service }->to_typemap( { %{ $opt }, wsdl => $self } );
|
||||||
|
|
||||||
my $template = <<'EOT';
|
my $template = <<'EOT';
|
||||||
package [% typemap_prefix %][% service.get_name %];
|
package [% typemap_prefix %][% service.get_name.replace('\.', '::') %];
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
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 %]
|
[% typemap %]
|
||||||
[% custom_types %]
|
[% custom_types %]
|
||||||
);
|
);
|
||||||
@@ -237,7 +280,11 @@ EOT
|
|||||||
my $tt = Template->new(
|
my $tt = Template->new(
|
||||||
OUTPUT_PATH => $path,
|
OUTPUT_PATH => $path,
|
||||||
);
|
);
|
||||||
$tt->process(\$template, { %{ $opt }, typemap => $typemap }, $name)
|
$tt->process(\$template,
|
||||||
|
{ %{ $opt }, typemap => $typemap },
|
||||||
|
$name,
|
||||||
|
binmode => ':utf8',
|
||||||
|
)
|
||||||
or die $tt->error();
|
or die $tt->error();
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -5,23 +5,23 @@ use warnings;
|
|||||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||||
use XML::Parser::Expat;
|
use XML::Parser::Expat;
|
||||||
|
|
||||||
=pod
|
=pod
|
||||||
|
|
||||||
=head2 new
|
=head2 new
|
||||||
|
|
||||||
=over
|
=over
|
||||||
|
|
||||||
=item SYNOPSIS
|
=item SYNOPSIS
|
||||||
|
|
||||||
my $obj = ->new();
|
my $obj = ->new();
|
||||||
|
|
||||||
=item DESCRIPTION
|
=item DESCRIPTION
|
||||||
|
|
||||||
Constructor.
|
Constructor.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my $class = shift;
|
my $class = shift;
|
||||||
@@ -37,106 +37,131 @@ sub class_resolver {
|
|||||||
my $self = shift;
|
my $self = shift;
|
||||||
$self->{ class_resolver } = shift;
|
$self->{ class_resolver } = shift;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub parse {
|
sub _initialize {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $xml = shift;
|
|
||||||
$self->{ data } = undef;
|
$self->{ data } = undef;
|
||||||
|
|
||||||
my $characters;
|
my $characters;
|
||||||
my $current = '__STOP__';
|
my $current = undef;
|
||||||
my $ignore = [ 'Envelope', 'Body' ];
|
my $ignore = [ 'Envelope', 'Body' ]; # top level elements to ignore
|
||||||
my $list = [];
|
my $list = []; # node list
|
||||||
my $namespace = {};
|
my $path = []; # current path (without
|
||||||
my $path = [];
|
# number)
|
||||||
|
my $skip = 0; # skip elements
|
||||||
my $parser = XML::Parser::Expat->new();
|
my $parser = XML::Parser::Expat->new();
|
||||||
|
|
||||||
|
# use "globals" for speed
|
||||||
|
my ($_prefix, $_localname, $_element, $_method,
|
||||||
|
$_class, $_parser, %_attrs) = ();
|
||||||
|
|
||||||
no strict qw(refs);
|
no strict qw(refs);
|
||||||
$parser->setHandlers(
|
$parser->setHandlers(
|
||||||
Start => sub {
|
Start => sub {
|
||||||
my ($parser, $element, %attrs) = @_;
|
($_parser, $_element, %_attrs) = @_;
|
||||||
my ($prefix, $localname) = split m{:}xms , $element;
|
($_prefix, $_localname) = split m{:}xms , $_element;
|
||||||
# for non-prefixed elements
|
|
||||||
if (not $localname) {
|
$_localname ||= $_element; # for non-prefixed elements
|
||||||
$localname = $element;
|
|
||||||
$prefix = q{};
|
|
||||||
}
|
|
||||||
# ignore top level elements
|
# ignore top level elements
|
||||||
if (@{ $ignore } && $localname eq $ignore->[0]) {
|
if (@{ $ignore } && $_localname eq $ignore->[0]) {
|
||||||
shift @{ $ignore };
|
shift @{ $ignore };
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
# empty characters
|
|
||||||
$characters = q{};
|
push @{ $path }, $_localname; # step down in path
|
||||||
|
return if $skip; # skip inside __SKIP__
|
||||||
push @{ $path }, $localname; # step down...
|
|
||||||
push @{ $list }, $current; # remember current
|
|
||||||
|
|
||||||
# resolve class of this element
|
# 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 "
|
or die "Cannot resolve class for "
|
||||||
. join('/', @{ $path }) . " via $self->{ class_resolver }";
|
. 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
|
# Check whether we have a primitive - we implement them as classes
|
||||||
# TODO replace with UNIVERSAL->isa()
|
# TODO replace with UNIVERSAL->isa()
|
||||||
# match is a bit faster if the string does not match, but WAY slower
|
# match is a bit faster if the string does not match, but WAY slower
|
||||||
# if $class matches...
|
# 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.
|
# check wheter there is a CODE reference for $class::new.
|
||||||
# If not, require it - all classes required here MUST
|
# If not, require it - all classes required here MUST
|
||||||
# define new()
|
# define new()
|
||||||
# This is the same as $class->can('new'), but it's way faster
|
# This is the same as $class->can('new'), but it's way faster
|
||||||
*{ "$class\::new" }{ CODE }
|
*{ "$_class\::new" }{ CODE }
|
||||||
or eval "require $class" ## no critic qw(ProhibitStringyEval)
|
or eval "require $_class" ## no critic qw(ProhibitStringyEval)
|
||||||
or die $@;
|
or die $@;
|
||||||
}
|
}
|
||||||
# create object
|
|
||||||
# set current object
|
$current = $_class->new({ %_attrs }); # set new current object
|
||||||
$current = $class->new({ %attrs });
|
|
||||||
|
|
||||||
# remember top level element
|
# remember top level element
|
||||||
defined $self->{ data }
|
defined $self->{ data }
|
||||||
or ($self->{ data } = $current);
|
or ($self->{ data } = $current);
|
||||||
},
|
},
|
||||||
|
|
||||||
Char => sub {
|
Char => sub {
|
||||||
|
return if $skip;
|
||||||
$characters .= $_[1];
|
$characters .= $_[1];
|
||||||
},
|
},
|
||||||
|
|
||||||
End => sub {
|
End => sub {
|
||||||
my $element = $_[1];
|
$_element = $_[1];
|
||||||
|
|
||||||
my ($prefix, $localname) = split m{:}xms , $element;
|
($_prefix, $_localname) = split m{:}xms , $_element;
|
||||||
# for non-prefixed elements
|
$_localname ||= $_element; # for non-prefixed elements
|
||||||
if (not $localname) {
|
|
||||||
$localname = $element;
|
pop @{ $path }; # step up in path
|
||||||
$prefix = q{};
|
|
||||||
|
if ($skip) {
|
||||||
|
return if $skip ne join '/', @{ $path }, $_localname;
|
||||||
|
$skip = 0;
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# This one easily handles ignores for us, too...
|
# This one easily handles ignores for us, too...
|
||||||
return if not ref $list->[-1];
|
return if not ref $$list[-1];
|
||||||
|
|
||||||
if ( $current
|
# set characters in current if we are a simple type
|
||||||
->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType') ) {
|
# 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 );
|
$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
|
# set appropriate attribute in last element
|
||||||
# multiple values must be implemented in base class
|
# multiple values must be implemented in base class
|
||||||
my $method = "add_$localname";
|
$_method = "add_$_localname";
|
||||||
|
$$list[-1]->$_method( $current );
|
||||||
$list->[-1]->$method( $current );
|
|
||||||
|
$current = pop @$list; # step up in object hierarchy...
|
||||||
# step up in path
|
|
||||||
pop @{ $path };
|
|
||||||
|
|
||||||
# step up in object hierarchy...
|
|
||||||
$current = pop @{ $list };
|
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
return $parser;
|
||||||
$parser->parse( $xml );
|
}
|
||||||
|
|
||||||
|
sub parse {
|
||||||
|
$_[0]->_initialize->parse( $_[1] );
|
||||||
|
return $_[0]->{ data };
|
||||||
|
}
|
||||||
|
|
||||||
|
sub parsefile {
|
||||||
|
$_[0]->_initialize->parsefile( $_[1] );
|
||||||
|
return $_[0]->{ data };
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_data {
|
sub get_data {
|
||||||
@@ -144,7 +169,6 @@ sub get_data {
|
|||||||
return $self->{ data };
|
return $self->{ data };
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
=pod
|
=pod
|
||||||
@@ -167,6 +191,13 @@ Real fast expat based SOAP message parser.
|
|||||||
|
|
||||||
See L<SOAP::WSDL::Parser> for details.
|
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
|
=head1 Bugs and Limitations
|
||||||
|
|
||||||
=over
|
=over
|
||||||
|
|||||||
+147
-1
@@ -4,7 +4,7 @@
|
|||||||
|
|
||||||
SOAP::WSDL::Manual - accessing WSDL based web services
|
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
|
=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
|
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.
|
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
|
=head1 SEE ALSO
|
||||||
|
|
||||||
L<SOAP::WSDL::Manual::Glossary> The meaning of all these words
|
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
|
=head2 web service
|
||||||
|
|
||||||
Web services are RPC (Remote Procedure Call) interfaces accessible via
|
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
|
=head2 SOAP
|
||||||
|
|
||||||
@@ -21,7 +21,7 @@ SOAP services accessible via postcards.
|
|||||||
|
|
||||||
Despite it's name, SOAP has nothing more to do with objects than
|
Despite it's name, SOAP has nothing more to do with objects than
|
||||||
cars have with pets - SOAP messages may, but not neccessarily do
|
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.
|
carry your pet.
|
||||||
|
|
||||||
=head2 WSDL
|
=head2 WSDL
|
||||||
|
|||||||
@@ -3,7 +3,10 @@ use strict;
|
|||||||
use warnings;
|
use warnings;
|
||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
use base qw/SOAP::WSDL::Base/;
|
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 %operation_of :ATTR(:name<operation> :default<()>);
|
||||||
my %input_of :ATTR(:name<input> :default<()>);
|
my %input_of :ATTR(:name<input> :default<()>);
|
||||||
my %output_of :ATTR(:name<output> :default<()>);
|
my %output_of :ATTR(:name<output> :default<()>);
|
||||||
|
|||||||
@@ -90,6 +90,29 @@ A class resolver package might look like this:
|
|||||||
};
|
};
|
||||||
1;
|
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
|
=head3 Creating type lib classes
|
||||||
|
|
||||||
Every element must have a correspondent one in the type library.
|
Every element must have a correspondent one in the type library.
|
||||||
|
|||||||
@@ -3,13 +3,13 @@ use strict;
|
|||||||
use warnings;
|
use warnings;
|
||||||
use Carp;
|
use Carp;
|
||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
# use base qw(XML::SAX::Base);
|
|
||||||
use SOAP::WSDL::TypeLookup;
|
use SOAP::WSDL::TypeLookup;
|
||||||
|
|
||||||
my %tree_of :ATTR(:name<tree> :default<{}>);
|
my %tree_of :ATTR(:name<tree> :default<{}>);
|
||||||
my %order_of :ATTR(:name<order> :default<[]>);
|
my %order_of :ATTR(:name<order> :default<[]>);
|
||||||
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
|
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
|
||||||
my %current_of :ATTR(:name<current> :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
|
# 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...
|
# ...we ignore em all...
|
||||||
no strict qw(refs);
|
no strict qw(refs);
|
||||||
foreach my $method ( qw(
|
foreach my $method ( qw(
|
||||||
characters
|
|
||||||
processing_instruction
|
processing_instruction
|
||||||
ignorable_whitespace
|
ignorable_whitespace
|
||||||
set_document_locator
|
set_document_locator
|
||||||
@@ -87,7 +86,8 @@ sub start_element {
|
|||||||
$element->{ NamespaceURI },
|
$element->{ NamespaceURI },
|
||||||
$element->{ LocalName }
|
$element->{ LocalName }
|
||||||
);
|
);
|
||||||
|
|
||||||
|
$characters_of{ $ident } = q{};
|
||||||
return if not $action;
|
return if not $action;
|
||||||
|
|
||||||
if ($action->{ type } eq 'CLASS') {
|
if ($action->{ type } eq 'CLASS') {
|
||||||
@@ -138,28 +138,41 @@ sub start_element {
|
|||||||
: values %{ $element->{ Attributes } } );
|
: values %{ $element->{ Attributes } } );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub characters {
|
||||||
|
$characters_of{ ident $_[0] } .= $_[1]->{ Data };
|
||||||
|
}
|
||||||
|
|
||||||
sub end_element {
|
sub end_element {
|
||||||
my ($self, $element) = @_;
|
my ($self, $element) = @_;
|
||||||
my $ident = ident $self;
|
my $ident = ident $self;
|
||||||
|
|
||||||
my $action = SOAP::WSDL::TypeLookup->lookup(
|
my $action = SOAP::WSDL::TypeLookup->lookup(
|
||||||
$element->{ NamespaceURI },
|
$element->{ NamespaceURI },
|
||||||
$element->{ LocalName }
|
$element->{ LocalName }
|
||||||
) || {};
|
) || {};
|
||||||
|
|
||||||
if ($action->{ type } && $action->{ type } eq 'CLASS' )
|
return if not ($action->{ type });
|
||||||
{
|
if ( $action->{ type } eq 'CLASS' ) {
|
||||||
$current_of{ $ident } = pop @{ $order_of{ $ident } };
|
$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 {
|
sub fatal_error {
|
||||||
die @_;
|
die @_;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_data {
|
sub get_data {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
return $tree_of{ ident $self };
|
return $tree_of{ ident $self };
|
||||||
}
|
}
|
||||||
1;
|
1;
|
||||||
|
|||||||
+141
-119
@@ -1,129 +1,157 @@
|
|||||||
package SOAP::WSDL::TypeLookup;
|
package SOAP::WSDL::TypeLookup;
|
||||||
|
|
||||||
my %TYPES = (
|
my %TYPES = (
|
||||||
# wsdl:
|
# wsdl:
|
||||||
'http://schemas.xmlsoap.org/wsdl/' => {
|
'http://schemas.xmlsoap.org/wsdl/' => {
|
||||||
binding => {
|
binding => {
|
||||||
type => 'CLASS',
|
type => 'CLASS',
|
||||||
class => 'SOAP::WSDL::Binding',
|
class => 'SOAP::WSDL::Binding',
|
||||||
},
|
},
|
||||||
definitions => {
|
definitions => {
|
||||||
type => 'CLASS',
|
type => 'CLASS',
|
||||||
class => 'SOAP::WSDL::Definitions',
|
class => 'SOAP::WSDL::Definitions',
|
||||||
},
|
},
|
||||||
portType => {
|
portType => {
|
||||||
type => 'CLASS',
|
type => 'CLASS',
|
||||||
class => 'SOAP::WSDL::PortType',
|
class => 'SOAP::WSDL::PortType',
|
||||||
},
|
},
|
||||||
types => {
|
message => {
|
||||||
type => 'SKIP',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::Message',
|
||||||
message => {
|
},
|
||||||
type => 'CLASS',
|
part => {
|
||||||
class => 'SOAP::WSDL::Message',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::Part',
|
||||||
part => {
|
},
|
||||||
type => 'CLASS',
|
service => {
|
||||||
class => 'SOAP::WSDL::Part',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::Service',
|
||||||
service => {
|
},
|
||||||
type => 'CLASS',
|
port => {
|
||||||
class => 'SOAP::WSDL::Service',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::Port',
|
||||||
port => {
|
},
|
||||||
type => 'CLASS',
|
operation => {
|
||||||
class => 'SOAP::WSDL::Port',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::Operation',
|
||||||
operation => {
|
},
|
||||||
type => 'CLASS',
|
input => {
|
||||||
class => 'SOAP::WSDL::Operation',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::OpMessage',
|
||||||
input => {
|
},
|
||||||
type => 'CLASS',
|
output => {
|
||||||
class => 'SOAP::WSDL::OpMessage',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::OpMessage',
|
||||||
output => {
|
},
|
||||||
type => 'CLASS',
|
fault => {
|
||||||
class => 'SOAP::WSDL::OpMessage',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::OpMessage',
|
||||||
fault => {
|
},
|
||||||
type => 'CLASS',
|
types => {
|
||||||
class => 'SOAP::WSDL::OpMessage',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::Types',
|
||||||
types => {
|
},
|
||||||
type => 'CLASS',
|
documentation => {
|
||||||
class => 'SOAP::WSDL::Types',
|
type => 'CONTENT',
|
||||||
}
|
method => 'set_documentation',
|
||||||
},
|
}
|
||||||
# soap:
|
},
|
||||||
'http://schemas.xmlsoap.org/wsdl/soap/' => {
|
# soap:
|
||||||
operation => {
|
'http://schemas.xmlsoap.org/wsdl/soap/' => {
|
||||||
type => 'CLASS',
|
operation => {
|
||||||
class => 'SOAP::WSDL::SoapOperation',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::SoapOperation',
|
||||||
binding => {
|
},
|
||||||
type => 'PARENT',
|
binding => {
|
||||||
},
|
type => 'PARENT',
|
||||||
body => {
|
},
|
||||||
type => 'PARENT',
|
body => {
|
||||||
},
|
type => 'PARENT',
|
||||||
address => {
|
},
|
||||||
type => 'PARENT',
|
address => {
|
||||||
}
|
type => 'PARENT',
|
||||||
},
|
}
|
||||||
'http://www.w3c.org/2001/XMLSchema' => {
|
},
|
||||||
schema => {
|
'http://www.w3.org/2001/XMLSchema' => {
|
||||||
type => 'CLASS',
|
schema => {
|
||||||
class => 'SOAP::WSDL::XSD::Schema',
|
type => 'CLASS',
|
||||||
},
|
class => 'SOAP::WSDL::XSD::Schema',
|
||||||
element => {
|
},
|
||||||
type => 'CLASS',
|
attribute => {
|
||||||
class => 'SOAP::WSDL::XSD::Element',
|
type => 'SKIP' # not implemented yet
|
||||||
},
|
},
|
||||||
simpleType => {
|
attributeGroup => {
|
||||||
type => 'CLASS',
|
type => 'SKIP', # not implemented yet
|
||||||
class => 'SOAP::WSDL::XSD::SimpleType',
|
},
|
||||||
},
|
key => {
|
||||||
complexType => {
|
type => 'SKIP', # not implemented yet
|
||||||
type => 'CLASS',
|
},
|
||||||
class => 'SOAP::WSDL::XSD::ComplexType',
|
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 => {
|
simpleContent => {
|
||||||
type => 'METHOD',
|
type => 'METHOD',
|
||||||
method => 'set_contentModel',
|
method => 'set_contentModel',
|
||||||
value => 'simpleContent'
|
value => 'simpleContent'
|
||||||
|
},
|
||||||
|
complexContent => {
|
||||||
|
type => 'METHOD',
|
||||||
|
method => 'set_contentModel',
|
||||||
|
value => 'complexContent'
|
||||||
|
},
|
||||||
|
restriction => {
|
||||||
|
type => 'METHOD',
|
||||||
|
method => 'set_restriction',
|
||||||
},
|
},
|
||||||
complexContent => {
|
list => {
|
||||||
type => 'METHOD',
|
type => 'METHOD',
|
||||||
method => 'set_contentModel',
|
method => 'set_list',
|
||||||
value => 'complexContent'
|
},
|
||||||
|
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 => {
|
group => {
|
||||||
type => 'METHOD',
|
type => 'METHOD',
|
||||||
method => 'set_flavor',
|
method => 'set_flavor',
|
||||||
value => 'all',
|
value => 'all',
|
||||||
},
|
},
|
||||||
all => {
|
all => {
|
||||||
type => 'METHOD',
|
type => 'METHOD',
|
||||||
method => 'set_flavor',
|
method => 'set_flavor',
|
||||||
value => 'all',
|
value => 'all',
|
||||||
},
|
},
|
||||||
choice => {
|
choice => {
|
||||||
type => 'METHOD',
|
type => 'METHOD',
|
||||||
method => 'set_flavor',
|
method => 'set_flavor',
|
||||||
@@ -133,16 +161,10 @@ my %TYPES = (
|
|||||||
type => 'METHOD',
|
type => 'METHOD',
|
||||||
method => 'set_flavor',
|
method => 'set_flavor',
|
||||||
value => 'sequence',
|
value => 'sequence',
|
||||||
},
|
},
|
||||||
|
},
|
||||||
},
|
|
||||||
);
|
);
|
||||||
|
|
||||||
# thei're equal (typo ?)
|
|
||||||
$TYPES{ 'http://www.w3.org/2001/XMLSchema' } = $TYPES{
|
|
||||||
'http://www.w3c.org/2001/XMLSchema'
|
|
||||||
};
|
|
||||||
|
|
||||||
|
|
||||||
sub lookup {
|
sub lookup {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|||||||
@@ -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
|
return q{} if not $flavor; # empty complexType
|
||||||
$opt->{ indent } ||= q{ };
|
$opt->{ indent } ||= q{ };
|
||||||
my $xml = q{};
|
my $xml = q{};
|
||||||
$xml .= "$opt->{indent}\'$name'=> " if $name;
|
$xml .= "$opt->{indent}\'$name'=> {\n" if $name;
|
||||||
|
|
||||||
if ( ($flavor eq "sequence") or ($flavor eq "all") ) {
|
if ( ($flavor eq "sequence") or ($flavor eq "all") ) {
|
||||||
$xml .= "{\n";
|
$opt->{ indent } .= " ";
|
||||||
$opt->{ indent } .= " ";
|
for my $element (@{ $self->get_element() }) {
|
||||||
$xml .= join q{}, map { $_->explain( $opt ) }
|
$xml .= $element->explain( $opt )
|
||||||
@{ $self->get_element() };
|
}
|
||||||
$opt->{ indent } =~s/\s{2}$//; # step back
|
$opt->{ indent } =~s/\s{2}$//; # step back
|
||||||
$xml .= "$opt->{ indent }},\n";
|
|
||||||
}
|
}
|
||||||
elsif ($flavor eq "complexContent")
|
elsif ($flavor eq "complexContent")
|
||||||
{
|
{
|
||||||
@@ -150,6 +149,11 @@ sub explain {
|
|||||||
{
|
{
|
||||||
warn "found unsupported complexType definition $flavor";
|
warn "found unsupported complexType definition $flavor";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# if we're called inside a element...
|
||||||
|
$xml .= "$opt->{indent}},\n" if $name;
|
||||||
|
|
||||||
return $xml;
|
return $xml;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -300,26 +304,3 @@ sub _check_value {
|
|||||||
}
|
}
|
||||||
1;
|
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 {
|
sub explain {
|
||||||
my ($self, $opt, $name) = @_;
|
my ($self, $opt, $name) = @_;
|
||||||
my $type;
|
my $type;
|
||||||
my $text = q{};
|
my $text = q{};
|
||||||
|
|
||||||
# if we have a simple / complexType, explain right here
|
# if we have a simple / complexType, explain right here
|
||||||
if ($type = $self->first_simpleType() )
|
if ($type = $self->first_simpleType() )
|
||||||
{
|
{
|
||||||
$text .= $type->explain( $opt, $self->get_name() );
|
if ($opt->{ anonymous }) {
|
||||||
return $text;
|
delete $opt->{ anonymous };
|
||||||
|
return $type->explain( $opt, undef );
|
||||||
|
}
|
||||||
|
return $type->explain( $opt, $self->get_name() );
|
||||||
}
|
}
|
||||||
elsif ($type = $self->first_complexType() )
|
elsif ($type = $self->first_complexType() )
|
||||||
{
|
{
|
||||||
$text .= $type->explain( $opt, $self->get_name() );
|
if ($opt->{ anonymous }) {
|
||||||
return $text;
|
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
|
# return if it's not a derived type - we don't handle
|
||||||
@@ -137,12 +143,15 @@ sub explain {
|
|||||||
$ns_map{ $prefix }, $localname
|
$ns_map{ $prefix }, $localname
|
||||||
);
|
);
|
||||||
|
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
die "no type for $prefix:$localname ($ns_map{ $prefix })"
|
die "no type for $prefix:$localname ($ns_map{ $prefix })"
|
||||||
. Dumper $opt->{ wsdl }->first_types()->first_schema()->_DUMP
|
. 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 $text .= $type->explain( $opt, $self->get_name() );
|
||||||
return 'ERROR: '. $@;
|
return 'ERROR: '. $@;
|
||||||
}
|
}
|
||||||
@@ -369,47 +378,4 @@ EOT
|
|||||||
|
|
||||||
1;
|
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 warnings;
|
||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
use SOAP::WSDL::XSD::Schema;
|
use SOAP::WSDL::XSD::Schema;
|
||||||
use SOAP::WSDL::XSD::Primitive;
|
use SOAP::WSDL::XSD::Builtin;
|
||||||
use base qw(SOAP::WSDL::XSD::Schema);
|
use base qw(SOAP::WSDL::XSD::Schema);
|
||||||
|
|
||||||
# all builtin types - add validation (e.g. content restrictions) later...
|
# all builtin types - add validation (e.g. content restrictions) later...
|
||||||
my %PRIMITIVES = (
|
my %BUILTINS = (
|
||||||
'string' => {},
|
'string' => {},
|
||||||
'boolean' => {},
|
'boolean' => {},
|
||||||
'decimal' => {},
|
'decimal' => {},
|
||||||
@@ -50,9 +50,9 @@ sub START {
|
|||||||
my $self = shift;
|
my $self = shift;
|
||||||
my @args = @_;
|
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,
|
name => $name,
|
||||||
targetNamespace => 'http://www.w3.org/2001/XMLSchema',
|
targetNamespace => 'http://www.w3.org/2001/XMLSchema',
|
||||||
} )
|
} )
|
||||||
|
|||||||
@@ -43,8 +43,7 @@ sub set_union {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
sub push_enumeration
|
sub push_enumeration {
|
||||||
{
|
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my @attr = @_;
|
my @attr = @_;
|
||||||
my @attributes = @_;
|
my @attributes = @_;
|
||||||
@@ -101,13 +100,9 @@ sub _serialize_single {
|
|||||||
}
|
}
|
||||||
|
|
||||||
sub explain {
|
sub explain {
|
||||||
my ($self, $opt, $name) = @_;
|
my ($self, $opt, $name ) = @_;
|
||||||
my $perl;
|
$opt->{ indent } = q{} if not defined $opt->{ indent };
|
||||||
$opt->{ indent } ||= "";
|
return "$opt->{ indent }'$name' => \$someValue,\n"
|
||||||
$perl .= $opt->{ indent } if ($opt->{ readable });
|
|
||||||
$perl .= q{'} . $name . q{' => $someValue };
|
|
||||||
$perl .= "\n" if ($opt->{ readable });
|
|
||||||
return $perl;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub _check_value {
|
sub _check_value {
|
||||||
@@ -155,25 +150,4 @@ EOT
|
|||||||
return $code;
|
return $code;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
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
|
=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
|
=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
|
=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
|
=head2 SOAP::WSDL::XSD::Typelib::Builtin::IDREFS
|
||||||
|
|
||||||
|
List of SOAP::WSDL::XSD::Typelib::Builtin::IDREF objects.
|
||||||
|
|
||||||
Derived by SOAP::WSDL::XSD::Typelib::Builtin::list.
|
Derived by SOAP::WSDL::XSD::Typelib::Builtin::list.
|
||||||
|
|
||||||
=head2 SOAP::WSDL::XSD::Typelib::Builtin::int
|
=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
|
=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::token
|
||||||
|
|
||||||
=head2 SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte
|
=head2 SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte
|
||||||
|
|||||||
@@ -2,6 +2,9 @@ package SOAP::WSDL::XSD::Typelib::Builtin::date;
|
|||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
|
use Date::Parse;
|
||||||
|
use Date::Format;
|
||||||
|
|
||||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :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;
|
1;
|
||||||
|
|
||||||
|
|||||||
@@ -3,6 +3,8 @@ use strict;
|
|||||||
use warnings;
|
use warnings;
|
||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||||
|
use Date::Parse;
|
||||||
|
use Date::Format;
|
||||||
|
|
||||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||||
@@ -30,8 +32,31 @@ BEGIN {
|
|||||||
}
|
}
|
||||||
return $self;
|
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;
|
||||||
|
|||||||
@@ -1,6 +1,8 @@
|
|||||||
package SOAP::WSDL::XSD::Typelib::Builtin::time;
|
package SOAP::WSDL::XSD::Typelib::Builtin::time;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
use Date::Parse;
|
||||||
|
use Date::Format;
|
||||||
|
|
||||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||||
my %enumeration_of :ATTR(:name<enumeration> :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;
|
1;
|
||||||
|
|||||||
@@ -29,46 +29,70 @@ sub _factory {
|
|||||||
my $type = $CLASSES_OF{ $class }->{ $name }
|
my $type = $CLASSES_OF{ $class }->{ $name }
|
||||||
or die "No class given for $name";
|
or die "No class given for $name";
|
||||||
|
|
||||||
|
# require all types here - this is a slow check -
|
||||||
|
# TODO speedup
|
||||||
$type->isa('UNIVERSAL')
|
$type->isa('UNIVERSAL')
|
||||||
or eval "require $type"
|
or eval "require $type"
|
||||||
or croak $@;
|
or croak $@;
|
||||||
|
|
||||||
|
my $is_list = $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list');
|
||||||
|
|
||||||
*{ "$class\::set_$name" } = sub {
|
*{ "$class\::set_$name" } = sub {
|
||||||
my ($self, $value) = @_;
|
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:
|
we accept:
|
||||||
# a) objects
|
a) objects
|
||||||
# b) scalars
|
b) scalars
|
||||||
# c) list refs
|
c) list refs
|
||||||
# d) hash refs
|
d) hash refs
|
||||||
# e) mixed stuff of all of the above, so we have to
|
e) mixed stuff of all of the above, so we have to set our element to
|
||||||
# set our element to
|
a) value if it's an object
|
||||||
# a) value if it's an object
|
b) New object of expected class with value for simple values
|
||||||
# b) New object with value for simple values
|
c 1) New object with value for list values and list type
|
||||||
# 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 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) 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
|
||||||
# d) New object with values passed to new for HASH references
|
where the hash ref is passed to new as argument
|
||||||
#
|
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.
|
We throw an error on
|
||||||
$attribute_ref->{ ident $self } = blessed $value
|
a) list refs of list refs - don't know what to do with this (maybe use for lists of list types ?)
|
||||||
? $value
|
b) wrong object types
|
||||||
: ref $value
|
c) non-blessed non-ARRAY/HASH references - if you can define semantics
|
||||||
? ref $value eq 'ARRAY'
|
for GLOB references, feel free to add them.
|
||||||
? $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list')
|
d) we should also die for non-blessed non-ARRAY/HASH references in lists but don't do yet - oh my !
|
||||||
? $type->new({ value => $value })
|
|
||||||
: [ map {
|
=cut
|
||||||
blessed($_)
|
|
||||||
? ($_->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
my $is_ref = ref $value;
|
||||||
? $_
|
$attribute_ref->{ ident $self } = ($is_ref)
|
||||||
: croak 'cannot use non-XSD object as value'
|
? $is_ref eq 'ARRAY'
|
||||||
: $type->new({ value => $_ })
|
? $is_list
|
||||||
} @{ $value }
|
? $type->new({ value => $value })
|
||||||
]
|
: [ map {
|
||||||
: ref $value eq 'HASH'
|
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 )
|
? $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 });
|
: $type->new({ value => $value });
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -176,7 +200,7 @@ __END__
|
|||||||
|
|
||||||
=head1 NAME
|
=head1 NAME
|
||||||
|
|
||||||
SOAP::WSDL::XSD::Typelib::ComplexType - ComplexType XML Schema definitions
|
SOAP::WSDL::XSD::Typelib::ComplexType - complexType base class
|
||||||
|
|
||||||
=head1 Bugs and limitations
|
=head1 Bugs and limitations
|
||||||
|
|
||||||
|
|||||||
@@ -63,27 +63,71 @@ sub end_tag {
|
|||||||
1;
|
1;
|
||||||
|
|
||||||
=pod
|
=pod
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
SOAP::WSDL::XSD::Typelib::Element - element base clase
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=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;
|
package MyElement;
|
||||||
use strict;
|
use strict;
|
||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
use base (
|
use base (
|
||||||
'SOAP::WSDL::XSD::Typelib::Element',
|
'SOAP::WSDL::XSD::Typelib::Element',
|
||||||
|
'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||||
);
|
);
|
||||||
|
|
||||||
__PACKAGE__->__set_name('MyElementName');
|
__PACKAGE__->__set_name('MyElementName');
|
||||||
__PACKAGE__->__set_nillable(1);
|
__PACKAGE__->__set_nillable(1);
|
||||||
__PACKAGE__->__set_minOccurs(1);
|
__PACKAGE__->__set_minOccurs(1);
|
||||||
__PACKAGE__->__set_maxOccurs(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
|
=head1 BUGS AND LIMITATIONS
|
||||||
|
|
||||||
=over
|
=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
|
These attributes are not yet supported, though they may be set as class
|
||||||
properties via __PACKAGE__->__set_FOO methods.
|
properties via __PACKAGE__->__set_FOO methods.
|
||||||
|
|||||||
@@ -17,7 +17,7 @@ __END__
|
|||||||
|
|
||||||
=head1 NAME
|
=head1 NAME
|
||||||
|
|
||||||
SOAP::WSDL::XSD::Typelib::SimpleType - simple type base class
|
SOAP::WSDL::XSD::Typelib::SimpleType - simpleType base class
|
||||||
|
|
||||||
=head1 DESCRIPTION
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
|||||||
+1
-1
@@ -16,7 +16,7 @@ my @modules = qw(
|
|||||||
SOAP::WSDL::PortType
|
SOAP::WSDL::PortType
|
||||||
SOAP::WSDL::Types
|
SOAP::WSDL::Types
|
||||||
SOAP::WSDL::SAX::WSDLHandler
|
SOAP::WSDL::SAX::WSDLHandler
|
||||||
SOAP::WSDL::XSD::Primitive
|
SOAP::WSDL::XSD::Builtin
|
||||||
SOAP::WSDL::XSD::ComplexType
|
SOAP::WSDL::XSD::ComplexType
|
||||||
SOAP::WSDL::XSD::SimpleType
|
SOAP::WSDL::XSD::SimpleType
|
||||||
SOAP::WSDL::XSD::Element
|
SOAP::WSDL::XSD::Element
|
||||||
|
|||||||
+1
-1
@@ -174,7 +174,7 @@ sub xml
|
|||||||
targetNamespace="urn:myNamespace"
|
targetNamespace="urn:myNamespace"
|
||||||
xmlns="http://schemas.xmlsoap.org/wsdl/"
|
xmlns="http://schemas.xmlsoap.org/wsdl/"
|
||||||
xmlns:tns="urn:myNamespace"
|
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:soap="http://schemas.xmlsoap.org/wsdl/soap/"
|
||||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||||
>
|
>
|
||||||
|
|||||||
+1
-5
@@ -37,7 +37,7 @@ $pod->output_string( \$output );
|
|||||||
$pod->parse_string_document( $soap->explain() );
|
$pod->parse_string_document( $soap->explain() );
|
||||||
|
|
||||||
# print $output;
|
# print $output;
|
||||||
|
|
||||||
SKIP: {
|
SKIP: {
|
||||||
skip_without_test_xml();
|
skip_without_test_xml();
|
||||||
is_xml( $soap->call( 'EnqueueMessage' , EnqueueMessage => {
|
is_xml( $soap->call( 'EnqueueMessage' , EnqueueMessage => {
|
||||||
@@ -48,10 +48,6 @@ SKIP: {
|
|||||||
}
|
}
|
||||||
)
|
)
|
||||||
, q{<SOAP-ENV:Envelope
|
, 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/" >
|
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
|
||||||
<SOAP-ENV:Body ><EnqueueMessage xmlns="http://www.example.org/MessageGateway2/"><MMessage>
|
<SOAP-ENV:Body ><EnqueueMessage xmlns="http://www.example.org/MessageGateway2/"><MMessage>
|
||||||
<MRecipientURI>mailto:test@example.com</MRecipientURI>
|
<MRecipientURI>mailto:test@example.com</MRecipientURI>
|
||||||
|
|||||||
@@ -15,7 +15,7 @@ my $soap = SOAP::WSDL->new(
|
|||||||
wsdl => 'file:///' . $path .'/t/acceptance/wsdl/008_complexType.wsdl'
|
wsdl => 'file:///' . $path .'/t/acceptance/wsdl/008_complexType.wsdl'
|
||||||
)->wsdlinit();
|
)->wsdlinit();
|
||||||
|
|
||||||
my $wsdl = $soap->{ _WSDL }->{ wsdl_definitions };
|
my $wsdl = $soap->get_definitions;
|
||||||
my $schema = $wsdl->first_types();
|
my $schema = $wsdl->first_types();
|
||||||
my $type = $schema->find_type('Test' , 'testComplexTypeAll');
|
my $type = $schema->find_type('Test' , 'testComplexTypeAll');
|
||||||
my $element = $type->get_element()->[0];
|
my $element = $type->get_element()->[0];
|
||||||
|
|||||||
@@ -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";
|
||||||
+7
-15
@@ -2,26 +2,18 @@ use Test::More;
|
|||||||
eval "use Test::Pod 1.00";
|
eval "use Test::Pod 1.00";
|
||||||
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
|
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
|
||||||
|
|
||||||
use Cwd;
|
# perl Build test or make test run from top-level dir.
|
||||||
|
if ( -d '../t/' ) {
|
||||||
my $dir = cwd;
|
@directories = ('../lib/');
|
||||||
|
|
||||||
if ( $dir =~ /t$/ )
|
|
||||||
{
|
|
||||||
@directories = ('../lib/', '../bin/');
|
|
||||||
}
|
}
|
||||||
else
|
else {
|
||||||
{
|
@directories = (); # empty - will work automatically
|
||||||
@directories = ();
|
|
||||||
}
|
}
|
||||||
|
|
||||||
my @files = all_pod_files(
|
my @files = all_pod_files(@directories);
|
||||||
@directories
|
|
||||||
);
|
|
||||||
|
|
||||||
plan tests => scalar(@files);
|
plan tests => scalar(@files);
|
||||||
|
|
||||||
foreach my $module (@files)
|
foreach my $module (@files){
|
||||||
{
|
|
||||||
pod_file_ok( $module )
|
pod_file_ok( $module )
|
||||||
}
|
}
|
||||||
+3
-15
@@ -1,4 +1,4 @@
|
|||||||
use Test::More tests => 10;
|
use Test::More tests => 7;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use diagnostics;
|
use diagnostics;
|
||||||
@@ -26,22 +26,10 @@ ok( $soap = SOAP::WSDL->new(
|
|||||||
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
|
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
|
||||||
), 'Instantiated object' );
|
), 'Instantiated object' );
|
||||||
|
|
||||||
ok( $soap->wsdlinit(), 'parsed WSDL' );
|
|
||||||
|
|
||||||
ok( ($soap->servicename('testService') ), 'set service' );
|
ok( ($soap->servicename('testService') ), 'set service' );
|
||||||
ok( ($soap->portname('testPort') ) ,'set portname');
|
ok( ($soap->portname('testPort2') ) ,'set portname');
|
||||||
|
ok( $soap->wsdlinit(), 'parsed WSDL' );
|
||||||
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->wsdlinit( servicename => 'testService', portname => 'testPort'), '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');
|
ok( ($soap->portname() eq 'testPort' ), 'found port passed to wsdlinit');
|
||||||
@@ -59,14 +59,12 @@ TODO: {
|
|||||||
|
|
||||||
eval
|
eval
|
||||||
{
|
{
|
||||||
$xml = $soap->serializer->method(
|
$xml = $soap->call('test',
|
||||||
$soap->call('test',
|
|
||||||
testAll => {
|
testAll => {
|
||||||
Test1 => 'Test 1',
|
Test1 => 'Test 1',
|
||||||
Test2 => [ 'Test 2', 'Test 3' ]
|
Test2 => [ 'Test 2', 'Test 3' ]
|
||||||
}
|
}
|
||||||
)
|
);
|
||||||
);
|
|
||||||
};
|
};
|
||||||
|
|
||||||
ok( ($@ =~m/illegal\snumber\sof\selements/),
|
ok( ($@ =~m/illegal\snumber\sof\selements/),
|
||||||
@@ -74,13 +72,11 @@ ok( ($@ =~m/illegal\snumber\sof\selements/),
|
|||||||
);
|
);
|
||||||
|
|
||||||
eval {
|
eval {
|
||||||
$xml = $soap->serializer->method(
|
$xml = $soap->call('test',
|
||||||
$soap->call('test',
|
|
||||||
testAll => {
|
testAll => {
|
||||||
Test1 => 'Test 1',
|
Test1 => 'Test 1',
|
||||||
}
|
}
|
||||||
)
|
);
|
||||||
)
|
|
||||||
};
|
};
|
||||||
ok($@, 'Died on illegal number of elements (not enough)');
|
ok($@, 'Died on illegal number of elements (not enough)');
|
||||||
|
|
||||||
|
|||||||
@@ -35,8 +35,6 @@ ok( $soap->wsdlinit(
|
|||||||
servicename => 'testService',
|
servicename => 'testService',
|
||||||
), 'parsed WSDL' );
|
), 'parsed WSDL' );
|
||||||
$soap->no_dispatch(1);
|
$soap->no_dispatch(1);
|
||||||
$soap->serializer()->envprefix('SOAP-ENV');
|
|
||||||
$soap->serializer()->encprefix('SOAP-ENC');
|
|
||||||
|
|
||||||
#4
|
#4
|
||||||
ok $xml = $soap->call('test',
|
ok $xml = $soap->call('test',
|
||||||
@@ -46,33 +44,32 @@ ok $xml = $soap->call('test',
|
|||||||
}
|
}
|
||||||
), 'Serialized complexType';
|
), 'Serialized complexType';
|
||||||
|
|
||||||
#5
|
TODO: {
|
||||||
eval
|
local $TODO = "not implemented yet";
|
||||||
{
|
#5
|
||||||
$xml = $soap->serializer->method(
|
eval
|
||||||
$soap->call('test',
|
{
|
||||||
testSequence => {
|
$xml = $soap->call('test',
|
||||||
Test1 => 'Test 1',
|
testSequence => {
|
||||||
}
|
Test1 => 'Test 1',
|
||||||
)
|
}
|
||||||
);
|
);
|
||||||
};
|
};
|
||||||
ok( ($@),
|
ok( ($@),
|
||||||
"Died on illegal number of elements"
|
"Died on illegal number of elements"
|
||||||
);
|
);
|
||||||
|
|
||||||
#6
|
#6
|
||||||
eval
|
eval
|
||||||
{
|
{
|
||||||
$xml = $soap->serializer->method(
|
$xml = $soap->call('test',
|
||||||
$soap->call('test',
|
testSequence => {
|
||||||
testSequence => {
|
Test1 => 'Test 1',
|
||||||
Test1 => 'Test 1',
|
Test2 => [ 1, 2, 3, ]
|
||||||
Test2 => [ 1, 2, 3, ]
|
}
|
||||||
}
|
);
|
||||||
)
|
};
|
||||||
);
|
ok( ($@),
|
||||||
};
|
"Died on illegal number of elements"
|
||||||
ok( ($@),
|
);
|
||||||
"Died on illegal number of elements"
|
};
|
||||||
);
|
|
||||||
@@ -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') },
|
||||||
|
#~ }
|
||||||
@@ -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') },
|
||||||
|
#~ }
|
||||||
@@ -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