Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
 Martin Kutter
|
21efa286af | ||
|
Martin Kutter
|
008d06b72a | ||
|
Martin Kutter
|
c6a48ba84b | ||
|
Martin Kutter
|
30be0da3dc | ||
|
Martin Kutter
|
2347a88353 | ||
|
Martin Kutter
|
9e85f63aa0 | ||
|
Martin Kutter
|
7ba2f93e44 | ||
|
Martin Kutter
|
099c83b6bc | ||
|
Martin Kutter
|
f63138fc87 | ||
|
Martin Kutter
|
fd0854e34a | ||
|
Martin Kutter
|
c2da74b5ae | ||
|
Martin Kutter
|
7ba1959888 | ||
|
Martin Kutter
|
a554e87f49 | ||
|
Martin Kutter
|
312f3d6bbd |
No files matched your search
@@ -1,40 +1,45 @@
|
||||
use Module::Build;
|
||||
Module::Build->new(
|
||||
dist_abstract => 'SOAP with WSDL support',
|
||||
dist_name => 'SOAP-WSDL',
|
||||
dist_version => '2.00_07',
|
||||
module_name => 'SOAP::WSDL',
|
||||
license => 'artistic',
|
||||
requires => {
|
||||
'Class::Std' => q/v0.0.8/,
|
||||
'Class::Std::Storable' => 0,
|
||||
'SOAP::Lite' => 0,
|
||||
'List::Util' => 0,
|
||||
'File::Basename' => 0,
|
||||
'File::Path' => 0,
|
||||
'XML::XPath' => 0,
|
||||
'XML::LibXML' => 0,
|
||||
'XML::SAX::Base' => 0,
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
'XML::Parser::Expat' => 0,
|
||||
|
||||
$build = Module::Build->new(
|
||||
create_makefile_pl => 'passthrough',
|
||||
dist_abstract => 'SOAP with WSDL support',
|
||||
dist_name => 'SOAP-WSDL',
|
||||
dist_version => '2.00_18',
|
||||
module_name => 'SOAP::WSDL',
|
||||
license => 'artistic',
|
||||
requires => {
|
||||
'Class::Std' => q/v0.0.8/,
|
||||
'Class::Std::Storable' => 0,
|
||||
'Data::Dumper' => 0,
|
||||
'Date::Parse' => 0,
|
||||
'Date::Format' => 0,
|
||||
'File::Basename' => 0,
|
||||
'File::Path' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'List::Util' => 0,
|
||||
'LWP::UserAgent' => 0,
|
||||
'Template' => 0,
|
||||
'Term::ReadKey' => 0,
|
||||
'XML::Parser::Expat' => 0,
|
||||
},
|
||||
buildrequires => {
|
||||
'Benchmark' => 0,
|
||||
'Cwd' => 0,
|
||||
'Test::More' => 0,
|
||||
'SOAP::Lite' => 0,
|
||||
'Class::Std' => 0.0.8,
|
||||
'Class::Std::Storable' => 0,
|
||||
'List::Util' => 0,
|
||||
'File::Basename' => 0,
|
||||
'File::Path' => 0,
|
||||
'XML::Simple' => 0,
|
||||
'XML::LibXML' => 0,
|
||||
'XML::Parser::Expat' => 0,
|
||||
'XML::SAX::Base' => 0,
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
'Pod::Simple::Text' => 0,
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
'Class::Std' => q/v0.0.8/,
|
||||
'Class::Std::Storable' => 0,
|
||||
'Cwd' => 0,
|
||||
'Date::Parse' => 0,
|
||||
'Date::Format' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'List::Util' => 0,
|
||||
'LWP::UserAgent' => 0,
|
||||
'File::Basename' => 0,
|
||||
'File::Path' => 0,
|
||||
'File::Spec' => 0,
|
||||
'Storable' => 0,
|
||||
'Test::More' => 0,
|
||||
'Template' => 0,
|
||||
'XML::Parser::Expat' => 0,
|
||||
},
|
||||
recursive_test_files => 1,
|
||||
)->create_build_script;
|
||||
);
|
||||
$build->add_build_element('tt');
|
||||
$build->create_build_script;
|
||||
@@ -1 +1,354 @@
|
||||
See perldoc SOAP::WSDL
|
||||
Release notes for SOAP::WSDL 2.00_18
|
||||
-------
|
||||
|
||||
I'm proud to present a new pre-release version of SOAP::WSDL.
|
||||
|
||||
SOAP::WSDL is a toolkit for creating WSDL-based SOAP client interfaces in perl.
|
||||
|
||||
Features:
|
||||
|
||||
* WSDL based SOAP client
|
||||
o SOAP1.1 support
|
||||
o Supports document/literal message style/encoding
|
||||
* Code generator for generating WSDL-based interface classes
|
||||
o Generated code includes usage documentation for the web service interface
|
||||
* Easy-to use API
|
||||
o Automatically encodes perl data structures as message data
|
||||
o Automatically sets HTTP headers right
|
||||
* Efficient documentation
|
||||
o SOAP::WSDL::Manual guides you at getting your work done, not at
|
||||
the module's internals
|
||||
* Thorough test suite
|
||||
o SOAP::WSDL is heavily regression tested, with a test coverage of
|
||||
over 95%.
|
||||
* SOAP::Lite like look and feel
|
||||
o Where possible, SOAP::WSDL mimics SOAP::Lite's API to allow easy migrations
|
||||
* XML schema based class library for creating data objects
|
||||
* High-performance XML parser
|
||||
* Plugin support. SOAP::WSDL can be extended through plugins in various aspects.
|
||||
The following plugins are supported:
|
||||
o Transport plugins via SOAP::WSDL::Factory::Transport
|
||||
o Serializer plugins via SOAP::WSDL::Factory::Serializer
|
||||
o Deserializer plugins via SOAP::WSDL::Factory::Serializer
|
||||
|
||||
The following changes have been made:
|
||||
|
||||
2.00_18
|
||||
----
|
||||
The following features were added (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
|
||||
|
||||
* [ 1790983 ] Create generator Plugin API
|
||||
Generator factory is SOAP::WSDL::Factory::Generator
|
||||
|
||||
The following bugs have been fixed (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
|
||||
|
||||
* [ 1805252 ] t/SOAP/WSDL/XSD/Typelib/Builtin/004_time.t fails
|
||||
The default timezone conversion has been fixed.
|
||||
|
||||
The following uncategorized improvements have been made:
|
||||
|
||||
* Documentation improvements
|
||||
* Test updates
|
||||
* readable() has been converted into a no-op, as it already had no effect
|
||||
any more
|
||||
|
||||
2.00_17
|
||||
----
|
||||
The following features were added (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
|
||||
|
||||
The following bugs have been fixed (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
|
||||
|
||||
* [ 1772617 ] SOAP Header not working
|
||||
Added header support. Currently, SOAP headers are only supported with
|
||||
the SOM or the XSD (SOAP11) serializer.
|
||||
|
||||
* [ 1805238 ] Tests in t/SOAP/WSDL don't work when run from t/
|
||||
|
||||
* [ 1805241 ] explain() broken in SOAP::WSDL
|
||||
explain has been removed from SOAP::WSDL
|
||||
|
||||
The following uncategorized improvements have been made:
|
||||
|
||||
* Added limited support for complexType complexContent content model with
|
||||
restriction variety.
|
||||
SOAP::WSDL now supports this XML Schema definition variant, although no
|
||||
constraints are imposed on derived types yet.
|
||||
Derived types do not serialize with a xsi:type attribute (and the xsi:type
|
||||
attribute is not recognized by the XML parser), so you cannot use derived
|
||||
types as a substitute for theri parent, yet.
|
||||
|
||||
* Added support for complexType choice variety
|
||||
complexType definitions using the choice variety are now supported,
|
||||
even though the content is not checked (if you pass in invalid data,
|
||||
invalid XML will be generated).
|
||||
|
||||
* Added Loopback Transport backend.
|
||||
SOAP::WSDL::Tranport::Loopback just returns the request as respons, but
|
||||
allows testing the whole chain from user interface to transport backend.
|
||||
|
||||
* Fixed SOAP::WSDL::Factory::Transport prefer user-registered
|
||||
transport backend
|
||||
|
||||
* Fixed set_soap_version method in SOAP::WSDL::Client.
|
||||
Re-setting the SOAP version now invalidates (resets) serializer and
|
||||
deserializer, but not the transport backend.
|
||||
|
||||
* Fixed SOAP::WSDL::XSD::Typelib::Builtin::boolean to return false
|
||||
when false and true when true.
|
||||
|
||||
* SOAP::WSDL::XSD::Typelib::Builtin::normalizedString now replaces all
|
||||
occurences of tab, newline and carriage return by whitespce on set_value.
|
||||
|
||||
* Code cleanup
|
||||
o Lots of orphan methods now replaced by the SOAP::WSDL::Generator
|
||||
hierarchy have been removed.
|
||||
o Unused (and unusable) readable option checking has been removed in
|
||||
SOAP::WSDL::Serializer::SOAP11.
|
||||
o Unused XML Schema facet attributes have been removed from XSD Builtin
|
||||
classes
|
||||
o Methods common to all expat parser classes have been factored out
|
||||
into a common base class.
|
||||
|
||||
* XML serialization speedup for SOAP::WSDL::XSD::* objects
|
||||
|
||||
* Tests added to improve test coverage.
|
||||
|
||||
* A few documentation errors have been fixed
|
||||
|
||||
* Misspelled default Typemap and Interface prefixes have been corrected
|
||||
|
||||
2.00_16
|
||||
----
|
||||
The following features were added (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
|
||||
|
||||
* [ 1761532 ] Support embedded atomic types
|
||||
SOAP::WSDL now supports a greater variety of XML Schema type definitions.
|
||||
Note that XML Schema support is still incomplete, though.
|
||||
|
||||
* [ 1797943 ] Create Perl Hash Deserializer
|
||||
There's a new deserializer which outputs perl hashes as data structures.
|
||||
Much like XML::Simple, but faster. No XML Attribute support, though.
|
||||
|
||||
* [ 1797678 ] Move Code generator from WSDL::Definitions to separate class
|
||||
|
||||
* [ 1803330 ] Create one interface per port
|
||||
SOAP::WSDL now creats one interface per port, not one per service.
|
||||
|
||||
The following bugs have been fixed (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
|
||||
|
||||
* [ 1804441 ] parts from binding not regarded in SOAP::WSDL
|
||||
SOAP::WSDL (interpreter mode) now respects the body parts specified in the
|
||||
binding.
|
||||
|
||||
* [ 1803763 ] nonNegativeInteger misspelled in Schema::Builtin
|
||||
|
||||
* [ 1793965 ] _expand() does not work on non-root-node ns declarations
|
||||
|
||||
* [ 1792348 ] 006_client.t requires SOAP::Lite in 2.00_15
|
||||
SOAP::WSDL no longer attempts to load SOAP::WSDL::Deserializer::SOM when
|
||||
no_dispatch is set.
|
||||
006_client.t now sets outputxml(1), to be really sure.
|
||||
|
||||
The following uncategorized improvements have been made:
|
||||
|
||||
* Code generator only generates interface for the first port in a service
|
||||
The code generator now generates interfaces for all ports.
|
||||
Note: The naming scheme has changed. It is now
|
||||
InterfacePrefix::Service::Port
|
||||
|
||||
* XML Parser speedup
|
||||
The XML parser has received a little speedup.
|
||||
|
||||
* A number of errors in parsing / traversing WSDL documents have been
|
||||
corrected.
|
||||
|
||||
* Documentation has been improved
|
||||
|
||||
* A number of (incorrect, but passing) tests have been fixed.
|
||||
|
||||
* Code cleanup: The SOAP::WSDL::SAX* modules are no longer included, as they
|
||||
are not supported any more. They can still be found in SOAP::WSDL's
|
||||
subversion repository in the attic directory, though.
|
||||
|
||||
2.00_15
|
||||
----
|
||||
|
||||
The following bugs have been fixed (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
|
||||
|
||||
* [ 1792321 ] 2.00_14 requires SOAP::Lite for passing tests
|
||||
|
||||
2.00_14
|
||||
----
|
||||
|
||||
The following bugs have been fixed (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
|
||||
|
||||
* [ 1792235 ] SOAP::WSDL::Transport::Test missing from 2.00_13
|
||||
The package has been re-added
|
||||
|
||||
* [ 1792221 ] class_resolver not set from ::Client in 2.00_13
|
||||
Changed to set class_resolver correctly.
|
||||
|
||||
The following uncategorized improvements have been made:
|
||||
|
||||
* The ::SOM deserializer has been simplified to be just a subclass
|
||||
of SOAP::Deserializer from SOAP::Lite
|
||||
* Factories now emit more useful error messages when no class is registered
|
||||
for the protocol/soap_version requested
|
||||
* Documentation has been improved
|
||||
- refined ::Factory:: modules' documentation
|
||||
* Several tests have been added
|
||||
* XSD classes have been improved for testability
|
||||
|
||||
2.00_13
|
||||
----
|
||||
The following features were added (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
|
||||
|
||||
* [ 1790619 ] Test transport backend
|
||||
A test transport backend has been implemented (SOAP::WSDL::Transport::Test).
|
||||
It returns the contents from a file and discards the response.
|
||||
The filename is determined from the soap_action field.
|
||||
|
||||
* [ 1785196 ] Replace outputsom(1) by deserializer plugin
|
||||
outputsom(1) in SOAP::WSDL is now implemented via using the deserializer
|
||||
plugin SOAP::WSDL::Deserializer::SOM.
|
||||
|
||||
* [1785195] Support deserializer plugins
|
||||
Deserializer plugin API added via SOAP::WSDL::Factory::Deserializer.
|
||||
|
||||
The following bugs have been fixed (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
|
||||
|
||||
* [1789581] Support ComplexType mixed
|
||||
WSDL parser now supports using the mixed="true" attribute in complexType
|
||||
definitions. Mixed content in messages is only supported via SOAP::SOM yet.
|
||||
|
||||
* [1787975] 016_client_object.t fails due to testing XML as string
|
||||
Removed string test.
|
||||
|
||||
* [1787959] Test wsdl seems to be broken
|
||||
Corrected typo.
|
||||
|
||||
* [1787955] ::XSD::Typelib::date is broken
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::date now converts time-zoned dates properly,
|
||||
and adds the local time zone if none is given.
|
||||
|
||||
* [1785646] SOAPAction header not set from soap:operation soapAction
|
||||
SOAP::WSDL now sets the SOAPAction header correctly.
|
||||
|
||||
The following uncategorized improvements have been made:
|
||||
|
||||
* Documentation improvements
|
||||
|
||||
2.00_12
|
||||
----
|
||||
|
||||
The following bugs have been fixed (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
|
||||
|
||||
* [1787146] SOAP::WSDL still uses XML::LibXML
|
||||
The superficious usage of XML::LibXML has been removed. XML::LibXML with
|
||||
sax filter has been replaced by SOAP::WSDL::Expat::WSDLParser.
|
||||
|
||||
* [1787054] Test suite requires XML::LibXML in 2.00_11
|
||||
The test suite no longer requires XML::LibXML to pass.
|
||||
|
||||
* [1785678] SOAP envelope not checked for namespace
|
||||
The SOAP envelope is now checked for the correct namespace.
|
||||
|
||||
* [1786644] SOAP::WSDL::Manual - doc error
|
||||
Documentation improvements
|
||||
|
||||
The following uncategorized improvements have been made
|
||||
|
||||
* The SOAPAction header is now alway quoted (R1109 in WS-I BP 1.0).
|
||||
|
||||
2.00_11
|
||||
----
|
||||
|
||||
The following features were added (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
|
||||
|
||||
* [1767963] Transport plugins via SOAP::WSDL::Factory::Transport.
|
||||
SOAP::WSDL uses SOAP::Lite's tranport modules as default, with a
|
||||
lightweight HTTP(S) transport plugin as fallback.
|
||||
Custom transport modules can be registered via SOAP::WSDL::Factory::Transport.
|
||||
|
||||
* [ 1772730 ] Serializer plugins via SOAP::WSDL::Factory::Serializer
|
||||
The default serializer for SOAP1.1 is SOAP::WSDL::Serializer::SOAP11.
|
||||
Custom serializers classes can be registered via
|
||||
SOAP::WSDL::Factory::Serializer or set via SOAP::WSDL's set_serializer
|
||||
method.
|
||||
|
||||
The following bugs have been fixed (the numbers in square brackets are the
|
||||
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
|
||||
|
||||
* [ 1764854 ] Port WSDL parser to expat and remove XML::LibXML dependency
|
||||
SOAP::WSDL now requires only XML::Parser to be installed.
|
||||
XML::LibXML is not required any more, though XML::LibXML based modules still
|
||||
exist.
|
||||
|
||||
The following uncategorized improvements have been made
|
||||
|
||||
* The number of dependencies has been reduced. SOAP::WSDL no longer requires the
|
||||
following modules to be installed:
|
||||
- XML::SAX::Base
|
||||
- XML::SAX::ParserFactory
|
||||
- Pod::Simple::Text
|
||||
- XML::LibXML
|
||||
|
||||
* The missing prerequisite Template has been added.
|
||||
* Documentation has been improved:
|
||||
- WS-I Compliance document added.
|
||||
|
||||
|
||||
2.00_10
|
||||
----
|
||||
* Changed Makefile.PL to use Module::Build (passthrough mode)
|
||||
* fixed element ref="" handling
|
||||
|
||||
2.00_09
|
||||
----
|
||||
* SOAP::WSDL::XSD::Typelib::Builtin::boolean objects now return their numerical
|
||||
value in bool context, not "true" or "false" (always true...)
|
||||
* date/time test are now timezone-sensitive
|
||||
* examples added
|
||||
|
||||
2.00_08
|
||||
---
|
||||
* SOAP::WSDL::XSD::Typelib::ComplexType objects now check the class of their
|
||||
child objects.
|
||||
This provides early feedback to developers.
|
||||
* SOAP message parser can skip unwanted parts of the message to improve parsing
|
||||
speed - see SOAP::WSDL::Expat::MessageParser for details.
|
||||
* HTTP Content-Type is configurable
|
||||
* SOAP::WSDL::XSD::Typelib::ComplexType based objects accept any combination of
|
||||
hash refs, list refs and objects as parameter to set_value() and new().
|
||||
* SOAP::WSDL::XSD::Typelib::Builtin::dateTime and ::date convert date
|
||||
strings into XML date strings
|
||||
* SOAP::WSDL::Definitions::create now
|
||||
- converts '.' in service names to '::' (.NET class separator to perl class
|
||||
separator)
|
||||
- outputs Typemaps and Interface classes in UTF8 to allow proper inclusion
|
||||
of UTF8 documentation from WSDL
|
||||
* SOAP::WSDL::Definitions::create() includes doc in generated interface classes
|
||||
* WSDLHandler now handles <wsdl:documentation> tags
|
||||
* fixed explain in SimpleType, ComplexType and Element
|
||||
|
||||
2.00_07 and below
|
||||
---
|
||||
* Implemented a Code generator for creating SOAP interfaces based on WSDL definitions
|
||||
* Implemented a high-speed stream based SOAP message parser
|
||||
SOAP message parser returns a objects based on XML schema based class library
|
||||
* Implemented a XML schema based class library
|
||||
* Implemented a stream based WSDL parser.
|
||||
Parses WSDL into objects. Objects can serialize data, and explain how to use the
|
||||
service(s) they make up (output documentation).
|
||||
@@ -1,3 +1,9 @@
|
||||
benchmark/01_expat.t
|
||||
benchmark/smallprof.out
|
||||
benchmark/smallprof.out-whitespace
|
||||
benchmark/XSD/01_anyType.t
|
||||
benchmark/XSD/02_anySimpleType.t
|
||||
benchmark/XSD/03_string.t
|
||||
bin/wsdl2perl.pl
|
||||
Build.PL
|
||||
CHANGES
|
||||
@@ -20,7 +26,9 @@ example/lib/MyInterfaces/FullerData_x0020_Fortune_x0020_Cookie.pm
|
||||
example/lib/MyInterfaces/GlobalWeather.pm
|
||||
example/lib/MyTypemaps/FullerData_x0020_Fortune_x0020_Cookie.pm
|
||||
example/lib/MyTypemaps/GlobalWeather.pm
|
||||
example/visitor/visitor.pl
|
||||
example/weather.pl
|
||||
example/weather_wsdl.pl
|
||||
example/wsdl/FortuneCookie.xml
|
||||
example/wsdl/genericbarcode.xml
|
||||
example/wsdl/globalweather.xml
|
||||
@@ -31,28 +39,83 @@ lib/SOAP/WSDL/Binding.pm
|
||||
lib/SOAP/WSDL/Client.pm
|
||||
lib/SOAP/WSDL/Client/Base.pm
|
||||
lib/SOAP/WSDL/Definitions.pm
|
||||
lib/SOAP/WSDL/Envelope.pm
|
||||
lib/SOAP/WSDL/Deserializer/Hash.pm
|
||||
lib/SOAP/WSDL/Deserializer/SOAP11.pm
|
||||
lib/SOAP/WSDL/Deserializer/SOM.pm
|
||||
lib/SOAP/WSDL/Expat/Base.pm
|
||||
lib/SOAP/WSDL/Expat/Message2Hash.pm
|
||||
lib/SOAP/WSDL/Expat/MessageParser.pm
|
||||
lib/SOAP/WSDL/Expat/MessageStreamParser.pm
|
||||
lib/SOAP/WSDL/Expat/WSDLParser.pm
|
||||
lib/SOAP/WSDL/Factory/Deserializer.pm
|
||||
lib/SOAP/WSDL/Factory/Generator.pm
|
||||
lib/SOAP/WSDL/Factory/Serializer.pm
|
||||
lib/SOAP/WSDL/Factory/Transport.pm
|
||||
lib/SOAP/WSDL/Generator/Template.pm
|
||||
lib/SOAP/WSDL/Generator/Template/XSD.pm
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/_type_class.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType/all.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType/atomicTypes.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType/complexContent.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType/contentModel.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType/POD/all.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType/POD/choice.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType/POD/complexContent.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType/POD/restriction.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType/POD/structure.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/complexType/restriction.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/element.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/element/POD/structure.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Interface.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Interface/Body.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Interface/Header.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Interface/Operation.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Interface/POD/Element.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Interface/POD/Message.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Interface/POD/method_info.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Interface/POD/Operation.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Interface/POD/Part.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Interface/POD/Type.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/simpleType.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/simpleType/atomicType.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/simpleType/contentModel.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/simpleType/list.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/simpleType/POD/list.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/simpleType/POD/restriction.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/simpleType/POD/structure.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/simpleType/restriction.tt
|
||||
lib/SOAP/WSDL/Generator/Template/XSD/Typemap.tt
|
||||
lib/SOAP/WSDL/Generator/Visitor.pm
|
||||
lib/SOAP/WSDL/Generator/Visitor/Typelib.pm
|
||||
lib/SOAP/WSDL/Generator/Visitor/Typemap.pm
|
||||
lib/SOAP/WSDL/Manual.pod
|
||||
lib/SOAP/WSDL/Manual/Glossary.pod
|
||||
lib/SOAP/WSDL/Manual/Parser.pod
|
||||
lib/SOAP/WSDL/Manual/WS_I.pod
|
||||
lib/SOAP/WSDL/Manual/XSD.pod
|
||||
lib/SOAP/WSDL/Message.pm
|
||||
lib/SOAP/WSDL/Operation.pm
|
||||
lib/SOAP/WSDL/OpMessage.pm
|
||||
lib/SOAP/WSDL/Parser.pod
|
||||
lib/SOAP/WSDL/Part.pm
|
||||
lib/SOAP/WSDL/Port.pm
|
||||
lib/SOAP/WSDL/PortType.pm
|
||||
lib/SOAP/WSDL/SAX/MessageHandler.pm
|
||||
lib/SOAP/WSDL/SAX/WSDLHandler.pm
|
||||
lib/SOAP/WSDL/Serializer/SOAP11.pm
|
||||
lib/SOAP/WSDL/Service.pm
|
||||
lib/SOAP/WSDL/SOAP/Address.pm
|
||||
lib/SOAP/WSDL/SOAP/Body.pm
|
||||
lib/SOAP/WSDL/SOAP/Header.pm
|
||||
lib/SOAP/WSDL/SOAP/HeaderFault.pm
|
||||
lib/SOAP/WSDL/SOAP/Operation.pm
|
||||
lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
|
||||
lib/SOAP/WSDL/SoapOperation.pm
|
||||
lib/SOAP/WSDL/Transport/HTTP.pm
|
||||
lib/SOAP/WSDL/Transport/Loopback.pm
|
||||
lib/SOAP/WSDL/Transport/Test.pm
|
||||
lib/SOAP/WSDL/TypeLookup.pm
|
||||
lib/SOAP/WSDL/Types.pm
|
||||
lib/SOAP/WSDL/XSD/Builtin.pm
|
||||
lib/SOAP/WSDL/XSD/ComplexType.pm
|
||||
lib/SOAP/WSDL/XSD/Element.pm
|
||||
lib/SOAP/WSDL/XSD/Primitive.pm
|
||||
lib/SOAP/WSDL/XSD/Schema.pm
|
||||
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
||||
lib/SOAP/WSDL/XSD/SimpleType.pm
|
||||
@@ -107,14 +170,16 @@ lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Element.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||
LICENSE
|
||||
MAINFEST
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
META.yml
|
||||
README
|
||||
t/001_use.t
|
||||
t/002_sax.t
|
||||
t/003_sax_serializer.t
|
||||
t/004_sax_wsdl.t
|
||||
t/005_sax_contributed_wsdl.t
|
||||
t/002_parse_wsdl.t
|
||||
t/003_wsdl_based_serializer.t
|
||||
t/004_parse_wsdl.t
|
||||
t/005_parse_contributed.t
|
||||
t/006_client.t
|
||||
t/007_envelope.t
|
||||
t/008_client_wsdl_complexType.t
|
||||
@@ -122,10 +187,9 @@ t/009_data_classes.t
|
||||
t/011_simpleType.t
|
||||
t/012_element.t
|
||||
t/013_complexType.t
|
||||
t/014_sax_typelib.t
|
||||
t/015_to_typemap.t
|
||||
t/016_client_object.t
|
||||
t/017_generator.t
|
||||
t/018_compat_2_00_15-generator.t
|
||||
t/020_storable.t
|
||||
t/098_pod.t
|
||||
t/acceptance/results/03_complexType-all.xml
|
||||
@@ -140,6 +204,7 @@ t/acceptance/wsdl/006_sax_client.wsdl
|
||||
t/acceptance/wsdl/008_complexType.wsdl
|
||||
t/acceptance/wsdl/02_port.wsdl
|
||||
t/acceptance/wsdl/03_complexType-all.wsdl
|
||||
t/acceptance/wsdl/03_complexType-element-ref.wsdl
|
||||
t/acceptance/wsdl/03_complexType-sequence.wsdl
|
||||
t/acceptance/wsdl/04_element-simpleType.wsdl
|
||||
t/acceptance/wsdl/04_element.wsdl
|
||||
@@ -152,11 +217,21 @@ t/acceptance/wsdl/contributed/Axis.wsdl
|
||||
t/acceptance/wsdl/contributed/ETest.wsdl
|
||||
t/acceptance/wsdl/contributed/OITest.wsdl
|
||||
t/acceptance/wsdl/contributed/tools.wsdl
|
||||
t/acceptance/wsdl/elementAtomicComplexType.xml
|
||||
t/acceptance/wsdl/email_account.wsdl
|
||||
t/acceptance/wsdl/generator_test.wsdl
|
||||
t/acceptance/wsdl/generator_unsupported_test.wsdl
|
||||
t/acceptance/wsdl/message_gateway.wsdl
|
||||
t/contributed.wsdl
|
||||
t/Expat/01_expat.t
|
||||
t/Expat/03_wsdl.t
|
||||
t/lib/MyComplexType.pm
|
||||
t/lib/MyElement.pm
|
||||
t/lib/MyElements/GetWeather.pm
|
||||
t/lib/MyElements/GetWeatherResponse.pm
|
||||
t/lib/MyInterfaces/GlobalWeather.pm
|
||||
t/lib/MySimpleType.pm
|
||||
t/lib/MyTypemaps/GlobalWeather.pm
|
||||
t/lib/Test/SOAPMessage.pm
|
||||
t/lib/Typelib/Base.pm
|
||||
t/lib/Typelib/TEnqueueMessage.pm
|
||||
@@ -166,6 +241,7 @@ t/SOAP/WSDL/02_port.t
|
||||
t/SOAP/WSDL/03_complexType-all.t
|
||||
t/SOAP/WSDL/03_complexType-choice.t
|
||||
t/SOAP/WSDL/03_complexType-complexContent.t
|
||||
t/SOAP/WSDL/03_complexType-element-ref.t
|
||||
t/SOAP/WSDL/03_complexType-group.t
|
||||
t/SOAP/WSDL/03_complexType-sequence.t
|
||||
t/SOAP/WSDL/03_complexType-simpleContent.t
|
||||
@@ -175,8 +251,64 @@ t/SOAP/WSDL/04_element.t
|
||||
t/SOAP/WSDL/05_simpleType-list.t
|
||||
t/SOAP/WSDL/05_simpleType-restriction.t
|
||||
t/SOAP/WSDL/05_simpleType-union.t
|
||||
t/SOAP/WSDL/10_performance.t
|
||||
t/SOAP/WSDL/06_keep_alive.t
|
||||
t/SOAP/WSDL/11_helloworld.NET.t
|
||||
t/SOAP/WSDL/12_binding.pl
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/001_string.t
|
||||
t/SOAP/WSDL/12_binding.t
|
||||
t/SOAP/WSDL/Deserializer/Hash.t
|
||||
t/SOAP/WSDL/Deserializer/SOM.t
|
||||
t/SOAP/WSDL/Deserializer/XSD.t
|
||||
t/SOAP/WSDL/Factory/Deserializer.t
|
||||
t/SOAP/WSDL/Factory/Serializer.t
|
||||
t/SOAP/WSDL/Factory/Transport.t
|
||||
t/SOAP/WSDL/Generator/Template.t
|
||||
t/SOAP/WSDL/Generator/Visitor.t
|
||||
t/SOAP/WSDL/Generator/Visitor/Typemap.t
|
||||
t/SOAP/WSDL/Generator/XCS.t
|
||||
t/SOAP/WSDL/Generator/XSD.t
|
||||
t/SOAP/WSDL/Generator/XSD_unsupported.t
|
||||
t/SOAP/WSDL/Transport/01_Test.t
|
||||
t/SOAP/WSDL/Transport/02_HTTP.t
|
||||
t/SOAP/WSDL/Transport/acceptance/test2.xml
|
||||
t/SOAP/WSDL/Transport/acceptance/test3.xml
|
||||
t/SOAP/WSDL/Typelib/Fault11.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/01_constructors.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/anyType.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/boolean.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/byte.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/date.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/decimal.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/double.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/float.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/ID.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/int.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/integer.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/long.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/Name.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/NCName.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/short.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/string.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/time.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/token.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.t
|
||||
t/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.t
|
||||
t/test.wsdl
|
||||
TEST_COVERAGE
|
||||
TODO
|
||||
@@ -1,45 +1,83 @@
|
||||
---
|
||||
name: SOAP-WSDL
|
||||
version: 2.00_07
|
||||
author:
|
||||
version: 2.00_18
|
||||
author: []
|
||||
abstract: SOAP with WSDL support
|
||||
license: artistic
|
||||
resources:
|
||||
license: http://opensource.org/licenses/artistic-license.php
|
||||
requires:
|
||||
Class::Std: v0.0.8
|
||||
Class::Std::Storable: 0
|
||||
Data::Dumper: 0
|
||||
Date::Format: 0
|
||||
Date::Parse: 0
|
||||
File::Basename: 0
|
||||
File::Path: 0
|
||||
Getopt::Long: 0
|
||||
LWP::UserAgent: 0
|
||||
List::Util: 0
|
||||
SOAP::Lite: 0
|
||||
XML::LibXML: 0
|
||||
Template: 0
|
||||
Term::ReadKey: 0
|
||||
XML::Parser::Expat: 0
|
||||
XML::SAX::Base: 0
|
||||
XML::SAX::ParserFactory: 0
|
||||
XML::XPath: 0
|
||||
generated_by: Module::Build version 0.2808
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
||||
version: 1.2
|
||||
provides:
|
||||
SOAP::WSDL:
|
||||
file: lib/SOAP/WSDL.pm
|
||||
version: 2.00_05
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Base:
|
||||
file: lib/SOAP/WSDL/Base.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Binding:
|
||||
file: lib/SOAP/WSDL/Binding.pm
|
||||
SOAP::WSDL::Client:
|
||||
file: lib/SOAP/WSDL/Client.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Client::Base:
|
||||
file: lib/SOAP/WSDL/Client/Base.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Definitions:
|
||||
file: lib/SOAP/WSDL/Definitions.pm
|
||||
SOAP::WSDL::Envelope:
|
||||
file: lib/SOAP/WSDL/Envelope.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Deserializer::Hash:
|
||||
file: lib/SOAP/WSDL/Deserializer/Hash.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Deserializer::SOAP11:
|
||||
file: lib/SOAP/WSDL/Deserializer/SOAP11.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Deserializer::SOM:
|
||||
file: lib/SOAP/WSDL/Deserializer/SOM.pm
|
||||
version: 2.00_15
|
||||
SOAP::WSDL::Expat::Base:
|
||||
file: lib/SOAP/WSDL/Expat/Base.pm
|
||||
SOAP::WSDL::Expat::Message2Hash:
|
||||
file: lib/SOAP/WSDL/Expat/Message2Hash.pm
|
||||
SOAP::WSDL::Expat::MessageParser:
|
||||
file: lib/SOAP/WSDL/Expat/MessageParser.pm
|
||||
SOAP::WSDL::Expat::MessageStreamParser:
|
||||
file: lib/SOAP/WSDL/Expat/MessageStreamParser.pm
|
||||
SOAP::WSDL::Factory::Deserializer:
|
||||
file: lib/SOAP/WSDL/Factory/Deserializer.pm
|
||||
SOAP::WSDL::Factory::Generator:
|
||||
file: lib/SOAP/WSDL/Factory/Generator.pm
|
||||
version: 2.00_18
|
||||
SOAP::WSDL::Factory::Serializer:
|
||||
file: lib/SOAP/WSDL/Factory/Serializer.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Factory::Transport:
|
||||
file: lib/SOAP/WSDL/Factory/Transport.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Generator::Template:
|
||||
file: lib/SOAP/WSDL/Generator/Template.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Generator::Template::XSD:
|
||||
file: lib/SOAP/WSDL/Generator/Template/XSD.pm
|
||||
SOAP::WSDL::Generator::Visitor:
|
||||
file: lib/SOAP/WSDL/Generator/Visitor.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Generator::Visitor::Typelib:
|
||||
file: lib/SOAP/WSDL/Generator/Visitor/Typelib.pm
|
||||
SOAP::WSDL::Generator::Visitor::Typemap:
|
||||
file: lib/SOAP/WSDL/Generator/Visitor/Typemap.pm
|
||||
SOAP::WSDL::Message:
|
||||
file: lib/SOAP/WSDL/Message.pm
|
||||
SOAP::WSDL::OpMessage:
|
||||
@@ -52,32 +90,55 @@ provides:
|
||||
file: lib/SOAP/WSDL/Port.pm
|
||||
SOAP::WSDL::PortType:
|
||||
file: lib/SOAP/WSDL/PortType.pm
|
||||
SOAP::WSDL::SAX::MessageHandler:
|
||||
file: lib/SOAP/WSDL/SAX/MessageHandler.pm
|
||||
SOAP::WSDL::SOAP::Address:
|
||||
file: lib/SOAP/WSDL/SOAP/Address.pm
|
||||
SOAP::WSDL::SOAP::Body:
|
||||
file: lib/SOAP/WSDL/SOAP/Body.pm
|
||||
SOAP::WSDL::SOAP::Header:
|
||||
file: lib/SOAP/WSDL/SOAP/Header.pm
|
||||
SOAP::WSDL::SOAP::HeaderFault:
|
||||
file: lib/SOAP/WSDL/SOAP/HeaderFault.pm
|
||||
SOAP::WSDL::SOAP::Operation:
|
||||
file: lib/SOAP/WSDL/SOAP/Operation.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::SOAP::Typelib::Fault11:
|
||||
file: lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Serializer::SOAP11:
|
||||
file: lib/SOAP/WSDL/Serializer/SOAP11.pm
|
||||
version: 2.00_13
|
||||
SOAP::WSDL::Service:
|
||||
file: lib/SOAP/WSDL/Service.pm
|
||||
SOAP::WSDL::SoapOperation:
|
||||
file: lib/SOAP/WSDL/SoapOperation.pm
|
||||
SOAP::WSDL::Transport::HTTP:
|
||||
file: lib/SOAP/WSDL/Transport/HTTP.pm
|
||||
SOAP::WSDL::Transport::Loopback:
|
||||
file: lib/SOAP/WSDL/Transport/Loopback.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::Transport::Test:
|
||||
file: lib/SOAP/WSDL/Transport/Test.pm
|
||||
version: 2.00_14
|
||||
SOAP::WSDL::TypeLookup:
|
||||
file: lib/SOAP/WSDL/TypeLookup.pm
|
||||
SOAP::WSDL::Types:
|
||||
file: lib/SOAP/WSDL/Types.pm
|
||||
SOAP::WSDL::XSD::Builtin:
|
||||
file: lib/SOAP/WSDL/XSD/Builtin.pm
|
||||
SOAP::WSDL::XSD::ComplexType:
|
||||
file: lib/SOAP/WSDL/XSD/ComplexType.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::XSD::Element:
|
||||
file: lib/SOAP/WSDL/XSD/Element.pm
|
||||
SOAP::WSDL::XSD::Primitive:
|
||||
file: lib/SOAP/WSDL/XSD/Primitive.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::XSD::Schema:
|
||||
file: lib/SOAP/WSDL/XSD/Schema.pm
|
||||
SOAP::WSDL::XSD::Schema::Builtin:
|
||||
file: lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
||||
SOAP::WSDL::XSD::SimpleType:
|
||||
file: lib/SOAP/WSDL/XSD/SimpleType.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::XSD::Typelib::Builtin:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::ENTITY:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::ID:
|
||||
@@ -108,6 +169,7 @@ provides:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::boolean:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
|
||||
version: 2.00_17
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::byte:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::date:
|
||||
@@ -160,6 +222,7 @@ provides:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::time:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
|
||||
version: 2.00_18
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::token:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte:
|
||||
@@ -172,11 +235,14 @@ provides:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
|
||||
version: 2.00_16
|
||||
SOAP::WSDL::XSD::Typelib::Element:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Element.pm
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType::restriction:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||
resources:
|
||||
license: http://opensource.org/licenses/artistic-license.php
|
||||
generated_by: Module::Build version 0.2808
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
||||
version: 1.2
|
||||
+31
@@ -0,0 +1,31 @@
|
||||
# Note: this file was auto-generated by Module::Build::Compat version 0.03
|
||||
|
||||
unless (eval "use Module::Build::Compat 0.02; 1" ) {
|
||||
print "This module requires Module::Build to install itself.\n";
|
||||
|
||||
require ExtUtils::MakeMaker;
|
||||
my $yn = ExtUtils::MakeMaker::prompt
|
||||
(' Install Module::Build now from CPAN?', 'y');
|
||||
|
||||
unless ($yn =~ /^y/i) {
|
||||
die " *** Cannot install without Module::Build. Exiting ...\n";
|
||||
}
|
||||
|
||||
require Cwd;
|
||||
require File::Spec;
|
||||
require CPAN;
|
||||
|
||||
# Save this 'cause CPAN will chdir all over the place.
|
||||
my $cwd = Cwd::cwd();
|
||||
|
||||
CPAN::Shell->install('Module::Build::Compat');
|
||||
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
|
||||
or die "Couldn't install Module::Build, giving up.\n";
|
||||
|
||||
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
|
||||
}
|
||||
eval "use Module::Build::Compat 0.02; 1" or die $@;
|
||||
|
||||
Module::Build::Compat->run_build_pl(args => \@ARGV);
|
||||
require Module::Build;
|
||||
Module::Build::Compat->write_makefile(build_class => 'Module::Build');
|
||||
@@ -1,2 +1,26 @@
|
||||
INTRO
|
||||
-----
|
||||
|
||||
SOAP-WSDL provides a SOAP client with WSDL support.
|
||||
|
||||
This is a developer release - everything may (and most things will) change.
|
||||
|
||||
INSTALLING
|
||||
----------
|
||||
|
||||
Use the following mantra:
|
||||
|
||||
perl Build.PL
|
||||
perl Build
|
||||
perl Build test
|
||||
perl Build install
|
||||
|
||||
If you don't have Module::Build installed, you may also use
|
||||
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
Note that Module::Build is the recommended installer - make will not run
|
||||
all tests provided with SOAP-WSDL.
|
||||
@@ -0,0 +1,11 @@
|
||||
# Unfortunately, Build testcover reports test coverage wrong.
|
||||
#
|
||||
# To get a complete coverage report, just run this file as a shell script
|
||||
# on a linux box (or execute the equivalent commands on another OS):
|
||||
|
||||
cd t/
|
||||
|
||||
find . -type f -name '*.t' | xargs -n 1 /usr/bin/perl -MDevel::Cover=-silent,1,-summary,0 -I../lib
|
||||
|
||||
cover -ignore_re \.t$ -ignore_re ^lib -coverage="statement" -coverage=condition -coverage=subroutine -coverage="branch"
|
||||
|
||||
@@ -1,27 +1,27 @@
|
||||
- remove benchmarks from tests. Create benchmark/ directory and store benchmarks in.
|
||||
- SOAP::WSDL::Definitions::create creates bad interface docs. Fix it.
|
||||
- add tests for SOAP::WSDL::Definitions::create
|
||||
- test for correct creation
|
||||
- test against web service (fullerdata.com?)
|
||||
- Improve docs
|
||||
- Remove SOAP::Lite dependency - for now, just support HTTP(s) via LWP::UserAgent.
|
||||
- write inheritance Test for all XSD::Typelib::Builtin::* classes
|
||||
- Check & probably fix simpleType support.
|
||||
The WS at http://www.webservicex.net/genericbarcode.asmx?wsdl should make up a good example for simpleType
|
||||
definitions.
|
||||
- update all Builtin Types to new constructor BEGIN block (Class::Std unfortunately is way slow)
|
||||
- DONE.
|
||||
- Remove useless (but on CPAN annoying) doc from Builtin::* classes
|
||||
- DONE
|
||||
- add example WS scripts
|
||||
- DONE.
|
||||
- SOAP::WSDL::XSD::Typelib::Builtin::string does not unescape XML builtin entities on get_value()
|
||||
- WONTFIX.
|
||||
Entities are unescaped by XML parser.
|
||||
If you want the plain value, you have to use get_value, as XML conversion is overloaded on stringification.
|
||||
- Make callin WS easier: implent WS-I-based SOAP::WSDL::Client::WSI
|
||||
- WONTFIX - SOAP::WSDL::Base should behave equal
|
||||
- add capability to create request objects based on input part definitions to SOAP::WSDL::Client::Base
|
||||
- DONE.
|
||||
TODO list for SOAP::WSDL
|
||||
|
||||
2.00 Pre-releases
|
||||
--------
|
||||
* Implement a Generator Plugin API
|
||||
|
||||
* Implement a interface similar to SOAP::Schema (#1783639)
|
||||
|
||||
2.1 release
|
||||
--------
|
||||
* Support namespaces in SOAP message payload
|
||||
|
||||
* Support the xsi:type attribute on derived types on the wire
|
||||
|
||||
* SOAP1.2 support
|
||||
|
||||
2.2 release
|
||||
--------
|
||||
* XML schema support ("minimal conformant") (#1764845)
|
||||
|
||||
* Support SOAP attachments
|
||||
|
||||
* Act as SOAP Server
|
||||
|
||||
3.0 release
|
||||
--------
|
||||
We're not thinking that far ahead right now.
|
||||
@@ -0,0 +1,97 @@
|
||||
#!/usr/bin/perl -w
|
||||
%DB::packages=(SOAP::WSDL::Expat::MessageParser => 1);
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib '../lib';
|
||||
use lib 'lib';
|
||||
use lib '../t/lib';
|
||||
# use SOAP::WSDL::SAX::MessageHandler;
|
||||
|
||||
use Benchmark;
|
||||
use SOAP::WSDL::Expat::MessageParser;
|
||||
use SOAP::WSDL::Expat::Message2Hash;
|
||||
use XML::Simple;
|
||||
use XML::LibXML;
|
||||
use MyComplexType;
|
||||
use MyElement;
|
||||
use MySimpleType;
|
||||
|
||||
my $xml = q{<SOAP-ENV:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
|
||||
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
|
||||
<SOAP-ENV:Body><MyAtomicComplexTypeElement xmlns="urn:Test" >
|
||||
<test>Test</test>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test2 >Test2</test2>
|
||||
<test>Test</test>
|
||||
<test>Test</test>
|
||||
<test>Test</test>
|
||||
<test>Test</test>
|
||||
<test>Test</test>
|
||||
<test>Test</test>
|
||||
<test>Test</test>
|
||||
<test>Test</test>
|
||||
<test>Test</test>
|
||||
<test>Test</test>
|
||||
<test>Test</test>
|
||||
</MyAtomicComplexTypeElement>
|
||||
</SOAP-ENV:Body></SOAP-ENV:Envelope>};
|
||||
|
||||
|
||||
my $parser = SOAP::WSDL::Expat::MessageParser->new({
|
||||
class_resolver => 'FakeResolver'
|
||||
});
|
||||
|
||||
my $hash_parser = SOAP::WSDL::Expat::Message2Hash->new();
|
||||
|
||||
$XML::Simple::PREFERRED_PARSER = 'XML::Parser';
|
||||
|
||||
my $libxml = XML::LibXML->new();
|
||||
my @data;
|
||||
timethese 10000,
|
||||
{
|
||||
'Hash (SOAP:WSDL)' => sub { push @data, $hash_parser->parse( $xml ) },
|
||||
'XSD (SOAP::WSDL)' => sub { push @data, $parser->parse( $xml ) },
|
||||
'XML::Simple (Hash)' => sub { push @data, XMLin $xml },
|
||||
# 'XML::LibXML (DOM)' => sub { push @data, $libxml->parse_string( $xml ) },
|
||||
};
|
||||
|
||||
# use Test::More tests => 1;
|
||||
#is $parser->get_data(), q{<MyAtomicComplexTypeElement xmlns="urn:Test" >}
|
||||
# . q{<test >Test</test><test2 >Test2</test2></MyAtomicComplexTypeElement>}
|
||||
# , 'Content comparison';
|
||||
|
||||
#$parser->class_resolver( 'FakeResolver2' );
|
||||
|
||||
|
||||
# data classes reside in t/lib/Typelib/
|
||||
BEGIN {
|
||||
package FakeResolver;
|
||||
{
|
||||
my %class_list = (
|
||||
'MyAtomicComplexTypeElement' => 'MyAtomicComplexTypeElement',
|
||||
'MyAtomicComplexTypeElement/test' => 'MyTestElement',
|
||||
'MyAtomicComplexTypeElement/test2' => 'MyTestElement2',
|
||||
);
|
||||
|
||||
sub get_map { return \%class_list };
|
||||
|
||||
sub new { return bless {}, 'FakeResolver' };
|
||||
|
||||
sub get_class {
|
||||
my $name = join('/', @{ $_[1] });
|
||||
return ($class_list{ $name }) ? $class_list{ $name }
|
||||
: warn "no class found for $name";
|
||||
};
|
||||
};
|
||||
};
|
||||
@@ -0,0 +1,21 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Benchmark;
|
||||
use lib '../../lib';
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::anyType;
|
||||
|
||||
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::anyType->new();
|
||||
|
||||
timethese 10000, {
|
||||
'new' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anyType->new() },
|
||||
'new with params' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anyType->new({
|
||||
xmlns => 'urn:Test'
|
||||
}) },
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
};
|
||||
|
||||
my $data;
|
||||
timethese 1000000, {
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
'get_FOO' => sub { $data = $obj->get_xmlns() },
|
||||
};
|
||||
@@ -0,0 +1,22 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Benchmark;
|
||||
use lib '../../lib';
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
|
||||
|
||||
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new();
|
||||
|
||||
timethese 10000, {
|
||||
'new' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new() },
|
||||
'new + params' => sub { SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({
|
||||
xmlns => 'urn:Test',
|
||||
value => 'Teststring'
|
||||
}) },
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
};
|
||||
|
||||
my $data;
|
||||
timethese 1000000, {
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
'get_FOO' => sub { $data = $obj->get_xmlns() },
|
||||
};
|
||||
@@ -0,0 +1,22 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use Benchmark;
|
||||
use lib '../../lib';
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::string;
|
||||
|
||||
my $obj = SOAP::WSDL::XSD::Typelib::Builtin::string->new();
|
||||
|
||||
timethese 10000, {
|
||||
'new' => sub { SOAP::WSDL::XSD::Typelib::Builtin::string->new() },
|
||||
'new + params' => sub { SOAP::WSDL::XSD::Typelib::Builtin::string->new({
|
||||
xmlns => 'urn:Test',
|
||||
value => 'Teststring'
|
||||
}) },
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
};
|
||||
|
||||
my $data;
|
||||
timethese 1000000, {
|
||||
'set_FOO' => sub { $obj->set_xmlns('Test') },
|
||||
'get_FOO' => sub { $data = $obj->get_xmlns() },
|
||||
};
|
||||
@@ -0,0 +1,324 @@
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 1
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
0 0.00000 0.00000 1:#!/usr/bin/perl
|
||||
0 0.00000 0.00000 2:package SOAP::WSDL::Expat::MessageParser;
|
||||
0 0.00000 0.00000 3:use strict;
|
||||
0 0.00000 0.00000 4:use warnings;
|
||||
0 0.00000 0.00000 5:use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
0 0.00000 0.00000 6:use XML::Parser::Expat;
|
||||
0 0.00000 0.00000 7:
|
||||
0 0.00000 0.00000 8:sub new {
|
||||
1 0.00000 0.00000 9: my ($class, $args) = @_;
|
||||
0 0.00000 0.00000 10: my $self = {
|
||||
0 0.00000 0.00000 11: class_resolver => $args->{
|
||||
1 0.00001 0.00000 12: strict => exists $args->{ strict } ?
|
||||
0 0.00000 0.00000 13: };
|
||||
1 0.00001 0.00000 14: bless $self, $class;
|
||||
1 0.02383 0.02000 15: return $self;
|
||||
0 0.00000 0.00000 16:}
|
||||
0 0.00000 0.00000 17:
|
||||
0 0.00000 0.00000 18:sub class_resolver {
|
||||
0 0.00000 0.00000 19: my $self = shift;
|
||||
0 0.00000 0.00000 20: $self->{ class_resolver } = shift;
|
||||
0 0.00000 0.00000 21: return;
|
||||
0 0.00000 0.00000 22:}
|
||||
0 0.00000 0.00000 23:
|
||||
0 0.00000 0.00000 24:sub _initialize {
|
||||
1000 0.00098 0.01000 25: my ($self, $parser) = @_;
|
||||
1000 0.04304 0.02000 26: $self->{ parser } = $parser;
|
||||
0 0.00000 0.00000 27:
|
||||
1000 0.00140 0.01000 28: delete $self->{ data };
|
||||
0 0.00000 0.00000 29:
|
||||
1000 0.00042 0.03000 30: my $characters;
|
||||
0 0.00000 0.00000 31: #my @characters_from = ();
|
||||
1000 0.00059 0.00000 32: my $current = undef;
|
||||
1000 0.00093 0.00000 33: my $list = []; #
|
||||
1000 0.00065 0.02000 34: my $path = []; #
|
||||
1000 0.00064 0.02000 35: my $skip = 0; #
|
||||
1000 0.00049 0.01000 36: my $current_part = q{}; # are
|
||||
0 0.00000 0.00000 37:
|
||||
1000 0.00041 0.00000 38: my $depth = 0;
|
||||
0 0.00000 0.00000 39:
|
||||
0 0.00000 0.00000 40: my %content_check = $self->{strict}
|
||||
0 0.00000 0.00000 41: ? (
|
||||
0 0.00000 0.00000 42: 0 => sub {
|
||||
1000 0.00115 0.00000 43: die "Bad top node $_[1]"
|
||||
1000 0.01666 0.03000 44: die "Bad namespace for
|
||||
0 0.00000 0.00000 45: if $_[0]-
|
||||
1000 0.00051 0.02000 46: $depth++;
|
||||
1000 0.00413 0.01000 47: return;
|
||||
0 0.00000 0.00000 48: },
|
||||
0 0.00000 0.00000 49: 1 => sub {
|
||||
1000 0.00050 0.02000 50: $depth++;
|
||||
1000 0.03690 0.04000 51: return;
|
||||
0 0.00000 0.00000 52: }
|
||||
0 0.00000 0.00000 53: )
|
||||
1000 0.01120 0.03000 54: : ();
|
||||
0 0.00000 0.00000 55:
|
||||
0 0.00000 0.00000 56: my $char_handler = sub {
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 2
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
0 0.00000 0.00000 57: # push @characters_from, $_[1] if
|
||||
80000 0.19296 1.00000 58: $characters .= $_[1] if $_[1]
|
||||
0 0.00000 0.00000 59:
|
||||
80000 0.27660 0.97000 60: return;
|
||||
1000 0.00449 0.00000 61: };
|
||||
0 0.00000 0.00000 62:
|
||||
0 0.00000 0.00000 63: # use "globals" for speed
|
||||
1000 0.00162 0.01000 64: my ($_prefix, $_method,
|
||||
0 0.00000 0.00000 65: $_class) = ();
|
||||
0 0.00000 0.00000 66:
|
||||
0 0.00000 0.00000 67: no strict qw(refs);
|
||||
0 0.00000 0.00000 68: $parser->setHandlers(
|
||||
0 0.00000 0.00000 69: Start => sub {
|
||||
0 0.00000 0.00000 70: # my ($parser, $element, %_attrs)
|
||||
0 0.00000 0.00000 71: # $depth = $parser->depth();
|
||||
0 0.00000 0.00000 72:
|
||||
0 0.00000 0.00000 73: # call methods without using
|
||||
0 0.00000 0.00000 74: # That's slightly faster than
|
||||
0 0.00000 0.00000 75: # and we don't have to pass $_[1]
|
||||
0 0.00000 0.00000 76: # Yup, that's dirty.
|
||||
28000 0.03037 0.32000 77: return &{$content_check{ $depth
|
||||
0 0.00000 0.00000 78:
|
||||
26000 0.02735 0.15000 79: push @{ $path }, $_[1]; #
|
||||
26000 0.01366 0.29000 80: return if $skip; #
|
||||
0 0.00000 0.00000 81:
|
||||
0 0.00000 0.00000 82: # resolve class of this element
|
||||
0 0.00000 0.00000 83: $_class = $self->{ class_resolver
|
||||
0 0.00000 0.00000 84: or die "Cannot resolve class
|
||||
26000 0.28196 0.56000 85: . join('/', @{ $path }) .
|
||||
0 0.00000 0.00000 86:
|
||||
26000 0.01695 0.35000 87: if ($_class eq '__SKIP__') {
|
||||
0 0.00000 0.00000 88: $skip = join('/', @{ $path
|
||||
0 0.00000 0.00000 89: $self->setHandlers( Char =>
|
||||
0 0.00000 0.00000 90: return;
|
||||
0 0.00000 0.00000 91: }
|
||||
0 0.00000 0.00000 92:
|
||||
26000 0.02064 0.35000 93: push @$list, $current; # step
|
||||
0 0.00000 0.00000 94:
|
||||
26000 0.02021 0.23000 95: $characters = q(); # empty
|
||||
0 0.00000 0.00000 96: #@characters_from = ();
|
||||
0 0.00000 0.00000 97:
|
||||
0 0.00000 0.00000 98: # Check whether we have a builtin
|
||||
0 0.00000 0.00000 99: # We could replace this with
|
||||
0 0.00000 0.00000 100: # match is a bit faster if the
|
||||
0 0.00000 0.00000 101: # if $class matches...
|
||||
26000 0.01676 0.21000 102: if (index $_class,
|
||||
0 0.00000 0.00000 103: # check wheter there is a
|
||||
0 0.00000 0.00000 104: # or a "new" method
|
||||
0 0.00000 0.00000 105: # If not, require it - all
|
||||
0 0.00000 0.00000 106: # define new()
|
||||
0 0.00000 0.00000 107: # This is not exactly the
|
||||
0 0.00000 0.00000 108: defined *{ "$_class\::new" }{
|
||||
26000 0.07804 0.33000 109: or scalar @{ *{
|
||||
0 0.00000 0.00000 110: or eval "require $_class"
|
||||
0 0.00000 0.00000 111: or die $@;
|
||||
0 0.00000 0.00000 112: }
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 3
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
0 0.00000 0.00000 113:
|
||||
26000 0.45038 0.81000 114: $current = $_class->new({
|
||||
0 0.00000 0.00000 115:
|
||||
0 0.00000 0.00000 116: # remember top level element
|
||||
0 0.00000 0.00000 117: exists $self->{ data }
|
||||
26000 0.02113 0.22000 118: or ($self->{ data } =
|
||||
26000 0.01267 0.25000 119: $depth++;
|
||||
26000 0.07978 0.40000 120: return;
|
||||
0 0.00000 0.00000 121: },
|
||||
0 0.00000 0.00000 122:
|
||||
0 0.00000 0.00000 123: Char => $char_handler,
|
||||
0 0.00000 0.00000 124:
|
||||
0 0.00000 0.00000 125: End => sub {
|
||||
0 0.00000 0.00000 126:
|
||||
28000 0.01974 0.26000 127: pop @{ $path };
|
||||
0 0.00000 0.00000 128:
|
||||
28000 0.01197 0.18000 129: if ($skip) {
|
||||
0 0.00000 0.00000 130: return if $skip ne join '/',
|
||||
0 0.00000 0.00000 131: $skip = 0;
|
||||
0 0.00000 0.00000 132: $_[0]->setHandler( Char =>
|
||||
0 0.00000 0.00000 133: return;
|
||||
0 0.00000 0.00000 134: }
|
||||
0 0.00000 0.00000 135:
|
||||
28000 0.01687 0.25000 136: $depth--;
|
||||
0 0.00000 0.00000 137:
|
||||
0 0.00000 0.00000 138: # This one easily handles ignores
|
||||
28000 0.10769 0.33000 139: return if not ref $list->[-1];
|
||||
0 0.00000 0.00000 140:
|
||||
0 0.00000 0.00000 141: # set characters in current if we
|
||||
0 0.00000 0.00000 142: # we may have characters in
|
||||
0 0.00000 0.00000 143: # too - maybe we should rely on
|
||||
0 0.00000 0.00000 144: # may get a speedup by defining a
|
||||
0 0.00000 0.00000 145: # and looking it up via exists
|
||||
0 0.00000 0.00000 146:# if ( $current-
|
||||
0 0.00000 0.00000 147:# $current->set_value(
|
||||
0 0.00000 0.00000 148:# }
|
||||
0 0.00000 0.00000 149: # currently doesn't work, as
|
||||
0 0.00000 0.00000 150: # maybe change ?
|
||||
25000 0.21156 0.56000 151: $current->set_value( $characters
|
||||
0 0.00000 0.00000 152: #$current->set_value( join
|
||||
25000 0.08260 0.32000 153: $characters = q{};
|
||||
0 0.00000 0.00000 154:# undef @characters_from;
|
||||
0 0.00000 0.00000 155: # set appropriate attribute in
|
||||
0 0.00000 0.00000 156: # multiple values must be
|
||||
0 0.00000 0.00000 157: #$_method = "add_$_localname";
|
||||
25000 0.01494 0.21000 158: $_method = "add_$_[1]";
|
||||
25000 0.55155 0.86000 159: $list->[-1]->$_method( $current
|
||||
0 0.00000 0.00000 160:
|
||||
25000 0.02121 0.14000 161: $current = pop @$list;
|
||||
25000 0.07002 0.34000 162: return;
|
||||
0 0.00000 0.00000 163: }
|
||||
1000 0.12135 0.08000 164: );
|
||||
1000 0.13602 0.11000 165: return $parser;
|
||||
0 0.00000 0.00000 166:}
|
||||
0 0.00000 0.00000 167:
|
||||
0 0.00000 0.00000 168:sub parse {
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 4
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
1000 0.00055 0.03000 169: eval {
|
||||
1000 0.07420 0.07000 170: $_[0]->_initialize(
|
||||
0 0.00000 0.00000 171: XML::Parser::Expat->new(
|
||||
0 0.00000 0.00000 172: Namespaces => 1
|
||||
0 0.00000 0.00000 173: )
|
||||
0 0.00000 0.00000 174: )->parse( $_[1] );
|
||||
1000 0.01030 0.02000 175: $_[0]->{ parser }->release();
|
||||
0 0.00000 0.00000 176: };
|
||||
1000 0.00034 0.00000 177: die $@ if $@;
|
||||
1000 2.73620 2.67000 178: return $_[0]->{ data };
|
||||
0 0.00000 0.00000 179:}
|
||||
0 0.00000 0.00000 180:
|
||||
0 0.00000 0.00000 181:sub parsefile {
|
||||
0 0.00000 0.00000 182: eval {
|
||||
0 0.00000 0.00000 183: $_[0]->_initialize(
|
||||
0 0.00000 0.00000 184: $_[0]->{ parser }->release();
|
||||
0 0.00000 0.00000 185: };
|
||||
0 0.00000 0.00000 186: die $@, $_[1] if $@;
|
||||
0 0.00000 0.00000 187: return $_[0]->{ data };
|
||||
0 0.00000 0.00000 188:}
|
||||
0 0.00000 0.00000 189:
|
||||
0 0.00000 0.00000 190:# SAX-like aliases
|
||||
0 0.00000 0.00000 191:sub parse_string;
|
||||
0 0.00000 0.00000 192:*parse_string = \&parse;
|
||||
0 0.00000 0.00000 193:
|
||||
0 0.00000 0.00000 194:sub parse_file;
|
||||
0 0.00000 0.00000 195:*parse_file = \&parsefile;
|
||||
0 0.00000 0.00000 196:
|
||||
0 0.00000 0.00000 197:sub get_data {
|
||||
0 0.00000 0.00000 198: return $_[0]->{ data };
|
||||
0 0.00000 0.00000 199:}
|
||||
0 0.00000 0.00000 200:
|
||||
0 0.00000 0.00000 201:1;
|
||||
0 0.00000 0.00000 202:
|
||||
0 0.00000 0.00000 203:=pod
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of 01_expat.t Page 5
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
0 0.00000 0.00000 1:#!/usr/bin/perl -w
|
||||
1 0.00003 0.00000 2:%DB::packages=(SOAP::WSDL::Expat::MessagePars
|
||||
0 0.00000 0.00000 3:use strict;
|
||||
0 0.00000 0.00000 4:use warnings;
|
||||
0 0.00000 0.00000 5:use lib '../lib';
|
||||
0 0.00000 0.00000 6:use lib 'lib';
|
||||
0 0.00000 0.00000 7:use lib '../t/lib';
|
||||
0 0.00000 0.00000 8:use SOAP::WSDL::SAX::MessageHandler;
|
||||
0 0.00000 0.00000 9:
|
||||
0 0.00000 0.00000 10:use Benchmark;
|
||||
0 0.00000 0.00000 11:use SOAP::WSDL::Expat::MessageParser;
|
||||
0 0.00000 0.00000 12:use SOAP::WSDL::Expat::Message2Hash;
|
||||
0 0.00000 0.00000 13:use XML::Simple;
|
||||
0 0.00000 0.00000 14:use XML::LibXML;
|
||||
0 0.00000 0.00000 15:use MyComplexType;
|
||||
0 0.00000 0.00000 16:use MyElement;
|
||||
0 0.00000 0.00000 17:use MySimpleType;
|
||||
0 0.00000 0.00000 18:
|
||||
0 0.00000 0.00000 19:my $xml = q{<SOAP-ENV:Envelope
|
||||
0 0.00000 0.00000 20: xmlns:SOAP-
|
||||
0 0.00000 0.00000 21: <SOAP-
|
||||
0 0.00000 0.00000 22: <test>Test</test>
|
||||
0 0.00000 0.00000 23: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 24: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 25: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 26: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 27: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 28: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 29: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 30: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 31: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 32: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 33: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 34: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 35: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 36: <test>Test</test>
|
||||
0 0.00000 0.00000 37: <test>Test</test>
|
||||
0 0.00000 0.00000 38: <test>Test</test>
|
||||
0 0.00000 0.00000 39: <test>Test</test>
|
||||
0 0.00000 0.00000 40: <test>Test</test>
|
||||
0 0.00000 0.00000 41: <test>Test</test>
|
||||
0 0.00000 0.00000 42: <test>Test</test>
|
||||
0 0.00000 0.00000 43: <test>Test</test>
|
||||
0 0.00000 0.00000 44: <test>Test</test>
|
||||
0 0.00000 0.00000 45: <test>Test</test>
|
||||
0 0.00000 0.00000 46: <test>Test</test>
|
||||
0 0.00000 0.00000 47: </MyAtomicComplexTypeElement>
|
||||
0 0.00000 0.00000 48:</SOAP-ENV:Body></SOAP-ENV:Envelope>};
|
||||
0 0.00000 0.00000 49:
|
||||
0 0.00000 0.00000 50:
|
||||
0 0.00000 0.00000 51:my $parser =
|
||||
0 0.00000 0.00000 52: class_resolver => 'FakeResolver'
|
||||
0 0.00000 0.00000 53:});
|
||||
0 0.00000 0.00000 54:
|
||||
0 0.00000 0.00000 55:my $hash_parser =
|
||||
0 0.00000 0.00000 56:
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of 01_expat.t Page 6
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
0 0.00000 0.00000 57:$XML::Simple::PREFERRED_PARSER =
|
||||
0 0.00000 0.00000 58:
|
||||
0 0.00000 0.00000 59:my $libxml = XML::LibXML->new();
|
||||
0 0.00000 0.00000 60:my @data;
|
||||
0 0.00000 0.00000 61:timethese 1000,
|
||||
0 0.00000 0.00000 62:{
|
||||
0 0.00000 0.00000 63: # 'Hash (SOAP:WSDL)' => sub { push @data,
|
||||
0 0.00000 0.00000 64: 'SOAP::WSDL' => sub { push @data, $parser-
|
||||
0 0.00000 0.00000 65:# 'XML::Simple (Hash)' => sub { push @data,
|
||||
0 0.00000 0.00000 66:# 'XML::LibXML (DOM)' => sub { push @data,
|
||||
0 0.00000 0.00000 67:};
|
||||
0 0.00000 0.00000 68:
|
||||
0 0.00000 0.00000 69:# use Test::More tests => 1;
|
||||
0 0.00000 0.00000 70:#is $parser->get_data(),
|
||||
0 0.00000 0.00000 71:# . q{<test >Test</test><test2
|
||||
0 0.00000 0.00000 72:# , 'Content comparison';
|
||||
0 0.00000 0.00000 73:
|
||||
0 0.00000 0.00000 74:#$parser->class_resolver( 'FakeResolver2' );
|
||||
0 0.00000 0.00000 75:
|
||||
0 0.00000 0.00000 76:
|
||||
0 0.00000 0.00000 77:# data classes reside in t/lib/Typelib/
|
||||
0 0.00000 0.00000 78:BEGIN {
|
||||
0 0.00000 0.00000 79: package FakeResolver;
|
||||
0 0.00000 0.00000 80: {
|
||||
0 0.00000 0.00000 81: my %class_list = (
|
||||
0 0.00000 0.00000 82: 'MyAtomicComplexTypeElement' =>
|
||||
0 0.00000 0.00000 83: 'MyAtomicComplexTypeElement/test'
|
||||
0 0.00000 0.00000 84:
|
||||
0 0.00000 0.00000 85: );
|
||||
0 0.00000 0.00000 86:
|
||||
0 0.00000 0.00000 87: sub get_map { return \%class_list };
|
||||
0 0.00000 0.00000 88:
|
||||
0 0.00000 0.00000 89: sub new { return bless {},
|
||||
0 0.00000 0.00000 90:
|
||||
0 0.00000 0.00000 91: sub get_class {
|
||||
0 0.00000 0.00000 92: my $name = join('/', @{ $_[1] });
|
||||
0 0.00000 0.00000 93: return ($class_list{ $name }) ?
|
||||
0 0.00000 0.00000 94: : warn "no class found for
|
||||
0 0.00000 0.00000 95: };
|
||||
0 0.00000 0.00000 96: };
|
||||
0 0.00000 0.00000 97:};
|
||||
@@ -0,0 +1,315 @@
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 1
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
0 0.00000 0.00000 1:#!/usr/bin/perl
|
||||
0 0.00000 0.00000 2:package SOAP::WSDL::Expat::MessageParser;
|
||||
0 0.00000 0.00000 3:use strict;
|
||||
0 0.00000 0.00000 4:use warnings;
|
||||
0 0.00000 0.00000 5:use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
0 0.00000 0.00000 6:use XML::Parser::Expat;
|
||||
0 0.00000 0.00000 7:
|
||||
0 0.00000 0.00000 8:sub new {
|
||||
1 0.00000 0.00000 9: my ($class, $args) = @_;
|
||||
0 0.00000 0.00000 10: my $self = {
|
||||
0 0.00000 0.00000 11: class_resolver => $args->{
|
||||
1 0.00001 0.00000 12: strict => exists $args->{ strict } ?
|
||||
0 0.00000 0.00000 13: };
|
||||
1 0.00001 0.00000 14: bless $self, $class;
|
||||
1 0.02309 0.03000 15: return $self;
|
||||
0 0.00000 0.00000 16:}
|
||||
0 0.00000 0.00000 17:
|
||||
0 0.00000 0.00000 18:sub class_resolver {
|
||||
1 0.00000 0.00000 19: my $self = shift;
|
||||
1 2.74336 2.69000 20: $self->{ class_resolver } = shift;
|
||||
0 0.00000 0.00000 21:}
|
||||
0 0.00000 0.00000 22:
|
||||
0 0.00000 0.00000 23:sub _initialize {
|
||||
1000 0.00163 0.01000 24: my ($self, $parser) = @_;
|
||||
1000 0.03682 0.05000 25: $self->{ parser } = $parser;
|
||||
0 0.00000 0.00000 26:
|
||||
1000 0.00138 0.01000 27: delete $self->{ data };
|
||||
0 0.00000 0.00000 28:
|
||||
1000 0.00048 0.01000 29: my $characters;
|
||||
1000 0.00091 0.00000 30: my $current = undef;
|
||||
1000 0.00097 0.01000 31: my $list = []; #
|
||||
1000 0.00107 0.01000 32: my $path = []; #
|
||||
1000 0.00054 0.01000 33: my $skip = 0; #
|
||||
1000 0.00053 0.01000 34: my $current_part = q{}; # are
|
||||
0 0.00000 0.00000 35:
|
||||
1000 0.00041 0.02000 36: my $depth = 0;
|
||||
0 0.00000 0.00000 37:
|
||||
0 0.00000 0.00000 38: my %content_check = $self->{strict}
|
||||
0 0.00000 0.00000 39: ? (
|
||||
0 0.00000 0.00000 40: 0 => sub {
|
||||
1000 0.00097 0.02000 41: die "Bad top node $_[1]"
|
||||
1000 0.01651 0.00000 42: die "Bad namespace for
|
||||
0 0.00000 0.00000 43: if $_[0]-
|
||||
1000 0.00068 0.00000 44: $depth++;
|
||||
1000 0.00441 0.02000 45: return;
|
||||
0 0.00000 0.00000 46: },
|
||||
0 0.00000 0.00000 47: 1 => sub {
|
||||
1000 0.00369 0.02000 48: die "Bad node $_[1].
|
||||
1000 0.00060 0.00000 49: $depth++;
|
||||
1000 0.03693 0.03000 50: return;
|
||||
0 0.00000 0.00000 51: }
|
||||
0 0.00000 0.00000 52: )
|
||||
1000 0.01252 0.01000 53: : ();
|
||||
0 0.00000 0.00000 54:
|
||||
0 0.00000 0.00000 55: # use "globals" for speed
|
||||
1000 0.00095 0.01000 56: my ($_prefix, $_method,
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 2
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
0 0.00000 0.00000 57: $_class) = ();
|
||||
0 0.00000 0.00000 58:
|
||||
0 0.00000 0.00000 59: no strict qw(refs);
|
||||
0 0.00000 0.00000 60: $parser->setHandlers(
|
||||
0 0.00000 0.00000 61: Start => sub {
|
||||
0 0.00000 0.00000 62: # my ($parser, $element, %_attrs)
|
||||
0 0.00000 0.00000 63: # $depth = $parser->depth();
|
||||
0 0.00000 0.00000 64:
|
||||
0 0.00000 0.00000 65: # call methods without using
|
||||
0 0.00000 0.00000 66: # That's slightly faster than
|
||||
0 0.00000 0.00000 67: # and we don't have to pass $_[1]
|
||||
0 0.00000 0.00000 68: # Yup, that's dirty.
|
||||
28000 0.03090 0.31000 69: return &{$content_check{ $depth
|
||||
0 0.00000 0.00000 70:
|
||||
26000 0.03309 0.32000 71: push @{ $path }, $_[1]; #
|
||||
26000 0.01337 0.21000 72: return if $skip; #
|
||||
0 0.00000 0.00000 73:
|
||||
0 0.00000 0.00000 74: # resolve class of this element
|
||||
0 0.00000 0.00000 75: $_class = $self->{ class_resolver
|
||||
0 0.00000 0.00000 76: or die "Cannot resolve class
|
||||
26000 0.28467 0.53000 77: . join('/', @{ $path }) .
|
||||
0 0.00000 0.00000 78:
|
||||
0 0.00000 0.00000 79: # maybe write as "return $skip =
|
||||
0 0.00000 0.00000 80: # would save a BLOCK...
|
||||
26000 0.03919 0.30000 81: return $skip = join('/', @{ $path
|
||||
0 0.00000 0.00000 82:
|
||||
26000 0.05079 0.22000 83: push @$list, $current; # step
|
||||
0 0.00000 0.00000 84:
|
||||
26000 0.07934 0.26000 85: $characters = q(); # empty
|
||||
0 0.00000 0.00000 86:
|
||||
0 0.00000 0.00000 87: # Check whether we have a builtin
|
||||
0 0.00000 0.00000 88: # We could replace this with
|
||||
0 0.00000 0.00000 89: # match is a bit faster if the
|
||||
0 0.00000 0.00000 90: # if $class matches...
|
||||
26000 0.01981 0.22000 91: if (index $_class,
|
||||
0 0.00000 0.00000 92: # check wheter there is a
|
||||
0 0.00000 0.00000 93: # or a "new" method
|
||||
0 0.00000 0.00000 94: # If not, require it - all
|
||||
0 0.00000 0.00000 95: # define new()
|
||||
0 0.00000 0.00000 96: # This is not exactly the
|
||||
0 0.00000 0.00000 97: defined *{ "$_class\::new" }{
|
||||
26000 0.08308 0.26000 98: or scalar @{ *{
|
||||
0 0.00000 0.00000 99: or eval "require $_class"
|
||||
0 0.00000 0.00000 100: or die $@;
|
||||
0 0.00000 0.00000 101: }
|
||||
0 0.00000 0.00000 102:
|
||||
26000 0.45611 0.64000 103: $current = $_class->new({
|
||||
0 0.00000 0.00000 104:
|
||||
0 0.00000 0.00000 105: # remember top level element
|
||||
0 0.00000 0.00000 106: exists $self->{ data }
|
||||
26000 0.02518 0.26000 107: or ($self->{ data } =
|
||||
26000 0.01496 0.32000 108: $depth++;
|
||||
26000 0.07949 0.39000 109: return;
|
||||
0 0.00000 0.00000 110: },
|
||||
0 0.00000 0.00000 111:
|
||||
0 0.00000 0.00000 112: Char => sub {
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 3
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
80000 0.05801 0.73000 113: return if $skip;
|
||||
80000 0.38097 1.05000 114: return if $_[1] =~m{ \A \s* \z
|
||||
25000 0.01804 0.24000 115: $characters .= $_[1];
|
||||
25000 0.07404 0.32000 116: return;
|
||||
0 0.00000 0.00000 117: },
|
||||
0 0.00000 0.00000 118:
|
||||
0 0.00000 0.00000 119: End => sub {
|
||||
0 0.00000 0.00000 120:
|
||||
28000 0.02209 0.25000 121: pop @{ $path };
|
||||
0 0.00000 0.00000 122:
|
||||
28000 0.01658 0.29000 123: if ($skip) {
|
||||
0 0.00000 0.00000 124: return if $skip ne join '/',
|
||||
0 0.00000 0.00000 125: $skip = 0;
|
||||
0 0.00000 0.00000 126: return;
|
||||
0 0.00000 0.00000 127: }
|
||||
0 0.00000 0.00000 128:
|
||||
28000 0.01628 0.26000 129: $depth--;
|
||||
0 0.00000 0.00000 130:
|
||||
0 0.00000 0.00000 131: # This one easily handles ignores
|
||||
28000 0.11185 0.27000 132: return if not ref $list->[-1];
|
||||
0 0.00000 0.00000 133:
|
||||
0 0.00000 0.00000 134: # set characters in current if we
|
||||
0 0.00000 0.00000 135: # we may have characters in
|
||||
0 0.00000 0.00000 136: # too - maybe we should rely on
|
||||
0 0.00000 0.00000 137: # may get a speedup by defining a
|
||||
0 0.00000 0.00000 138: # and looking it up via exists
|
||||
0 0.00000 0.00000 139:# if ( $current-
|
||||
0 0.00000 0.00000 140:# $current->set_value(
|
||||
0 0.00000 0.00000 141:# }
|
||||
0 0.00000 0.00000 142: # currently doesn't work, as
|
||||
0 0.00000 0.00000 143: # maybe change ?
|
||||
25000 0.28121 0.53000 144: $current->set_value( $characters
|
||||
25000 0.01730 0.20000 145: $characters = q{};
|
||||
0 0.00000 0.00000 146: # set appropriate attribute in
|
||||
0 0.00000 0.00000 147: # multiple values must be
|
||||
0 0.00000 0.00000 148: #$_method = "add_$_localname";
|
||||
25000 0.01976 0.23000 149: $_method = "add_$_[1]";
|
||||
25000 0.55083 0.85000 150: $list->[-1]->$_method( $current
|
||||
0 0.00000 0.00000 151:
|
||||
25000 0.02277 0.25000 152: $current = pop @$list;
|
||||
25000 0.06949 0.36000 153: return;
|
||||
0 0.00000 0.00000 154: }
|
||||
1000 0.12369 0.12000 155: );
|
||||
1000 0.13620 0.08000 156: return $parser;
|
||||
0 0.00000 0.00000 157:}
|
||||
0 0.00000 0.00000 158:
|
||||
0 0.00000 0.00000 159:sub parse {
|
||||
1000 0.00065 0.02000 160: eval {
|
||||
1000 0.07514 0.09000 161: $_[0]->_initialize(
|
||||
0 0.00000 0.00000 162: XML::Parser::Expat->new(
|
||||
0 0.00000 0.00000 163: Namespaces => 1
|
||||
0 0.00000 0.00000 164: )
|
||||
0 0.00000 0.00000 165: )->parse( $_[1] );
|
||||
1000 0.01077 0.02000 166: $_[0]->{ parser }->release();
|
||||
0 0.00000 0.00000 167: };
|
||||
1000 0.00051 0.00000 168: die $@ if $@;
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of ../lib/SOAP/WSDL/Expat/MessageParser.pm Page 4
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
1000 0.01431 0.04000 169: return $_[0]->{ data };
|
||||
0 0.00000 0.00000 170:}
|
||||
0 0.00000 0.00000 171:
|
||||
0 0.00000 0.00000 172:sub parsefile {
|
||||
0 0.00000 0.00000 173: eval {
|
||||
0 0.00000 0.00000 174: $_[0]->_initialize(
|
||||
0 0.00000 0.00000 175: $_[0]->{ parser }->release();
|
||||
0 0.00000 0.00000 176: };
|
||||
0 0.00000 0.00000 177: die $@, $_[1] if $@;
|
||||
0 0.00000 0.00000 178: return $_[0]->{ data };
|
||||
0 0.00000 0.00000 179:}
|
||||
0 0.00000 0.00000 180:
|
||||
0 0.00000 0.00000 181:# SAX-like aliases
|
||||
0 0.00000 0.00000 182:sub parse_string;
|
||||
0 0.00000 0.00000 183:*parse_string = \&parse;
|
||||
0 0.00000 0.00000 184:
|
||||
0 0.00000 0.00000 185:sub parse_file;
|
||||
0 0.00000 0.00000 186:*parse_file = \&parsefile;
|
||||
0 0.00000 0.00000 187:
|
||||
0 0.00000 0.00000 188:sub get_data {
|
||||
0 0.00000 0.00000 189: return $_[0]->{ data };
|
||||
0 0.00000 0.00000 190:}
|
||||
0 0.00000 0.00000 191:
|
||||
0 0.00000 0.00000 192:1;
|
||||
0 0.00000 0.00000 193:
|
||||
0 0.00000 0.00000 194:=pod
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of 01_expat.t Page 5
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
0 0.00000 0.00000 1:#!/usr/bin/perl -w
|
||||
1 0.00002 0.00000 2:%DB::packages=(SOAP::WSDL::Expat::MessagePars
|
||||
0 0.00000 0.00000 3:use strict;
|
||||
0 0.00000 0.00000 4:use warnings;
|
||||
0 0.00000 0.00000 5:use lib '../lib';
|
||||
0 0.00000 0.00000 6:use lib 'lib';
|
||||
0 0.00000 0.00000 7:use lib '../t/lib';
|
||||
0 0.00000 0.00000 8:use SOAP::WSDL::SAX::MessageHandler;
|
||||
0 0.00000 0.00000 9:
|
||||
0 0.00000 0.00000 10:use Benchmark;
|
||||
0 0.00000 0.00000 11:use SOAP::WSDL::Expat::MessageParser;
|
||||
0 0.00000 0.00000 12:use SOAP::WSDL::Expat::Message2Hash;
|
||||
0 0.00000 0.00000 13:use XML::Simple;
|
||||
0 0.00000 0.00000 14:use XML::LibXML;
|
||||
0 0.00000 0.00000 15:use MyComplexType;
|
||||
0 0.00000 0.00000 16:use MyElement;
|
||||
0 0.00000 0.00000 17:use MySimpleType;
|
||||
0 0.00000 0.00000 18:
|
||||
0 0.00000 0.00000 19:my $xml = q{<SOAP-ENV:Envelope
|
||||
0 0.00000 0.00000 20: xmlns:SOAP-
|
||||
0 0.00000 0.00000 21: <SOAP-
|
||||
0 0.00000 0.00000 22: <test>Test</test>
|
||||
0 0.00000 0.00000 23: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 24: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 25: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 26: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 27: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 28: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 29: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 30: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 31: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 32: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 33: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 34: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 35: <test2 >Test2</test2>
|
||||
0 0.00000 0.00000 36: <test>Test</test>
|
||||
0 0.00000 0.00000 37: <test>Test</test>
|
||||
0 0.00000 0.00000 38: <test>Test</test>
|
||||
0 0.00000 0.00000 39: <test>Test</test>
|
||||
0 0.00000 0.00000 40: <test>Test</test>
|
||||
0 0.00000 0.00000 41: <test>Test</test>
|
||||
0 0.00000 0.00000 42: <test>Test</test>
|
||||
0 0.00000 0.00000 43: <test>Test</test>
|
||||
0 0.00000 0.00000 44: <test>Test</test>
|
||||
0 0.00000 0.00000 45: <test>Test</test>
|
||||
0 0.00000 0.00000 46: <test>Test</test>
|
||||
0 0.00000 0.00000 47: </MyAtomicComplexTypeElement>
|
||||
0 0.00000 0.00000 48:</SOAP-ENV:Body></SOAP-ENV:Envelope>};
|
||||
0 0.00000 0.00000 49:
|
||||
0 0.00000 0.00000 50:
|
||||
0 0.00000 0.00000 51:my $parser =
|
||||
0 0.00000 0.00000 52: class_resolver => 'FakeResolver'
|
||||
0 0.00000 0.00000 53:});
|
||||
0 0.00000 0.00000 54:
|
||||
0 0.00000 0.00000 55:my $hash_parser =
|
||||
0 0.00000 0.00000 56:
|
||||
================ SmallProf version 2.02 ================
|
||||
Profile of 01_expat.t Page 6
|
||||
=================================================================
|
||||
count wall tm cpu time line
|
||||
0 0.00000 0.00000 57:$XML::Simple::PREFERRED_PARSER =
|
||||
0 0.00000 0.00000 58:
|
||||
0 0.00000 0.00000 59:my $libxml = XML::LibXML->new();
|
||||
0 0.00000 0.00000 60:my @data;
|
||||
0 0.00000 0.00000 61:timethese 1000,
|
||||
0 0.00000 0.00000 62:{
|
||||
0 0.00000 0.00000 63:# 'SOAP::WSDL Hash' => sub { push @data,
|
||||
0 0.00000 0.00000 64: 'SOAP::WSDL' => sub { push @data, $parser-
|
||||
0 0.00000 0.00000 65:# 'XML::Simple (Hash)' => sub { push @data,
|
||||
0 0.00000 0.00000 66:# 'XML::LibXML (DOM)' => sub { push @data,
|
||||
0 0.00000 0.00000 67:};
|
||||
0 0.00000 0.00000 68:
|
||||
0 0.00000 0.00000 69:# use Test::More tests => 1;
|
||||
0 0.00000 0.00000 70:#is $parser->get_data(),
|
||||
0 0.00000 0.00000 71:# . q{<test >Test</test><test2
|
||||
0 0.00000 0.00000 72:# , 'Content comparison';
|
||||
0 0.00000 0.00000 73:
|
||||
0 0.00000 0.00000 74:$parser->class_resolver( 'FakeResolver2' );
|
||||
0 0.00000 0.00000 75:
|
||||
0 0.00000 0.00000 76:
|
||||
0 0.00000 0.00000 77:# data classes reside in t/lib/Typelib/
|
||||
0 0.00000 0.00000 78:BEGIN {
|
||||
0 0.00000 0.00000 79: package FakeResolver;
|
||||
0 0.00000 0.00000 80: {
|
||||
0 0.00000 0.00000 81: my %class_list = (
|
||||
0 0.00000 0.00000 82: 'MyAtomicComplexTypeElement' =>
|
||||
0 0.00000 0.00000 83: 'MyAtomicComplexTypeElement/test'
|
||||
0 0.00000 0.00000 84:
|
||||
0 0.00000 0.00000 85: );
|
||||
0 0.00000 0.00000 86:
|
||||
0 0.00000 0.00000 87: sub get_map { return \%class_list };
|
||||
0 0.00000 0.00000 88:
|
||||
0 0.00000 0.00000 89: sub new { return bless {},
|
||||
0 0.00000 0.00000 90:
|
||||
0 0.00000 0.00000 91: sub get_class {
|
||||
0 0.00000 0.00000 92: my $name = join('/', @{ $_[1] });
|
||||
0 0.00000 0.00000 93: return ($class_list{ $name }) ?
|
||||
0 0.00000 0.00000 94: : warn "no class found for
|
||||
0 0.00000 0.00000 95: };
|
||||
0 0.00000 0.00000 96: };
|
||||
0 0.00000 0.00000 97:};
|
||||
+127
-34
@@ -1,34 +1,64 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Fcntl;
|
||||
use IO::File;
|
||||
use Pod::Usage;
|
||||
use Getopt::Long;
|
||||
use LWP::Simple qw(get);
|
||||
use SOAP::WSDL::SAX::WSDLHandler;
|
||||
use XML::LibXML;
|
||||
use LWP::UserAgent;
|
||||
use SOAP::WSDL::Expat::WSDLParser;
|
||||
use SOAP::WSDL::Factory::Generator;
|
||||
use Term::ReadKey;
|
||||
|
||||
my %opt = (
|
||||
url => '',
|
||||
prefix => undef,
|
||||
type_prefix => 'MyTypes::',
|
||||
element_prefix => 'MyElements::',
|
||||
typemap_prefix => 'MyTypemaps::',
|
||||
interface_prefix => 'MyInterfaces::',
|
||||
type_prefix => 'MyTypes',
|
||||
element_prefix => 'MyElements',
|
||||
typemap_prefix => 'MyTypemaps',
|
||||
interface_prefix => 'MyInterfaces',
|
||||
base_path => 'lib/',
|
||||
proxy => undef,
|
||||
generator => 'XSD',
|
||||
);
|
||||
|
||||
{ # a block just to scope "no warnings"
|
||||
no warnings qw(redefine);
|
||||
|
||||
*LWP::UserAgent::get_basic_credentials = sub {
|
||||
my ($user, $password);
|
||||
# remove user from option if called, to force prompting for a user
|
||||
# name the next time
|
||||
print "URL requires authorization.\n";
|
||||
if (not $user = delete $opt{user}) {
|
||||
print 'User name:';
|
||||
ReadMode 1;
|
||||
$user = ReadLine();
|
||||
ReadMode 0;
|
||||
};
|
||||
if (not $password = delete $opt{password}) {
|
||||
print 'Password:';
|
||||
ReadMode 2;
|
||||
$user = ReadLine;
|
||||
ReadMode 0;
|
||||
};
|
||||
return ($user, $password);
|
||||
};
|
||||
}
|
||||
|
||||
GetOptions(\%opt,
|
||||
qw(
|
||||
url|u=s
|
||||
prefix|p=s
|
||||
type_prefix|t=s
|
||||
element_prefix|e=s
|
||||
typemap_prefix|m=s
|
||||
interface_prefix|i=s
|
||||
base_path|b=s
|
||||
typemap_include|mi=s
|
||||
help|h
|
||||
proxy|x=s
|
||||
keep_alive
|
||||
user=s
|
||||
password=s
|
||||
generator=s
|
||||
)
|
||||
);
|
||||
|
||||
@@ -37,25 +67,55 @@ my $url = $ARGV[0];
|
||||
pod2usage( -exit => 1 , verbose => 2 ) if ($opt{help});
|
||||
pod2usage( -exit => 1 , verbose => 1 ) if not ($url);
|
||||
|
||||
my $handler = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||
my $parser = XML::LibXML->new();
|
||||
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
|
||||
|
||||
my $xml = get($url) or die "Could not load WSDL schema $url\n";
|
||||
local $ENV{HTTP_PROXY} = $opt{proxy} if $opt{proxy};
|
||||
local $ENV{HTTPS_PROXY} = $opt{proxy} if $opt{proxy};
|
||||
|
||||
$parser->set_handler( $handler );
|
||||
$parser->parse_string( $xml );
|
||||
my $lwp = LWP::UserAgent->new(
|
||||
$opt{keep_alive}
|
||||
? ( keep_alive => 1 )
|
||||
: ()
|
||||
);
|
||||
$lwp->env_proxy(); # get proxy from environment. Works for both http & https.
|
||||
|
||||
my $wsdl = $handler->get_data();
|
||||
my $response = $lwp->get($url);
|
||||
die $response->message(), "\n" if $response->code != 200;
|
||||
|
||||
my $xml = $response->content();
|
||||
|
||||
my $definitions = $parser->parse_string( $xml );
|
||||
|
||||
my %typemap = ();
|
||||
|
||||
if ($opt{typemap_include}) {
|
||||
my $fh = IO::File->new($opt{typemap_include} , O_RDONLY)
|
||||
or die "cannot open typemap_include file $opt{typemap_include}\n";
|
||||
$opt{custom_types} = join q{}, $fh->getlines();
|
||||
$fh->close();
|
||||
delete $opt{typemap_include};
|
||||
die "$opt{typemap_include} not found " if not -f $opt{typemap_include};
|
||||
%typemap = do $opt{typemap_include};
|
||||
}
|
||||
|
||||
$wsdl->create({ %opt });
|
||||
my $generator = SOAP::WSDL::Factory::Generator->get_generator({ type => $opt{'generator'} });
|
||||
|
||||
if (%typemap) {
|
||||
if ($generator->can('set_typemap')) {
|
||||
$generator->set_typemap( \%typemap );
|
||||
}
|
||||
else {
|
||||
warn "Typemap snippet given, but generator does not support it\n";
|
||||
}
|
||||
};
|
||||
|
||||
$generator->set_type_prefix( $opt{ type_prefix }) if $generator->can('set_type_prefix');
|
||||
$generator->set_typemap_prefix( $opt{ typemap_prefix }) if $generator->can('set_typemap_prefix');
|
||||
$generator->set_element_prefix($opt{ element_prefix }) if $generator->can('set_element_prefix');
|
||||
$generator->set_interface_prefix($opt{ interface_prefix }) if $generator->can('set_interface_prefix');
|
||||
$generator->set_OUTPUT_PATH($opt{ base_path }) if $generator->can('set_OUTPUT_PATH');
|
||||
$generator->set_definitions($definitions) if $generator->can('set_definitions');
|
||||
$generator->set_wsdl($xml) if $generator->can('set_wsdl');
|
||||
|
||||
# start with typelib, as errors will most likely occur here...
|
||||
$generator->generate();
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
@@ -73,17 +133,26 @@ wsdl2perl.pl - create perl bindings for SOAP webservices.
|
||||
NAME SHORT DESCRITPION
|
||||
----------------------------------------------------------------------------
|
||||
prefix p Prefix for both type and element classes.
|
||||
type_prefix t Prefix for type classes. Should end with '::'
|
||||
Default: MyTypes::
|
||||
element_prefix e Prefix for element classes. Should end with '::'
|
||||
Default: MyElements::
|
||||
typemap_prefix m Prefix for typemap classes. Should end with '::'
|
||||
Default: MyTypemaps::
|
||||
interface_prefix i Prefix for interface classes. Should end with '::'
|
||||
Default: MyInterfaces::
|
||||
type_prefix t Prefix for type classes.
|
||||
Default: MyTypes
|
||||
element_prefix e Prefix for element classes.
|
||||
Default: MyElements
|
||||
typemap_prefix m Prefix for typemap classes.
|
||||
Default: MyTypemaps
|
||||
interface_prefix i Prefix for interface classes.
|
||||
Default: MyInterfaces
|
||||
base_path b Path to create classes in.
|
||||
Default: ./lib
|
||||
typemap_include mi File to include in typemap.
|
||||
Default: .
|
||||
typemap_include mi File to include in typemap. Must eval() to a valid
|
||||
perl hash (not a hash ref !).
|
||||
proxy x HTTP(S) proxy to use (if any). wsdl2perl will also
|
||||
use the proxy settings specified via the HTTP_PROXY
|
||||
and HTTPS_PROXY environment variables.
|
||||
keep_alive Use http keep_alive.
|
||||
user Username for HTTP authentication
|
||||
password Password. wsdl2perl will prompt if not given.
|
||||
generator g Generator to use.
|
||||
Default: XSD
|
||||
help h Show help content
|
||||
|
||||
=head1 DESCRIPTION
|
||||
@@ -95,7 +164,7 @@ The following classes are created:
|
||||
|
||||
=over
|
||||
|
||||
=item * A interface class for every service
|
||||
=item * A interface class for every SOAP port in service
|
||||
|
||||
Interface classes are what you will mainly deal with: They provide a method
|
||||
for accessing every web service method.
|
||||
@@ -116,10 +185,34 @@ typemap_include (mi) option.
|
||||
You may need to write additional type classes if your WSDL is incomplete.
|
||||
|
||||
For writing your own lib classes, see L<SOAP::WSDL::XSD::Typelib::Element>,
|
||||
L<SOAP::WSDL::XSD::Typelib::ComplexType> and L<SOAP::WSDL::XSD::Typelib::SimpleType>.
|
||||
L<SOAP::WSDL::XSD::Typelib::ComplexType>
|
||||
and L<SOAP::WSDL::XSD::Typelib::SimpleType>.
|
||||
|
||||
=back
|
||||
|
||||
=head1 TROUBLESHOOTING
|
||||
|
||||
=head2 Accessing HTTPS URLs
|
||||
|
||||
You need Crypt::SSLeay installed for accessing HTTPS URLs.
|
||||
|
||||
=head2 Accessing protected documents
|
||||
|
||||
Use the -u option for specifying the user name. You will be prompted for a
|
||||
password.
|
||||
|
||||
Alternatively, you may specify a passowrd with --password on the command
|
||||
line.
|
||||
|
||||
=head2 Accessing documents protected by NTLM authentication
|
||||
|
||||
Set the --keep_alive option.
|
||||
|
||||
Note that accessing documents protected by NTLM authentication is currently
|
||||
untested, because I have no access to a system using NTLM authentication.
|
||||
If you try it, I would be glad if you could just drop me a note about
|
||||
success or failure.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2007 Martin Kutter.
|
||||
|
||||
+30
-16
@@ -11,23 +11,37 @@
|
||||
|
||||
use lib 'lib/';
|
||||
use MyInterfaces::FullerData_x0020_Fortune_x0020_Cookie;
|
||||
use MyElements::GetFortuneCookie;
|
||||
my $cookieService = MyInterfaces::FullerData_x0020_Fortune_x0020_Cookie->new();
|
||||
|
||||
my $cookie = $cookieService->GetFortuneCookie();
|
||||
my $cookie;
|
||||
$cookie = $cookieService->GetFortuneCookie()
|
||||
or die "$cookie";
|
||||
|
||||
if ($cookie) {
|
||||
print $cookie->get_GetFortuneCookieResult()->get_value, "\n";
|
||||
}
|
||||
else {
|
||||
print $cookie;
|
||||
}
|
||||
print $cookie; # ->get_GetFortuneCookieResult()->get_value, "\n";
|
||||
|
||||
$cookie = $cookieService->GetSpecificCookie({ index => 23 });
|
||||
if ($cookie) {
|
||||
print $cookie
|
||||
->get_GetSpecificCookieResult(), "\n";
|
||||
}
|
||||
else {
|
||||
print $cookie;
|
||||
}
|
||||
$cookie = $cookieService->GetSpecificCookie({ index => 23 })
|
||||
or die "$cookie";
|
||||
|
||||
print $cookie->get_GetSpecificCookieResult(), "\n";
|
||||
|
||||
print $cookie;
|
||||
|
||||
|
||||
=for demo:
|
||||
|
||||
# the same in SOAP lite (second call)
|
||||
#
|
||||
|
||||
use SOAP::Lite;
|
||||
|
||||
my $lite = SOAP::Lite->new()->on_action(sub { join '/', @_ } )
|
||||
->proxy('http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx');
|
||||
|
||||
$lite->call(
|
||||
SOAP::Data->name('GetSpecificCookie')
|
||||
->attr({ 'xmlns', 'http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx' }),
|
||||
SOAP::Data->name('index')->value(23)
|
||||
);
|
||||
|
||||
die $soap->message() if ($soap->fault());
|
||||
print $soap->result();
|
||||
@@ -3,6 +3,7 @@ use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Element;
|
||||
|
||||
|
||||
# atomic complexType
|
||||
# <element name="GetCitiesByCountry"><complexType> definition
|
||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
@@ -46,9 +47,16 @@ __PACKAGE__->__set_ref('');
|
||||
|
||||
__END__
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME MyElements::GetCitiesByCountry
|
||||
=head1 NAME
|
||||
|
||||
MyElements::GetCitiesByCountry
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
||||
@@ -3,6 +3,7 @@ use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Element;
|
||||
|
||||
|
||||
# atomic complexType
|
||||
# <element name="GetCitiesByCountryResponse"><complexType> definition
|
||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
@@ -46,9 +47,16 @@ __PACKAGE__->__set_ref('');
|
||||
|
||||
__END__
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME MyElements::GetCitiesByCountryResponse
|
||||
=head1 NAME
|
||||
|
||||
MyElements::GetCitiesByCountryResponse
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
||||
@@ -3,6 +3,7 @@ use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Element;
|
||||
|
||||
|
||||
# atomic complexType
|
||||
# <element name="GetWeather"><complexType> definition
|
||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
@@ -54,9 +55,16 @@ __PACKAGE__->__set_ref('');
|
||||
|
||||
__END__
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME MyElements::GetWeather
|
||||
=head1 NAME
|
||||
|
||||
MyElements::GetWeather
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
||||
@@ -3,6 +3,7 @@ use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Element;
|
||||
|
||||
|
||||
# atomic complexType
|
||||
# <element name="GetWeatherResponse"><complexType> definition
|
||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
@@ -46,9 +47,16 @@ __PACKAGE__->__set_ref('');
|
||||
|
||||
__END__
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME MyElements::GetWeatherResponse
|
||||
=head1 NAME
|
||||
|
||||
MyElements::GetWeatherResponse
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
||||
@@ -3,6 +3,7 @@ use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Element;
|
||||
|
||||
|
||||
#
|
||||
# <element name="string" type="s:string"/> definition
|
||||
#
|
||||
@@ -13,7 +14,7 @@ use base qw(
|
||||
);
|
||||
|
||||
|
||||
sub get_xmlns { 'http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx' }
|
||||
sub get_xmlns { 'http://www.webserviceX.NET' }
|
||||
|
||||
__PACKAGE__->__set_name('string');
|
||||
__PACKAGE__->__set_nillable(true);
|
||||
@@ -26,9 +27,16 @@ __PACKAGE__->__set_ref('');
|
||||
|
||||
__END__
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME MyElements::string
|
||||
=head1 NAME
|
||||
|
||||
MyElements::string
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
package MyInterfaces::GlobalWeather;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use MyTypemaps::GlobalWeather;
|
||||
@@ -16,8 +17,18 @@ sub new {
|
||||
}
|
||||
|
||||
__PACKAGE__->__create_methods(
|
||||
GetWeather => [ 'MyElements::GetWeather', ],
|
||||
GetCitiesByCountry => [ 'MyElements::GetCitiesByCountry', ],
|
||||
GetWeather => {
|
||||
parts => [ 'MyElements::GetWeather', ],
|
||||
soap_action => 'http://www.webserviceX.NET/GetWeather',
|
||||
style => 'document',
|
||||
# use => '', # use not implemented yet
|
||||
},
|
||||
GetCitiesByCountry => {
|
||||
parts => [ 'MyElements::GetCitiesByCountry', ],
|
||||
soap_action => 'http://www.webserviceX.NET/GetCitiesByCountry',
|
||||
style => 'document',
|
||||
# use => '', # use not implemented yet
|
||||
},
|
||||
|
||||
);
|
||||
|
||||
@@ -25,6 +36,10 @@ __PACKAGE__->__create_methods(
|
||||
|
||||
__END__
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
@@ -38,222 +53,31 @@ http://www.webservicex.net/globalweather.asmx
|
||||
my $GetCitiesByCountry = $interface->GetCitiesByCountry();
|
||||
|
||||
|
||||
=head1 Service GlobalWeather
|
||||
=head1 METHODS
|
||||
|
||||
=head2 Service information:
|
||||
=head2 GetWeather
|
||||
|
||||
Port name: GlobalWeatherSoap
|
||||
Binding: tns:GlobalWeatherSoap
|
||||
Location: http://www.webservicex.net/globalweather.asmx
|
||||
Get weather report for all major cities around the world.
|
||||
|
||||
=head2 SOAP Operations
|
||||
SYNOPSIS:
|
||||
|
||||
B<Note:>
|
||||
|
||||
Input, output and fault messages are stated as perl hash refs.
|
||||
|
||||
These are only for informational purposes - the actual implementation
|
||||
normally uses object trees, not hash refs, though the input messages
|
||||
may be passed to the respective methods as hash refs and will be
|
||||
converted to object trees automatically.
|
||||
|
||||
|
||||
=head3 GetWeather
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
$service->GetWeather({
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
});
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
=head2 GetCitiesByCountry
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
Get all major cities by country name(full / part).
|
||||
|
||||
SYNOPSIS:
|
||||
|
||||
$service->GetCitiesByCountry({
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
});
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
|
||||
=head3 GetCitiesByCountry
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
=head2 Service information:
|
||||
|
||||
Port name: GlobalWeatherHttpGet
|
||||
Binding: tns:GlobalWeatherHttpGet
|
||||
Location:
|
||||
|
||||
=head2 SOAP Operations
|
||||
|
||||
B<Note:>
|
||||
|
||||
Input, output and fault messages are stated as perl hash refs.
|
||||
|
||||
These are only for informational purposes - the actual implementation
|
||||
normally uses object trees, not hash refs, though the input messages
|
||||
may be passed to the respective methods as hash refs and will be
|
||||
converted to object trees automatically.
|
||||
|
||||
|
||||
=head3 GetWeather
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
|
||||
=head3 GetCitiesByCountry
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
=head2 Service information:
|
||||
|
||||
Port name: GlobalWeatherHttpPost
|
||||
Binding: tns:GlobalWeatherHttpPost
|
||||
Location:
|
||||
|
||||
=head2 SOAP Operations
|
||||
|
||||
B<Note:>
|
||||
|
||||
Input, output and fault messages are stated as perl hash refs.
|
||||
|
||||
These are only for informational purposes - the actual implementation
|
||||
normally uses object trees, not hash refs, though the input messages
|
||||
may be passed to the respective methods as hash refs and will be
|
||||
converted to object trees automatically.
|
||||
|
||||
|
||||
=head3 GetWeather
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
|
||||
=head3 GetCitiesByCountry
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
{
|
||||
'GetWeather'=> {
|
||||
'CityName' => $someValue,
|
||||
'CountryName' => $someValue,
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
B<Fault:>
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
=cut
|
||||
=pod
|
||||
|
||||
@@ -3,6 +3,14 @@ use strict;
|
||||
use warnings;
|
||||
|
||||
my %typemap = (
|
||||
# SOAP 1.1 fault typemap
|
||||
'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11',
|
||||
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::TOKEN',
|
||||
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
|
||||
# generated typemap
|
||||
'GetWeather' => 'MyElements::GetWeather',
|
||||
# atomic complex type (sequence)
|
||||
'GetWeather/CityName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
@@ -24,12 +32,9 @@ my %typemap = (
|
||||
'GetCitiesByCountryResponse/GetCitiesByCountryResult' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
|
||||
# end atomic complex type (sequence)
|
||||
Fault => 'SOAP::WSDL::SOAP::Typelib::Fault11',
|
||||
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
|
||||
|
||||
|
||||
|
||||
);
|
||||
|
||||
|
||||
@@ -0,0 +1,26 @@
|
||||
package PersonVisitor;
|
||||
use Class::Std; # handles all basic stuff like constructors etc.
|
||||
|
||||
sub visit_Person {
|
||||
my ( $self, $object ) = @_;
|
||||
print "Person name is ", $object->get_name(), "\n";
|
||||
}
|
||||
|
||||
package Person;
|
||||
use Class::Std;
|
||||
my %name : ATTR(:name<name> :default<anonymous>);
|
||||
|
||||
sub accept { $_[1]->visit_Person( $_[0] ) }
|
||||
|
||||
package main;
|
||||
my @person_from = ();
|
||||
for (qw(Gamma Helm Johnson Vlissides)) {
|
||||
push @person_from, Person->new( { name => $_ } );
|
||||
}
|
||||
|
||||
my $visitor = PersonVisitor->new();
|
||||
for (@person_from) {
|
||||
$_->accept($visitor);
|
||||
}
|
||||
|
||||
|
||||
+12
-11
@@ -1,19 +1,20 @@
|
||||
# Accessing the fortune cookie service at
|
||||
# Accessing the globalweather service at
|
||||
# www.webservicex.net/GlobalWeather/GlobalWeather.asmx
|
||||
#
|
||||
# I have no connection to www.webservicex.net
|
||||
# Note that the GlobalWeather web service returns a (quoted) XML structure -
|
||||
# don't be surprised by the response's format.
|
||||
#
|
||||
# I have no connection to www.webservicex.net
|
||||
# Use this script at your own risk.
|
||||
#
|
||||
# This script demonstrates the use of a interface generated by wsdl2perl.pl
|
||||
|
||||
use lib 'lib/';
|
||||
use MyInterfaces::GlobalWeather;
|
||||
my $webservice = MyInterfaces::GlobalWeather->new();
|
||||
my $weather = MyInterfaces::GlobalWeather->new({ no_dispatch => 1 });
|
||||
my $result = $weather->GetWeather({ CountryName => 'Germany', CityName => 'Munich' });
|
||||
print $result;
|
||||
# boolean comparison overloaded
|
||||
die $result->get_faultstring()->get_value() if not ($result);
|
||||
|
||||
my $result = $webservice->GetWeather({ CountryName => 'Germany', CityName => 'Munich' });
|
||||
|
||||
if ($result) {
|
||||
print $result->get_GetWeatherResult()->get_value(), "\n";
|
||||
}
|
||||
else {
|
||||
print $result;
|
||||
}
|
||||
print $result->get_GetWeatherResult()->get_value() , "\n";
|
||||
@@ -0,0 +1,43 @@
|
||||
# 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 File::Basename qw(dirname);
|
||||
use File::Spec;
|
||||
my $path = File::Spec->rel2abs( dirname __FILE__);
|
||||
|
||||
# SOAP::WSDL variant
|
||||
use SOAP::WSDL;
|
||||
my $soap = SOAP::WSDL->new();
|
||||
my $som = $soap->wsdl("file:///$path/wsdl/globalweather.xml")
|
||||
->call('GetWeather', GetWeather =>
|
||||
{ CountryName => 'Germany', CityName => 'Munich' }
|
||||
);
|
||||
|
||||
die "Error" if $som->fault();
|
||||
print $som->result();
|
||||
|
||||
# SOAP::Lite variant:
|
||||
# Note that you have to look both the proxy and the xmlns attribute
|
||||
# set on the GetWeather SOAP::Data object from the WSDL.
|
||||
|
||||
use SOAP::Lite +trace;
|
||||
$soap = SOAP::Lite->new()->on_action( sub { join'/', @_ } )
|
||||
->proxy("http://www.webservicex.net/globalweather.asmx"); # from WSDL
|
||||
$som = $soap->call(
|
||||
SOAP::Data->name('GetWeather')
|
||||
->attr({ xmlns => 'http://www.webserviceX.NET' }), # from WSDL
|
||||
SOAP::Data->name('CountryName')->value('Germany'),
|
||||
SOAP::Data->name('CityName')->value('Munich')
|
||||
);
|
||||
die "Error" if $som->fault();
|
||||
print $som->result();
|
||||
+429
-356
@@ -1,181 +1,190 @@
|
||||
package SOAP::WSDL;
|
||||
use strict;
|
||||
use warnings;
|
||||
use vars qw/$AUTOLOAD/;
|
||||
use vars qw($AUTOLOAD);
|
||||
use Carp;
|
||||
use Scalar::Util qw(blessed);
|
||||
use SOAP::WSDL::Envelope;
|
||||
use SOAP::WSDL::SAX::WSDLHandler;
|
||||
use base qw(SOAP::Lite);
|
||||
use Data::Dumper;
|
||||
use SOAP::WSDL::Client;
|
||||
use SOAP::WSDL::Expat::WSDLParser;
|
||||
use Class::Std;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
|
||||
use LWP::UserAgent;
|
||||
|
||||
our $VERSION='2.00_05';
|
||||
our $VERSION='2.00_17';
|
||||
|
||||
BEGIN {
|
||||
eval {
|
||||
use XML::LibXML;
|
||||
my %no_dispatch_of :ATTR(:name<no_dispatch>);
|
||||
my %wsdl_of :ATTR(:name<wsdl>);
|
||||
my %proxy_of :ATTR(:name<proxy>);
|
||||
my %autotype_of :ATTR(:name<autotype>);
|
||||
my %outputxml_of :ATTR(:name<outputxml> :default<0>);
|
||||
my %outputtree_of :ATTR(:name<outputtree>);
|
||||
my %outputhash_of :ATTR(:name<outputhash>);
|
||||
my %servicename_of :ATTR(:name<servicename>);
|
||||
my %portname_of :ATTR(:name<portname>);
|
||||
my %class_resolver_of :ATTR(:name<class_resolver>);
|
||||
|
||||
my %method_info_of :ATTR(:default<()>);
|
||||
my %port_of :ATTR(:default<()>);
|
||||
my %porttype_of :ATTR(:default<()>);
|
||||
my %binding_of :ATTR(:default<()>);
|
||||
my %service_of :ATTR(:default<()>);
|
||||
my %definitions_of :ATTR(:get<definitions> :default<()>);
|
||||
my %serialize_options_of :ATTR(:default<()>);
|
||||
|
||||
my %client_of :ATTR(:name<client> :default<()>);
|
||||
my %keep_alive_of :ATTR(:name<keep_alive> :default<0> );
|
||||
|
||||
my %LOOKUP = (
|
||||
no_dispatch => \%no_dispatch_of,
|
||||
class_resolver => \%class_resolver_of,
|
||||
wsdl => \%wsdl_of,
|
||||
proxy => \%proxy_of,
|
||||
autotype => \%autotype_of,
|
||||
outputxml => \%outputxml_of,
|
||||
outputtree => \%outputtree_of,
|
||||
outputhash => \%outputhash_of,
|
||||
portname => \%portname_of,
|
||||
servicename => \%servicename_of,
|
||||
keep_alive => \%keep_alive_of,
|
||||
);
|
||||
|
||||
sub readable { warn <<EOT;
|
||||
'readable' has no effect any more. If you want formatted XML,
|
||||
copy the debug output to your favorite XML editor and run the
|
||||
source format command.
|
||||
EOT
|
||||
}
|
||||
|
||||
sub set_readable; *set_readable = \&readable;
|
||||
|
||||
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 };
|
||||
};
|
||||
if ($@) {
|
||||
use XML::SAX::ParserFactory;
|
||||
}
|
||||
|
||||
{ # just a BLOCK for scoping warnings.
|
||||
|
||||
# we need to roll our own for supporting
|
||||
# SOAP::WSDL->new( key => value ) syntax,
|
||||
# like SOAP::Lite does. Class::Std enforces a single hash ref as
|
||||
# parameters to new()
|
||||
no warnings qw(redefine);
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my %args_from = @_;
|
||||
my $self = \do { my $foo = undef };
|
||||
bless $self, $class;
|
||||
|
||||
for (keys %args_from) {
|
||||
my $method = $self->can("set_$_")
|
||||
or croak "unknown parameter $_ passed to new";
|
||||
$method->($self, $args_from{$_});
|
||||
}
|
||||
my $ident = ident $self;
|
||||
$self->wsdlinit() if ($wsdl_of{ $ident });
|
||||
|
||||
$client_of{ $ident } = SOAP::WSDL::Client->new();
|
||||
|
||||
return $self;
|
||||
}
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
|
||||
die "$method not found";
|
||||
}
|
||||
|
||||
sub outputtree {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ outputtree } if not @_;
|
||||
return $self->{ _WSDL }->{ outputtree } = shift;
|
||||
}
|
||||
|
||||
sub class_resolver {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ class_resolver } if not @_;
|
||||
return $self->{ _WSDL }->{ class_resolver } = shift;
|
||||
}
|
||||
|
||||
sub wsdlinit {
|
||||
my $self = shift;
|
||||
my $ident = ident $self;
|
||||
my %opt = @_;
|
||||
|
||||
my $wsdl_xml = SOAP::Schema->new( schema_url => $self->wsdl() )->access(
|
||||
$self->wsdl()
|
||||
my $lwp = LWP::UserAgent->new(
|
||||
$keep_alive_of{ $ident }
|
||||
? (keep_alive => 1)
|
||||
: ()
|
||||
);
|
||||
my $response = $lwp->get( $wsdl_of{ $ident } );
|
||||
croak $response->message() if ($response->code != 200);
|
||||
|
||||
my $filter;
|
||||
my $parser = eval { XML::LibXML->new() };
|
||||
if ($parser) {
|
||||
$filter = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||
$parser->set_handler( $filter );
|
||||
}
|
||||
else {
|
||||
$filter = SOAP::WSDL::SAX::WSDLHandler->new( base => 'XML::SAX::Base' );
|
||||
$parser = XML::SAX::ParserFactory->parser( Handler => $filter );
|
||||
}
|
||||
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
|
||||
$parser->parse_string( $response->content() );
|
||||
|
||||
$parser->parse_string( $wsdl_xml );
|
||||
|
||||
my $wsdl_definitions = $filter->get_data()
|
||||
or die "unable to parse WSDL";
|
||||
my $wsdl_definitions = $parser->get_data();
|
||||
|
||||
# sanity checks
|
||||
my $types = $wsdl_definitions->first_types()
|
||||
or die "unable to extract schema from WSDL";
|
||||
|
||||
my $ns = $wsdl_definitions->get_xmlns()
|
||||
or die "unable to extract XML Namespaces" . $wsdl_definitions->to_string;
|
||||
( %{ $ns } ) or die "unable to extract XML Namespaces";
|
||||
|
||||
# setup lookup variables
|
||||
$self->{ _WSDL }->{ wsdl_definitions } = $wsdl_definitions;
|
||||
$self->{ _WSDL }->{ serialize_options } = {
|
||||
$definitions_of{ $ident } = $wsdl_definitions;
|
||||
$serialize_options_of{ $ident } = {
|
||||
autotype => 0,
|
||||
readable => $self->readable(),
|
||||
typelib => $types,
|
||||
namespace => $ns,
|
||||
};
|
||||
$self->{ _WSDL }->{ explain_options } = {
|
||||
readable => $self->readable(),
|
||||
wsdl => $wsdl_definitions,
|
||||
namespace => $ns,
|
||||
typelib => $types,
|
||||
};
|
||||
|
||||
$self->servicename($opt{servicename}) if $opt{servicename};
|
||||
$self->portname($opt{portname}) if $opt{portname};
|
||||
$servicename_of{ $ident } = $opt{servicename} if $opt{servicename};
|
||||
$portname_of{ $ident } = $opt{portname} if $opt{portname};
|
||||
return $self;
|
||||
} ## end sub wsdlinit
|
||||
|
||||
sub _wsdl_get_service {
|
||||
my $self = shift;
|
||||
my $service;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
if ( $self->{ _WSDL }->{ servicename } )
|
||||
{
|
||||
$service =
|
||||
$wsdl->find_service( $ns, $self->{ _WSDL }->{ servicename } );
|
||||
}
|
||||
else
|
||||
{
|
||||
$service = $wsdl->get_service()->[ 0 ];
|
||||
warn "no servicename specified - using " . $service->get_name();
|
||||
}
|
||||
return $self->{ _WSDL }->{ service } = $service;
|
||||
sub _wsdl_get_service :PRIVATE {
|
||||
my $ident = ident shift;
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
return $service_of{ $ident } = $servicename_of{ $ident }
|
||||
? $wsdl->find_service( $wsdl->get_targetNamespace() , $servicename_of{ $ident } )
|
||||
: $service_of{ $ident } = $wsdl->get_service()->[ 0 ];
|
||||
} ## end sub _wsdl_get_service
|
||||
|
||||
sub _wsdl_get_port {
|
||||
my $self = shift;
|
||||
my $service = $self->{ _WSDL }->{ service }
|
||||
|| $self->_wsdl_get_service();
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
my $port;
|
||||
if ( $self->{ _WSDL }->{ portname } )
|
||||
{
|
||||
$port = $service->get_port( $ns, $self->{ _WSDL }->{ portname } );
|
||||
}
|
||||
else
|
||||
{
|
||||
$port = $service->get_port()->[ 0 ];
|
||||
}
|
||||
$self->{ _WSDL }->{ port } = $port;
|
||||
|
||||
# preload portType
|
||||
$self->_wsdl_get_portType();
|
||||
|
||||
# Auto-set proxy - required before issuing call()
|
||||
$self->proxy( $port->get_location() );
|
||||
|
||||
return $port;
|
||||
} ## end sub _wsdl_get_port
|
||||
|
||||
sub _wsdl_get_binding {
|
||||
my $self = shift;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
sub _wsdl_get_port :PRIVATE {
|
||||
my $ident = ident shift;
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
my $port = $self->{ _WSDL }->{ port }
|
||||
|| $self->_wsdl_get_port();
|
||||
return $port_of{ $ident } = $portname_of{ $ident }
|
||||
? $service_of{ $ident }->get_port( $ns, $portname_of{ $ident } )
|
||||
: $port_of{ $ident } = $service_of{ $ident }->get_port()->[ 0 ];
|
||||
}
|
||||
|
||||
my ( $prefix, $localname ) = split /:/, $port->get_binding();
|
||||
|
||||
# TODO lookup $ns instead of just using
|
||||
# the top element's targetns...
|
||||
my $binding = $wsdl->find_binding( $ns, $localname )
|
||||
sub _wsdl_get_binding :PRIVATE {
|
||||
my $self = shift;
|
||||
my $ident = ident $self;
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
my $port = $port_of{ $ident } || $self->_wsdl_get_port();
|
||||
$binding_of{ $ident } = $wsdl->find_binding( $port->expand( $port->get_binding() ) )
|
||||
or die "no binding found for ", $port->get_binding();
|
||||
return $self->{ _WSDL }->{ binding } = $binding;
|
||||
} ## end sub _wsdl_get_binding
|
||||
return $binding_of{ $ident };
|
||||
}
|
||||
|
||||
sub _wsdl_get_portType {
|
||||
sub _wsdl_get_portType :PRIVATE {
|
||||
my $self = shift;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $binding = $self->{ _WSDL }->{ binding }
|
||||
|| $self->_wsdl_get_binding();
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
my ( $prefix, $localname ) = split /:/, $binding->get_type();
|
||||
my $portType = $wsdl->find_portType( $ns, $localname );
|
||||
$self->{ _WSDL }->{ portType } = $portType;
|
||||
return $portType;
|
||||
} ## end sub _wsdl_get_portType
|
||||
my $ident = ident $self;
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
my $binding = $binding_of{ $ident } || $self->_wsdl_get_binding();
|
||||
$porttype_of{ $ident } = $wsdl->find_portType( $binding->expand( $binding->get_type() ) )
|
||||
or die "cannot find portType for " . $binding->get_type();
|
||||
return $porttype_of{ $ident };
|
||||
}
|
||||
|
||||
|
||||
sub _wsdl_init_methods {
|
||||
sub _wsdl_init_methods :PRIVATE {
|
||||
my $self = shift;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $ident = ident $self;
|
||||
my $wsdl = $definitions_of{ $ident };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
|
||||
# get bindings, portType, message, part(s)
|
||||
# - use cached values where possible for speed,
|
||||
# private methods if not for clear separation...
|
||||
my $binding = $self->{ _WSDL }->{ binding }
|
||||
|| $self->_wsdl_get_binding()
|
||||
# get bindings, portType, message, part(s) - use private methods for clear separation...
|
||||
$self->_wsdl_get_service if not ($service_of{ $ident });
|
||||
my $binding = $binding_of{ $ident } || $self->_wsdl_get_binding()
|
||||
|| die "Can't find binding";
|
||||
my $portType = $self->{ _WSDL }->{ portType }
|
||||
|| $self->_wsdl_get_portType()
|
||||
|| die "Can't find portType";
|
||||
my $portType = $porttype_of{ $ident } || $self->_wsdl_get_portType();
|
||||
|
||||
my $methodHashRef = {};
|
||||
$method_info_of{ $ident } = {};
|
||||
|
||||
foreach my $binding_operation (@{ $binding->get_operation() })
|
||||
{
|
||||
@@ -200,212 +209,108 @@ sub _wsdl_init_methods {
|
||||
my $message = $wsdl->find_message( $ns, $localname )
|
||||
or die "Message {$ns}$localname not found in WSDL definition";
|
||||
|
||||
$method->{ parts } = $message->get_part();
|
||||
if (my $body=$binding_operation->first_input()->first_body()) {
|
||||
if ($body->get_parts()) {
|
||||
$method->{ parts } = []; # make sure it's empty
|
||||
my $message_part_ref = $message->get_part();
|
||||
for my $name (split m{\s} , $body->get_parts() ) {
|
||||
$name =~s{ \A [^:]+: }{}x; # throw away ns prefix
|
||||
# could probably made more efficient, but our lists are
|
||||
# usually quite short
|
||||
push @{ $method->{ parts } },
|
||||
grep { $_->get_name() eq $name } @{ $message_part_ref };
|
||||
}
|
||||
}
|
||||
}
|
||||
$method->{ parts } ||= $message->get_part();
|
||||
|
||||
|
||||
# rpc / encoded methods may have a namespace specified.
|
||||
# look it up and set it...
|
||||
$method->{ namespace } = $binding_operation
|
||||
? do {
|
||||
my $input = $binding_operation->first_input();
|
||||
$input ? $input->get_namespace() : undef;
|
||||
$input ? $input->first_body()->get_namespace() : undef;
|
||||
}
|
||||
: undef;
|
||||
|
||||
$methodHashRef->{ $binding_operation->get_name() } = $method;
|
||||
$method_info_of{ $ident }->{ $binding_operation->get_name() } = $method;
|
||||
}
|
||||
|
||||
$self->{ _WSDL }->{ methodInfo } = $methodHashRef;
|
||||
|
||||
return $methodHashRef;
|
||||
return $method_info_of{ $ident };
|
||||
}
|
||||
|
||||
sub call {
|
||||
my $self = shift;
|
||||
my $method = shift;
|
||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
||||
my ($self, $method, @data_from) = @_;
|
||||
my $ident = ident $self;
|
||||
|
||||
my $content = q{};
|
||||
my $envelope;
|
||||
my $methodInfo;
|
||||
my ($data, $header) = ref $data_from[0]
|
||||
? ($data_from[0], $data_from[1] )
|
||||
: (@data_from>1)
|
||||
? ( { @data_from }, undef )
|
||||
: ( $data_from[0], undef );
|
||||
|
||||
if (blessed $data
|
||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
||||
{
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
||||
$self->wsdlinit() if not ($definitions_of{ $ident });
|
||||
$self->_wsdl_init_methods() if not ($method_info_of{ $ident });
|
||||
|
||||
# TODO replace by something derived from binding - this is just a
|
||||
# workaround...
|
||||
$methodInfo->{ soap_action }
|
||||
= join '/', $data->get_xmlns(), $method;
|
||||
}
|
||||
else {
|
||||
my $methodLookup = $self->{ _WSDL }->{ methodInfo }
|
||||
|| $self->_wsdl_init_methods();
|
||||
my $client = $client_of{ $ident };
|
||||
|
||||
$methodInfo = $methodLookup->{ $method };
|
||||
my $partListRef = $methodInfo->{ parts };
|
||||
|
||||
# set serializer options
|
||||
# TODO allow custom options here
|
||||
my $opt = $self->{ _WSDL }->{ serialize_options };
|
||||
|
||||
# set response target namespace
|
||||
# TODO make rpc-encoded encoding recognise this namespace
|
||||
# $opt->{ targetNamespace } = $soap_binding_operation ?
|
||||
# $operation->input()->namespace() : undef;
|
||||
|
||||
# serialize content
|
||||
# TODO create surrounding element for rpc-encoded messages
|
||||
foreach my $part ( @{ $partListRef } ) {
|
||||
$content .= $part->serialize( $method, $data, $opt );
|
||||
}
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $content , $opt );
|
||||
};
|
||||
|
||||
|
||||
if ( $self->no_dispatch() ) {
|
||||
return $envelope;
|
||||
} ## end if ( $self->no_dispatch...
|
||||
|
||||
# get response via transport layer
|
||||
# TODO remove dependency from SOAP::Lite and use a
|
||||
# SAX-based filter using XML::LibXML to get the
|
||||
# result.
|
||||
# Filter should have the following methods:
|
||||
# - result: returns the result of the call (like SOAP::Lite, but as
|
||||
# perl data structure)
|
||||
# - header: returns the content of the SOAP header
|
||||
# - fault: returns the result of the call if a SOAP fault is sent back
|
||||
# by the server. Retuns undef (nothing) if the call has been
|
||||
# processed without errors.
|
||||
my $response = $self->transport->send_receive(
|
||||
context => $self, # this is provided for context
|
||||
endpoint => $self->endpoint(),
|
||||
action => $methodInfo->{ soap_action }, # SOAPAction from binding
|
||||
envelope => $envelope, # use custom content
|
||||
# pass-through keep_alive if we need it...
|
||||
$client->set_proxy( $proxy_of{ $ident }
|
||||
|| $port_of{ $ident }->first_address()->get_location(),
|
||||
$keep_alive_of{ $ident } ? (keep_alive => 1) : (),
|
||||
);
|
||||
|
||||
return $response if ($self->outputxml() );
|
||||
$client->set_no_dispatch( $no_dispatch_of{ $ident } );
|
||||
$client->set_outputxml( $outputxml_of{ $ident } ? 1 : 0 );
|
||||
|
||||
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 {
|
||||
my $self = shift;
|
||||
my $opt = $self->{ _WSDL }->{ explain_options };
|
||||
|
||||
return $self->{ _WSDL }->{ wsdl_definitions }->explain( $opt );
|
||||
} ## end sub explain
|
||||
|
||||
sub _load_method {
|
||||
my $method = shift;
|
||||
no strict "refs";
|
||||
*$method = sub {
|
||||
my $self = shift;
|
||||
return ( @_ ) ? $self->{ _WSDL }->{ $method } = shift
|
||||
: $self->{ _WSDL }->{ $method }
|
||||
# only load ::Deserializer::SOM if we really need to deserialize to SOM.
|
||||
# maybe we should introduce something like $output{ $ident } with a fixed
|
||||
# set of values - m{^(TREE|HASH|XML|SOM)$}xms ?
|
||||
if ( ( ! $outputtree_of{ $ident } )
|
||||
&& ( ! $outputhash_of{ $ident } )
|
||||
&& ( ! $outputxml_of{ $ident } )
|
||||
&& ( ! $no_dispatch_of{ $ident } ) ) {
|
||||
require SOAP::WSDL::Deserializer::SOM;
|
||||
$client->set_deserializer( SOAP::WSDL::Deserializer::SOM->new() );
|
||||
};
|
||||
} ## end sub _load_method
|
||||
|
||||
&_load_method( 'no_dispatch' );
|
||||
&_load_method( 'wsdl' );
|
||||
my $method_info = $method_info_of{ $ident }->{ $method };
|
||||
|
||||
sub servicename {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ servicename } if ( not @_ );
|
||||
$self->{ _WSDL }->{ servicename } = shift;
|
||||
# TODO serialize both header and body, not only header
|
||||
my (@response) = (blessed $data)
|
||||
? $client->call( {
|
||||
operation => $method,
|
||||
soap_action => $method_info->{ soap_action },
|
||||
}, $data )
|
||||
: do {
|
||||
my $content = '';
|
||||
# TODO support RPC-encoding: Top-Level element + namespace...
|
||||
foreach my $part ( @{ $method_info->{ parts } } ) {
|
||||
$content .= $part->serialize( $method, $data,
|
||||
{
|
||||
%{ $serialize_options_of{ $ident } },
|
||||
} );
|
||||
}
|
||||
$client->call(
|
||||
{
|
||||
operation => $method,
|
||||
soap_action => $method_info->{ soap_action }
|
||||
},
|
||||
# absolutely stupid, but we need a reference which
|
||||
# serializes to XML on stringification...
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({
|
||||
value => $content
|
||||
}),
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({
|
||||
value => $header
|
||||
})
|
||||
);
|
||||
};
|
||||
|
||||
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
|
||||
return unless @response; # nothing to do for one-ways
|
||||
return wantarray ? @response : $response[0];
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
@@ -417,12 +322,19 @@ __END__
|
||||
|
||||
SOAP::WSDL - SOAP with WSDL support
|
||||
|
||||
=head1 Overview
|
||||
|
||||
For creating Perl classes instrumenting a web service with a WSDL definition,
|
||||
read L<SOAP::WSDL::Manual>.
|
||||
|
||||
For using an interpreting (thus slow and somewhat troublesome) WSDL based
|
||||
SOAP client, which mimics L<SOAP::Lite|SOAP::Lite>'s API, read on.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file://bla.wsdl',
|
||||
readable => 1,
|
||||
)->wsdlinit();
|
||||
);
|
||||
|
||||
my $result = $soap->call('MyMethod', %data);
|
||||
|
||||
@@ -432,16 +344,53 @@ SOAP::WSDL provides easy access to Web Services with WSDL descriptions.
|
||||
|
||||
The WSDL is parsed and stored in memory.
|
||||
|
||||
Your data is serialized according to the rules in the WSDL and sent via
|
||||
SOAP::Lite's transport mechanism.
|
||||
Your data is serialized according to the rules in the WSDL.
|
||||
|
||||
The only transport mechanisms currently supported are http and https.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 new
|
||||
|
||||
Constructor. All parameters passed are passed to the corresponding methods.
|
||||
|
||||
=head2 call
|
||||
|
||||
Performs a SOAP call. The result is either an object tree (with outputtree),
|
||||
a hash reference (with outputhash), plain XML (with outputxml) or a SOAP::SOM
|
||||
object (with neither of the above set).
|
||||
|
||||
call() can be called in different ways:
|
||||
|
||||
=over
|
||||
|
||||
=item * Old-style idiom
|
||||
|
||||
my $result = $soap->call('method', %data);
|
||||
|
||||
Does not support SOAP header data.
|
||||
|
||||
=item * New-style idiom
|
||||
|
||||
my $result = $soap->call('method', $body_ref, $header_ref );
|
||||
|
||||
Does support SOAP header data. $body_ref and $header ref may either be
|
||||
hash refs or SOAP::WSDL::XSD::Typelib::* derived objects.
|
||||
|
||||
Result headers are accessible via the result SOAP::SOM object.
|
||||
|
||||
If outputtree or outputhash are set, you may also use the following to
|
||||
access response header data:
|
||||
|
||||
my ($body, $header) = $soap->call('method', $body_ref, $header_ref );
|
||||
|
||||
=back
|
||||
|
||||
=head2 wsdlinit
|
||||
|
||||
Reads the WSDL file and initializes SOAP::WSDL for working with it.
|
||||
|
||||
Must be called after the wsdl URL has been set, and before calling one of
|
||||
Is called automatically from call() if not called directly before.
|
||||
|
||||
servicename
|
||||
portname
|
||||
@@ -455,14 +404,6 @@ wsdlinit:
|
||||
portname => 'MyPort'
|
||||
);
|
||||
|
||||
=head2 call
|
||||
|
||||
Performs a SOAP call. The result is either an object tree (with outputtree),
|
||||
a hash reference (with outputhash), plain XML (with outputxml) or a SOAP::SOM
|
||||
object (with neither of the above set).
|
||||
|
||||
my $result = $soap->call('method', %data);
|
||||
|
||||
=head1 CONFIGURATION METHODS
|
||||
|
||||
=head2 outputtree
|
||||
@@ -471,7 +412,7 @@ When outputtree is set, SOAP::WSDL will return an object tree instead of a
|
||||
SOAP::SOM object.
|
||||
|
||||
You have to specify a class_resolver for this to work. See
|
||||
<class_resolver|class_resolver>
|
||||
L<class_resolver|class_resolver>
|
||||
|
||||
=head2 class_resolver
|
||||
|
||||
@@ -481,8 +422,8 @@ Class resolvers must implement the method get_class which has to return the
|
||||
name of the class name for deserializing a XML node at the current XPath
|
||||
location.
|
||||
|
||||
Class resolvers are typically generated by using the to_typemap method on a
|
||||
SOAP::WSDL::Definitions objects.
|
||||
Class resolvers are typically generated by using the generate_typemap method
|
||||
of a SOAP::WSDL::Generator subclass.
|
||||
|
||||
Example:
|
||||
|
||||
@@ -515,8 +456,6 @@ SOAP::WSDL::XSD::ComplexType on how to build / generate one.
|
||||
Sets the service to operate on. If no service is set via servicename, the
|
||||
first service found is used.
|
||||
|
||||
Must be called after calling wsdlinit().
|
||||
|
||||
Returns the soap object, so you can chain calls like
|
||||
|
||||
$soap->servicename->('Name')->portname('Port');
|
||||
@@ -528,8 +467,6 @@ Returns the soap object, so you can chain calls like
|
||||
Sets the port to operate on. If no port is set via portname, the
|
||||
first port found is used.
|
||||
|
||||
Must be called after calling wsdlinit().
|
||||
|
||||
Returns the soap object, so you can chain calls like
|
||||
|
||||
$soap->portname('Port')->call('MyMethod', %data);
|
||||
@@ -539,12 +476,16 @@ Returns the soap object, so you can chain calls like
|
||||
When set, call() returns the plain request XML instead of dispatching the
|
||||
SOAP call to the SOAP service. Handy for testing/debugging.
|
||||
|
||||
=head2 _wsdl_init_methods
|
||||
=head1 ACCESS TO SOAP::WSDL's internals
|
||||
|
||||
Creates a lookup table containing the information required for all methods
|
||||
specified for the service/port selected.
|
||||
=head2 get_client / set_client
|
||||
|
||||
The lookup table is used by L<call|call>.
|
||||
Returns the SOAP client implementation used (normally a SOAP::WSDL::Client
|
||||
object).
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
See the examples/ directory.
|
||||
|
||||
=head1 Differences to previous versions
|
||||
|
||||
@@ -554,22 +495,23 @@ The lookup table is used by L<call|call>.
|
||||
|
||||
SOAP::WSDL 2 is a complete rewrite. While SOAP::WSDL 1.x attempted to
|
||||
process the WSDL file on the fly by using XPath queries, SOAP:WSDL 2 uses a
|
||||
SAX filter for parsing the WSDL and building up a object tree representing
|
||||
Expat handler for parsing the WSDL and building up a object tree representing
|
||||
it's content.
|
||||
|
||||
The object tree has two main functions: It knows how to serialize data passed
|
||||
as hash ref, and how to render the WSDL elements found into perl classes.
|
||||
|
||||
Yup your're right, there's a builting code generation facility.
|
||||
Yup your're right, there's a builting code generation facility. Read
|
||||
L<SOAP::WSDL::Manual> for using it.
|
||||
|
||||
=item * no_dispatch
|
||||
|
||||
call() with outputtxml set to true now returns the complete SOAP
|
||||
call() with no_dispatch set to true now returns the complete SOAP request
|
||||
envelope, not only the body's content.
|
||||
|
||||
=item * outputxml
|
||||
|
||||
call() with outputxml set to true now returns the complete SOAP
|
||||
call() with outputxml set to true now returns the complete SOAP response
|
||||
envelope, not only the body's content.
|
||||
|
||||
=item * servicename/portname
|
||||
@@ -582,44 +524,112 @@ You may pass the servicename and portname as attributes to wsdlinit, though.
|
||||
|
||||
=head1 Differences to SOAP::Lite
|
||||
|
||||
=head2 readable
|
||||
|
||||
readable is a no-op in SOAP::WSDL. Actually, the XML output from SOAP::Lite
|
||||
is hardly readable, either with readable switched on.
|
||||
|
||||
If you need readable XML messages, I suggest using your favorite XML editor
|
||||
for displaying and formatting.
|
||||
|
||||
=head2 Message style/encoding
|
||||
|
||||
While SOAP::Lite supports rpc/encoded style/encoding only, SOAP::WSDL currently
|
||||
supports document/literal style/encoding.
|
||||
|
||||
=head2 autotype / type information
|
||||
|
||||
SOAP::Lite defaults to transmitting XML type information by default, where
|
||||
SOAP::WSDL defaults to leaving it out.
|
||||
|
||||
autotype(1) might even be broken in SOAP::WSDL - it's not well-tested, yet.
|
||||
|
||||
=head2 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
|
||||
|
||||
=head2 outputxml
|
||||
|
||||
SOAP::Lite returns only the content of the SOAP body when outputxml is set
|
||||
to true. SOAP::WSDL returns the complete XML response.
|
||||
|
||||
=head2 Auto-Dispatching
|
||||
|
||||
SOAP::WSDL does B<does not> support auto-dispatching.
|
||||
|
||||
This is on purpose: You may easily create interface classes by using
|
||||
SOAP::WSDL and implementing something like
|
||||
SOAP::WSDL::Client and implementing something like
|
||||
|
||||
sub mySoapMethod {
|
||||
my $self = shift;
|
||||
$soap_wsdl_client->call( mySoapMethod, @_);
|
||||
}
|
||||
|
||||
You may even do this in a class factory - SOAP::WSDL provides the methods
|
||||
for generating such interfaces.
|
||||
You may even do this in a class factory - see L<wsdl2perl.pl> for creating
|
||||
such interfaces.
|
||||
|
||||
SOAP::Lite's autodispatching mechanism is - though convenient - a constant
|
||||
source of errors: Every typo in a method name gets caught by AUTOLOAD and
|
||||
may lead to unpredictable results.
|
||||
=head2 Debugging / Tracing
|
||||
|
||||
While SOAP::Lite features a global tracing facility, SOAP::WSDL
|
||||
allows to switch tracing on/of on a per-object base.
|
||||
|
||||
This has to be done in the SOAP client used by SOAP::WSDL - see
|
||||
L<get_client|get_client> for an example and L<SOAP::WSDL::Client> for
|
||||
details.
|
||||
|
||||
=head1 Bugs and Limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * readable
|
||||
=item * Apache SOAP datatypes are not supported
|
||||
|
||||
readable() must be called before calling wsdlinit. This is a bug.
|
||||
You currently can't use SOAP::WSDL with Apache SOAP datatypes like map.
|
||||
|
||||
=item * Unsupported XML Schema definitions
|
||||
If you want this changed, email me a copy of the specs, please.
|
||||
|
||||
The following XML Schema definitions are not supported:
|
||||
=item * Incomplete XML Schema definitions support
|
||||
|
||||
XML Schema attribute definitions are not supported yet.
|
||||
|
||||
Importing external definitions is not supported yet.
|
||||
|
||||
The following XML Schema definitions varieties are not supported:
|
||||
|
||||
choice
|
||||
group
|
||||
union
|
||||
simpleContent
|
||||
complexContent
|
||||
|
||||
=item * Serialization of hash refs dos not work for ambiguous values
|
||||
The following XML Schema definition content model is only partially
|
||||
supported:
|
||||
|
||||
complexContent - only restriction variety supported
|
||||
|
||||
See L<SOAP::WSDL::Manual::XSD> for details.
|
||||
|
||||
=item * Serialization of hash refs dos not work for ambiguos values
|
||||
|
||||
If you have list elements with multiple occurences allowed, SOAP::WSDL
|
||||
has no means of finding out which variant you meant.
|
||||
@@ -629,11 +639,11 @@ Passing in item => [1,2,3] could serialize to
|
||||
<item>1 2</item><item>3</item>
|
||||
<item>1</item><item>2 3</item>
|
||||
|
||||
Ambiguos data can be avoided by passing an object tree as data.
|
||||
Ambiguos data can be avoided by providing data as objects.
|
||||
|
||||
=item * XML Schema facets
|
||||
|
||||
Almost all XML schema facets are not yet implemented. The only facets
|
||||
Almost no XML schema facets are implemented yet. The only facets
|
||||
currently implemented are:
|
||||
|
||||
fixed
|
||||
@@ -652,6 +662,62 @@ The following facets have no influence yet:
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=head2 Related projects
|
||||
|
||||
=over
|
||||
|
||||
=item * L<SOAP::Lite|SOAP::Lite>
|
||||
|
||||
Full featured SOAP-library, little WSDL support. Supports rpc-encoded style only. Many protocols supported.
|
||||
|
||||
=item * <XML::Compile::WSDL|XML::Compile::WSDL>
|
||||
|
||||
A promising-looking approach derived from a cool functional DOM-based XML schema parser.
|
||||
|
||||
Will support encoding/decoding of SOAP messages based on WSDL definitions.
|
||||
|
||||
Not yet finished at the time of writing - but you may wish to give it a try, especially
|
||||
if you need to adhere very closely to the XML Schema / WSDL specs.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Sources of documentation
|
||||
|
||||
=over
|
||||
|
||||
=item * SOAP::WSDL homepage at sourceforge.net
|
||||
|
||||
L<http://soap-wsdl.sourceforge.net>
|
||||
|
||||
=item * SOAP::WSDL forum at CPAN::Forum
|
||||
|
||||
L<http://www.cpanforum.com/dist/SOAP-WSDL>
|
||||
|
||||
=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)
|
||||
|
||||
David Bussenschutt, Damian A. Martinez Gelabert, Dennis S. Hennen, Dan Horne,
|
||||
Peter Orvos, Mark Overmeer, Jon Robens, Isidro Vila Verde and Glenn Wood
|
||||
spotted bugs and/or suggested improvements in the 1.2x releases.
|
||||
|
||||
Andreas 'ac0v' Specht constantly asked for better performance.
|
||||
|
||||
JT Justman provided some early feedback for the 2.xx pre-releases.
|
||||
|
||||
Numerous people sent me their real-world WSDL files for testing. Thank you.
|
||||
|
||||
Paul Kulchenko and Byrne Reese wrote and maintained SOAP::Lite and
|
||||
thus provided a base (and counterpart) for SOAP::WSDL.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
@@ -663,5 +729,12 @@ the same terms as perl itself
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 308 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: WSDL.pm 308 2007-10-05 17:35:28Z kutterma $
|
||||
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL.pm $
|
||||
|
||||
=cut
|
||||
|
||||
+35
-74
@@ -1,12 +1,15 @@
|
||||
package SOAP::WSDL::Base;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Class::Std::Storable;
|
||||
use List::Util qw(first);
|
||||
use Carp qw(confess);
|
||||
|
||||
our $VERSION='2.00_17';
|
||||
|
||||
my %id_of :ATTR(:name<id> :default<()>);
|
||||
my %name_of :ATTR(:name<name> :default<()>);
|
||||
my %documentation_of :ATTR(:name<documentation> :default<()>);
|
||||
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
|
||||
my %xmlns_of :ATTR(:name<xmlns> :default<{}>);
|
||||
my %parent_of :ATTR(:name<parent> :default<()>);
|
||||
@@ -22,6 +25,16 @@ sub STORABLE_freeze_post :CUMULATIVE {};
|
||||
sub STORABLE_thaw_pre :CUMULATIVE {};
|
||||
sub STORABLE_thaw_post :CUMULATIVE { return $_[0] };
|
||||
|
||||
sub _accept {
|
||||
my $self = shift;
|
||||
my $class = ref $self;
|
||||
$class =~ s{ \A SOAP::WSDL:: }{}xms;
|
||||
$class =~ s{ (:? :: ) }{_}gxms;
|
||||
my $method = "visit_$class";
|
||||
no strict qw(refs);
|
||||
shift->$method( $self );
|
||||
}
|
||||
|
||||
# unfortunately, AUTOMETHOD is SLOW.
|
||||
# Re-implement in derived package wherever speed is an issue...
|
||||
#
|
||||
@@ -38,8 +51,6 @@ sub AUTOMETHOD {
|
||||
## And we would have to check getters, too.
|
||||
## Maybe do it the Conway way via the Symbol table...
|
||||
## ... can is way slow...
|
||||
# croak "no set accessor found for push_$subname"
|
||||
# if not ($self->can( $setter ));
|
||||
return sub {
|
||||
no strict qw(refs);
|
||||
my $old_value = $self->$getter();
|
||||
@@ -53,6 +64,7 @@ sub AUTOMETHOD {
|
||||
|
||||
# we're called as $obj->find_something($ns, $key)
|
||||
elsif ($subname =~s {^find_}{get_}xms) {
|
||||
@values = @{ $values[0] } if ref $values[0] eq 'ARRAY';
|
||||
return sub {
|
||||
return first {
|
||||
$_->get_targetNamespace() eq $values[0] &&
|
||||
@@ -69,7 +81,7 @@ sub AUTOMETHOD {
|
||||
return $result_ref->[0];
|
||||
};
|
||||
}
|
||||
croak "$subname not found in class " . (ref $self || $self);
|
||||
confess "$subname not found in class " . (ref $self || $self) ;
|
||||
}
|
||||
|
||||
sub init {
|
||||
@@ -77,12 +89,15 @@ sub init {
|
||||
my @args = @_;
|
||||
foreach my $value (@args)
|
||||
{
|
||||
die $value if (not defined ($value->{ Name }));
|
||||
die @args if (not defined ($value->{ Name }));
|
||||
if ($value->{ Name } =~m{^xmlns\:}xms) {
|
||||
die $xmlns_of{ ident $self }
|
||||
if ref $xmlns_of{ ident $self } ne 'HASH';
|
||||
|
||||
# add namespaces
|
||||
$xmlns_of{ ident $self }->{ $value->{ Value } } =
|
||||
$value->{ LocalName };
|
||||
|
||||
next;
|
||||
}
|
||||
elsif ($value->{ Name } =~m{^xmlns$}xms) {
|
||||
@@ -90,80 +105,26 @@ sub init {
|
||||
# TODO handle xmlns correctly - maybe via setting a prefix ?
|
||||
next;
|
||||
}
|
||||
my $name = $value->{ LocalName };
|
||||
my $method = "set_$name";
|
||||
$self->$method( $value->{ Value } ) if ( $method );
|
||||
|
||||
my $name = $value->{ LocalName };
|
||||
my $method = "set_$name";
|
||||
$self->$method( $value->{ Value } );
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub add_namespace {
|
||||
my ($self, $uri, $prefix ) = @_;
|
||||
return unless $uri;
|
||||
$self->{ namespace } ||= {};
|
||||
$self->{ namespace }->{ $uri } = $prefix;
|
||||
}
|
||||
sub expand {
|
||||
my ($self, , $qname) = @_;
|
||||
my ($prefix, $localname) = split /:/, $qname;
|
||||
my %ns_map = reverse %{ $self->get_xmlns() };
|
||||
return ($ns_map{ $prefix }, $localname) if ($ns_map{ $prefix });
|
||||
|
||||
sub to_typemap {
|
||||
warn "to_typemap";
|
||||
return q{};
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
my $self = shift;
|
||||
warn 'toClass is deprecated and will be removed before reaching 2.01 - '
|
||||
. 'use to_class instead (' . caller() . ')';
|
||||
$self->to_class(@_);
|
||||
}
|
||||
|
||||
sub to_class {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $template = shift;
|
||||
|
||||
$opt->{ base_path } ||= '.';
|
||||
|
||||
my $element_prefix = $opt->{ element_prefix } || $opt->{ prefix };
|
||||
my $type_prefix = $opt->{ type_prefix } || $opt->{ prefix };
|
||||
|
||||
if (($type_prefix) && ($type_prefix !~m{ :: $ }xms ) ) {
|
||||
warn 'type_prefix should end with "::"';
|
||||
$type_prefix .= '::';
|
||||
if (my $parent = $self->get_parent()) {
|
||||
return $parent->expand($qname);
|
||||
}
|
||||
|
||||
if (($element_prefix) && ($element_prefix !~m{ :: $ }xms) ) {
|
||||
warn 'element_prefix should end with "::"';
|
||||
$element_prefix .= '::';
|
||||
}
|
||||
|
||||
# Be careful: a Element may be ComplexType, too
|
||||
# (but not vice versa)
|
||||
my $prefix = $self->isa('SOAP::WSDL::XSD::Element')
|
||||
? $element_prefix
|
||||
: $type_prefix;
|
||||
|
||||
die 'No prefix specified' if not $prefix;
|
||||
|
||||
my $filename = $prefix . $self->get_name() . '.pm';
|
||||
$filename =~s{::}{/}xmsg;
|
||||
|
||||
my $output = $opt->{ output } || $filename;
|
||||
|
||||
require Template;
|
||||
my $tt = Template->new(
|
||||
RELATIVE => 1,
|
||||
OUTPUT_PATH => $opt->{ base_path },
|
||||
);
|
||||
|
||||
my $code = $tt->process( \$template, {
|
||||
element_prefix => $element_prefix,
|
||||
type_prefix => $type_prefix,
|
||||
self => $self,
|
||||
nsmap => { reverse %{ $opt->{ wsdl }->get_xmlns() } },
|
||||
structure => $self->explain( { wsdl => $opt->{ wsdl } } ),
|
||||
},
|
||||
$output
|
||||
)
|
||||
or die $tt->error();
|
||||
confess "unbound prefix $prefix found for $prefix:$localname";
|
||||
}
|
||||
sub _expand;
|
||||
*_expand = \&expand;
|
||||
|
||||
1;
|
||||
@@ -10,106 +10,4 @@ my %type_of :ATTR(:name<type> :default<()>);
|
||||
my %transport_of :ATTR(:name<transport> :default<()>);
|
||||
my %style_of :ATTR(:name<style> :default<()>);
|
||||
|
||||
|
||||
sub explain {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $name = $self->get_name();
|
||||
|
||||
die 'required atribute wsdl missing' if not $opt->{ wsdl };
|
||||
|
||||
my $portType = $opt->{ wsdl }->find_portType(
|
||||
$opt->{ wsdl }->_expand( $self->get_type() )
|
||||
) or die 'portType not found: ' . $self->get_type();
|
||||
|
||||
my $txt = <<"EOT";
|
||||
|
||||
=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.
|
||||
|
||||
EOT
|
||||
|
||||
foreach my $operation (@{ $self->get_operation() }) {
|
||||
|
||||
my $operation_name = $operation->get_name();
|
||||
my $operation_style = $operation->get_style() || q{};
|
||||
|
||||
my $port_operation = first { $_->get_name eq $operation_name }
|
||||
@{ $portType->get_operation() }
|
||||
or die "operation not found:" . $operation->get_name();
|
||||
|
||||
# TODO rename lexical $input to "message"
|
||||
my $input_message = do {
|
||||
my $input = $port_operation->first_input();
|
||||
$input ? $input->explain($opt) : q{};
|
||||
};
|
||||
my $output_message = do {
|
||||
my $input = $port_operation->first_output();
|
||||
$input ? $input->explain($opt) : q{};
|
||||
};
|
||||
my $fault_message = do {
|
||||
my $input = $port_operation->first_fault();
|
||||
$input ? $input->explain($opt) : q{};
|
||||
};
|
||||
|
||||
$txt .= <<"EOT";
|
||||
|
||||
=head3 $operation_name
|
||||
|
||||
B<Input Message:>
|
||||
|
||||
$input_message
|
||||
|
||||
B<Output Message:>
|
||||
|
||||
$output_message
|
||||
|
||||
B<Fault:>
|
||||
|
||||
$fault_message
|
||||
|
||||
EOT
|
||||
}
|
||||
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
my ($self, $opt) = @_;
|
||||
my $name = $self->get_name();
|
||||
|
||||
my $portType = $opt->{ wsdl }->find_portType(
|
||||
$opt->{ wsdl }->_expand( $self->get_type )
|
||||
) or die 'portType not found: ' . $self->get_type;
|
||||
|
||||
my $txt = q{};
|
||||
foreach my $operation (@{ $self->get_operation() })
|
||||
{
|
||||
my $operation_name = $operation->get_name();
|
||||
my $operation_style = $operation->get_style() || q{};
|
||||
|
||||
my ($port_operation) = grep { $_->get_name eq $operation_name }
|
||||
@{ $portType->get_operation() }
|
||||
or die "operation not found:" . $operation->get_name();
|
||||
|
||||
no strict qw(refs);
|
||||
$txt .= join q{},
|
||||
map {
|
||||
my $message = $port_operation->$_;
|
||||
$message
|
||||
? $message->to_typemap($opt)
|
||||
: q{}
|
||||
} qw(first_input first_output first_fault);
|
||||
}
|
||||
return $txt;
|
||||
}
|
||||
|
||||
1;
|
||||
+260
-91
@@ -2,26 +2,81 @@ package SOAP::WSDL::Client;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Scalar::Util qw(blessed);
|
||||
use SOAP::WSDL::Envelope;
|
||||
use SOAP::Lite;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::Expat::MessageParser;
|
||||
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
|
||||
# Package globals for speed...
|
||||
my $PARSER;
|
||||
my $MESSAGE_HANDLER;
|
||||
use Class::Std::Storable;
|
||||
use Scalar::Util qw(blessed);
|
||||
|
||||
use SOAP::WSDL::Factory::Deserializer;
|
||||
use SOAP::WSDL::Factory::Serializer;
|
||||
use SOAP::WSDL::Factory::Transport;
|
||||
use SOAP::WSDL::Expat::MessageParser;
|
||||
|
||||
our $VERSION = '2.00_17';
|
||||
|
||||
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
|
||||
my %no_dispatch_of :ATTR(:name<no_dispatch> :default<()>);
|
||||
my %outputxml_of :ATTR(:name<outputxml> :default<()>);
|
||||
my %proxy_of :ATTR(:name<proxy> :default<()>);
|
||||
my %transport_of :ATTR(:name<transport> :default<()>);
|
||||
my %endpoint_of :ATTR(:name<endpoint> :default<()>);
|
||||
|
||||
# TODO remove when preparing 2.01
|
||||
sub outputtree { warn 'outputtree is deprecated and'
|
||||
. 'will be removed before reaching v2.01 !' }
|
||||
my %soap_version_of :ATTR(:get<soap_version> :init_attr<soap_version> :default<'1.1'>);
|
||||
|
||||
my %on_action_of :ATTR(:name<on_action> :default<()>);
|
||||
my %content_type_of :ATTR(:name<content_type> :default<text/xml; charset=utf8>); #/#trick editors
|
||||
my %serializer_of :ATTR(:name<serializer> :default<()>);
|
||||
my %deserializer_of :ATTR(:name<deserializer> :default<()>);
|
||||
|
||||
sub BUILD {
|
||||
my ($self, $ident, $attrs_of_ref) = @_;
|
||||
|
||||
if (exists $attrs_of_ref->{ proxy }) {
|
||||
$self->set_proxy( $attrs_of_ref->{ proxy } );
|
||||
delete $attrs_of_ref->{ proxy };
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub get_proxy {
|
||||
return $_[0]->get_transport();
|
||||
}
|
||||
|
||||
sub set_proxy {
|
||||
my ($self, @args_from) = @_;
|
||||
my $ident = ident $self;
|
||||
|
||||
# remember old value to return it later - Class::Std does so, too
|
||||
my $old_value = $transport_of{ $ident };
|
||||
|
||||
# accept both list and list ref args
|
||||
@args_from = @{ $args_from[0] } if ref $args_from[0];
|
||||
|
||||
# remember endpoint
|
||||
$endpoint_of{ $ident } = $args_from[0];
|
||||
|
||||
# set transport - SOAP::Lite works similar...
|
||||
$transport_of{ $ident } = SOAP::WSDL::Factory::Transport
|
||||
->get_transport( @args_from );
|
||||
|
||||
return $old_value;
|
||||
}
|
||||
|
||||
sub set_soap_version {
|
||||
my $ident = ident shift;
|
||||
|
||||
# remember old value to return it later - Class::Std does so, too
|
||||
my $soap_version = $soap_version_of{ $ident };
|
||||
|
||||
# re-setting the soap version invalidates the
|
||||
# serializer object
|
||||
delete $serializer_of{ $ident };
|
||||
delete $deserializer_of{ $ident };
|
||||
|
||||
$soap_version_of{ $ident } = shift;
|
||||
|
||||
return $soap_version;
|
||||
}
|
||||
|
||||
# Mimic SOAP::Lite's behaviour for getter/setter routines
|
||||
SUBFACTORY: {
|
||||
no strict qw(refs);
|
||||
for (qw(class_resolver no_dispatch outputxml proxy)) {
|
||||
@@ -37,103 +92,187 @@ SUBFACTORY: {
|
||||
}
|
||||
}
|
||||
|
||||
BEGIN {
|
||||
$PARSER = SOAP::WSDL::Expat::MessageParser->new();
|
||||
}
|
||||
|
||||
sub call {
|
||||
my $self = shift;
|
||||
my $method = shift;
|
||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
||||
my $content = q{};
|
||||
my ($envelope, $soap_action);
|
||||
my ($self, $method, @data_from) = @_;
|
||||
my $ident = ident $self;
|
||||
|
||||
if (blessed $data
|
||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
||||
{
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
||||
# TODO replace by something derived from binding - this is just a
|
||||
# workaround...
|
||||
$soap_action = join '/', $data->get_xmlns(), $method;
|
||||
}
|
||||
else {
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
||||
# $soap_action = $self->on_action( $method );
|
||||
}
|
||||
# the only valid idiom for calling a method with both a header and a body
|
||||
# is
|
||||
# ->call($method, $body_ref, $header_ref);
|
||||
#
|
||||
# These other idioms all assume an empty header:
|
||||
# ->call($method, %body_of); # %body_of is a hash
|
||||
# ->call($method, $body); # $body is a scalar
|
||||
my ($data, $header) = ref $data_from[0]
|
||||
? ($data_from[0], $data_from[1] )
|
||||
: (@data_from>1)
|
||||
? ( { @data_from }, undef )
|
||||
: ( $data_from[0], undef );
|
||||
|
||||
# get operation name and soap_action
|
||||
my ($operation, $soap_action) = (ref $method eq 'HASH')
|
||||
? ( $method->{ operation }, $method->{ soap_action } )
|
||||
: (blessed $data
|
||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
||||
? ( $method , (join '/', $data->get_xmlns(), $method) )
|
||||
: ( $method, q{} );
|
||||
|
||||
$serializer_of{ $ident } ||= SOAP::WSDL::Factory::Serializer->get_serializer({
|
||||
soap_version => $self->get_soap_version(),
|
||||
});
|
||||
|
||||
my $envelope = $serializer_of{ $ident }->serialize({
|
||||
method => $operation,
|
||||
body => $data,
|
||||
header => $header,
|
||||
});
|
||||
|
||||
return $envelope if $self->no_dispatch();
|
||||
|
||||
# warn $envelope;
|
||||
# always quote SOAPAction header.
|
||||
# WS-I BP 1.0 R1109
|
||||
if ($soap_action) {
|
||||
$soap_action =~s{\A(:?"|')?}{"}xms;
|
||||
$soap_action =~s{(:?"|')?\Z}{"}xms;
|
||||
}
|
||||
else {
|
||||
$soap_action = q{""};
|
||||
}
|
||||
|
||||
# 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 $soap = SOAP::Lite->new()->proxy( $self->get_proxy() );
|
||||
my $response = $soap->transport->send_receive(
|
||||
context => $self, # this is provided for context
|
||||
endpoint => $soap->endpoint(),
|
||||
action => $soap_action, # SOAPAction, should be from binding
|
||||
envelope => $envelope, # use custom content
|
||||
);
|
||||
# get response via transport layer.
|
||||
# Normally, SOAP::Lite's transport layer is used, though users
|
||||
# may provide their own.
|
||||
my $transport = $self->get_transport();
|
||||
my $response = $transport->send_receive(
|
||||
endpoint => $self->get_endpoint(),
|
||||
content_type => $content_type_of{ $ident },
|
||||
envelope => $envelope,
|
||||
action => $soap_action,
|
||||
# on_receive_chunk => sub {} # optional, may be used for parsing large responses as they arrive.
|
||||
);
|
||||
|
||||
# warn 'Received ' . length($response) . ' bytes of content';
|
||||
return $response if ($self->outputxml() );
|
||||
return $response if ($outputxml_of{ $ident } );
|
||||
|
||||
$PARSER->class_resolver( $self->get_class_resolver() );
|
||||
# get deserializer
|
||||
$deserializer_of{ $ident } ||= SOAP::WSDL::Factory::Deserializer->get_deserializer({
|
||||
soap_version => $soap_version_of{ $ident },
|
||||
});
|
||||
|
||||
# set class resolver if serializer supports it
|
||||
$deserializer_of{ $ident }->set_class_resolver( $class_resolver_of{ $ident } )
|
||||
if ( $deserializer_of{ $ident }->can('set_class_resolver') );
|
||||
|
||||
# Try deserializing response - there may be some,
|
||||
# even if transport did not succeed (got a 500 response)
|
||||
if ( $response ) {
|
||||
my ($result_body, $result_header) = eval {
|
||||
$deserializer_of{ $ident }->deserialize( $response );
|
||||
};
|
||||
if (not $@) {
|
||||
return wantarray
|
||||
? ($result_body, $result_header)
|
||||
: $result_body;
|
||||
}
|
||||
return $deserializer_of{ $ident }->generate_fault({
|
||||
code => 'soap:Server',
|
||||
role => 'urn:localhost',
|
||||
message => "Error deserializing message: $@. \n"
|
||||
. "Message was: \n$response"
|
||||
});
|
||||
};
|
||||
|
||||
# if we had no success (Transport layer error status code)
|
||||
# or if transport layer failed
|
||||
if (! $soap->transport->is_success() ) {
|
||||
# Try deserializing response - there may be some
|
||||
if ($response) {
|
||||
eval { $PARSER->parse( $response ); };
|
||||
if ($@) {
|
||||
warn "could not deserialize response: $@";
|
||||
}
|
||||
else {
|
||||
return $PARSER->get_data();
|
||||
}
|
||||
};
|
||||
if ( ! $transport->is_success() ) {
|
||||
|
||||
|
||||
require SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
# 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: '
|
||||
. $soap->transport->message()
|
||||
return $deserializer_of{ $ident }->generate_fault({
|
||||
code => 'soap:Server',
|
||||
role => 'urn:localhost',
|
||||
message => 'Error sending / receiving message: '
|
||||
. $transport->message()
|
||||
});
|
||||
}
|
||||
eval { $PARSER->parse( $response ) };
|
||||
|
||||
# return fault if we cannot deserialize response
|
||||
if ($@) {
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => "Error deserializing message: $@. \n"
|
||||
. "Message was: \n$response"
|
||||
});
|
||||
}
|
||||
|
||||
return $PARSER->get_data();
|
||||
} ## end sub call
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Client - SOAP::WSDL's SOAP Client
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 call
|
||||
|
||||
$soap->call( \%method, \@parts );
|
||||
|
||||
%method is a hash with the following keys:
|
||||
|
||||
Name Description
|
||||
----------------------------------------------------
|
||||
operation operation name
|
||||
soap_action SOAPAction HTTP header to use
|
||||
style Operation style. One of (document|rpc)
|
||||
use SOAP body encoding. One of (literal|encoded)
|
||||
|
||||
The style and use keys have no influence yet.
|
||||
|
||||
@parts is a list containing the elements of the message parts.
|
||||
|
||||
For backward compatibility, call may also be called as below:
|
||||
|
||||
$soap->call( $method, \@parts );
|
||||
|
||||
In this case, $method is the SOAP operation name, and the SOAPAction header
|
||||
is guessed from the first part's namespace and the operation name (which is
|
||||
mostly correct, but may fail). Operation style and body encoding are assumed to
|
||||
be document/literal
|
||||
|
||||
|
||||
=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
|
||||
|
||||
SOAP::WSDL does not aim to be a complete replacement for SOAP::Lite - the
|
||||
@@ -145,7 +284,7 @@ Nonetheless SOAP::WSDL mimics part of SOAP::Lite's API and behaviour,
|
||||
so SOAP::Lite users can switch without looking up every method call in the
|
||||
documentation.
|
||||
|
||||
A few things are quite differentl from SOAP::Lite, though:
|
||||
A few things are quite different from SOAP::Lite, though:
|
||||
|
||||
=head3 SOAP request data
|
||||
|
||||
@@ -197,9 +336,39 @@ SOAP::WSDL::Client and implementing something like
|
||||
$soap_wsdl_client->call( mySoapMethod, @_);
|
||||
}
|
||||
|
||||
You may even do this in a class factory - SOAP::WSDL provides the methods
|
||||
for generating such interfaces.
|
||||
You may even do this in a class factory - see L<wsdl2perl.pl> for creating
|
||||
such interfaces.
|
||||
|
||||
=head1 Troubleshooting
|
||||
|
||||
=head2 Accessing protected web services
|
||||
|
||||
Accessing protected web services is very specific for the transport
|
||||
backend used.
|
||||
|
||||
In general, you may pass additional arguments to the set_proxy method (or
|
||||
a list ref of the web service address and any additional arguments to the
|
||||
new method's I<proxy> argument).
|
||||
|
||||
Refer to the appropriate transport module for documentation.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 303 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Client.pm 303 2007-10-01 18:51:50Z kutterma $
|
||||
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
@@ -2,42 +2,79 @@ package SOAP::WSDL::Client::Base;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base 'SOAP::WSDL::Client';
|
||||
use Scalar::Util qw(blessed);
|
||||
|
||||
sub __create_new {
|
||||
my ($package, %args_of) = @_;
|
||||
our $VERSION = '2.00_17';
|
||||
|
||||
no strict qw(refs);
|
||||
|
||||
*{ "$package\::new" } = sub {
|
||||
my $class = shift;
|
||||
my $self = $class->SUPER::new({
|
||||
proxy => $args_of{ proxy },
|
||||
class_resolver => $args_of{ class_resolver }
|
||||
});
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
sub call {
|
||||
my ($self, $method, $body, $header) = @_;
|
||||
if (not blessed $body) {
|
||||
my $class = $method->{ body }->{ parts }->[0];
|
||||
eval "require $class" || die $@;
|
||||
$body = $class->new($body);
|
||||
}
|
||||
|
||||
# if we have a header
|
||||
if (%{ $method->{ header } }) {
|
||||
if (not blessed $header) {
|
||||
my $class = $method->{ header }->{ parts }->[0];
|
||||
eval "require $class" || die $@;
|
||||
$header = $class->new($header);
|
||||
}
|
||||
}
|
||||
return $self->SUPER::call($method, $body, $header);
|
||||
}
|
||||
|
||||
#sub __create_new {
|
||||
# my ($package, %args_of) = @_;
|
||||
#
|
||||
# no strict qw(refs);
|
||||
# no warnings qw(redefine);
|
||||
#
|
||||
# # TODO factor out and replace by generated START method
|
||||
# *{ "$package\::new" } = sub {
|
||||
# my $class = shift;
|
||||
# my $self = $class->SUPER::new({
|
||||
# proxy => $args_of{ proxy },
|
||||
# class_resolver => $args_of{ class_resolver }
|
||||
# });
|
||||
# bless $self, $class;
|
||||
# return $self;
|
||||
# }
|
||||
#}
|
||||
|
||||
sub __create_methods {
|
||||
my ($package, %parts_of) = @_;
|
||||
my ($package, %info_of) = @_;
|
||||
|
||||
no strict qw(refs);
|
||||
no warnings qw(redefine);
|
||||
for my $method (keys %info_of){
|
||||
my ($soap_action, @parts);
|
||||
|
||||
# up to 2.00_10 we had list refs...
|
||||
if (ref $info_of{ $method }eq 'HASH') {
|
||||
@parts = @{ $info_of{ $method }->{ parts } };
|
||||
$soap_action = $info_of{ $method }->{ soap_action };
|
||||
}
|
||||
else {
|
||||
@parts = @{ $info_of{ $method } };
|
||||
$soap_action = ();
|
||||
}
|
||||
|
||||
for my $method (keys %parts_of){
|
||||
*{ "$package\::$method" } = sub {
|
||||
my $self = shift;
|
||||
my @param = map {
|
||||
my $data = shift || {};
|
||||
eval "require $_";
|
||||
$_->new( $data );
|
||||
} @{ $parts_of{ $method } };
|
||||
} @parts;
|
||||
|
||||
$self->call( $method, @param );
|
||||
return $self->SUPER::call( {
|
||||
operation => $method,
|
||||
soap_action => $soap_action,
|
||||
}, @param );
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -48,13 +85,40 @@ __END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Client::Base - Base client for WSDL-based SOAP access
|
||||
SOAP::WSDL::Client::Base - Factory class for WSDL-based SOAP access
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package MySoapClient;
|
||||
package MySoapInterface;
|
||||
use SOAP::WSDL::Client::Base;
|
||||
__PACKAGE__->__create_new(
|
||||
proxy => 'http://somewhere.over.the.rainbow',
|
||||
class_resolver => 'Typemap::MySoapInterface'
|
||||
);
|
||||
__PACKAGE__->__create_methods( qw(one two three) );
|
||||
1;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Factory class for creating interface classes. Should probably be renamed to
|
||||
SOAP::WSDL::Factory::Interface...
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 303 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Base.pm 303 2007-10-01 18:51:50Z kutterma $
|
||||
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client/Base.pm $
|
||||
|
||||
=cut
|
||||
+14
-347
@@ -1,4 +1,5 @@
|
||||
package SOAP::WSDL::Definitions;
|
||||
use utf8;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
@@ -8,6 +9,8 @@ use List::Util qw(first);
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
our $VERSION='2.00_17';
|
||||
|
||||
my %types_of :ATTR(:name<types> :default<[]>);
|
||||
my %message_of :ATTR(:name<message> :default<()>);
|
||||
my %portType_of :ATTR(:name<portType> :default<()>);
|
||||
@@ -31,224 +34,24 @@ BLOCK: {
|
||||
foreach my $method(keys %attributes_of ) {
|
||||
|
||||
*{ "find_$method" } = sub {
|
||||
my ($self, @args) = @_;
|
||||
my ($self, @args_from) = @_;
|
||||
@args_from = @{ $args_from[0] } if ref $args_from[0] eq 'ARRAY';
|
||||
return first {
|
||||
$_->get_targetNamespace() eq $args[0]
|
||||
&& $_->get_name() eq $args[1]
|
||||
$_->get_targetNamespace() eq $args_from[0]
|
||||
&& $_->get_name() eq $args_from[1]
|
||||
}
|
||||
@{ $attributes_of{ $method }->{ ident $self } };
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
sub explain {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
$opt->{ wsdl } ||= $self;
|
||||
$opt->{ namespace } ||= $self->get_xmlns() || {};
|
||||
my $txt = '';
|
||||
|
||||
for my $service (@{ $self->get_service() }) {
|
||||
$txt .= $service->explain( $opt );
|
||||
$txt .= "\n";
|
||||
}
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub _expand {
|
||||
my ($self, $prefix, $localname) = ($_[0], split /:/, $_[1]);
|
||||
my %ns_map = reverse %{ $self->get_xmlns() };
|
||||
return ($ns_map{ $prefix }, $localname);
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
$opt->{ prefix } ||= q{};
|
||||
$opt->{ wsdl } ||= $self;
|
||||
$opt->{ type_prefix } ||= $opt->{ prefix };
|
||||
$opt->{ element_prefix } ||= $opt->{ prefix };
|
||||
return join "\n",
|
||||
map { $_->to_typemap( $opt ) } @{ $service_of{ ident $self } };
|
||||
}
|
||||
|
||||
sub create {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
|
||||
my $base_path = $opt->{ base_path }
|
||||
or croak "missing or empty argument base_path";
|
||||
$opt->{ prefix } ||= q{};
|
||||
$opt->{ type_prefix } ||= $opt->{ prefix };
|
||||
$opt->{ element_prefix } ||= $opt->{ prefix };
|
||||
$opt->{ typemap_prefix } or die 'Required argument typemap_prefix missing';
|
||||
|
||||
mkpath $base_path;
|
||||
|
||||
for my $service (@{ $service_of{ ident $self } }) {
|
||||
warn "creating typemap $opt->{ typemap_prefix }". $service->get_name() . "\n";
|
||||
$self->_create_typemap({ %{ $opt }, service => $service });
|
||||
$self->_create_interface({ %{ $opt }, service => $service });
|
||||
}
|
||||
|
||||
my @schema = @{ $self->first_types()->get_schema() };
|
||||
for my $type (map { @{ $_->get_type() } , @{ $_->get_element() } } @schema[1..$#schema] ) {
|
||||
warn 'creating class for '. $type->get_name() . "\n";
|
||||
$type->to_class( { %$opt, wsdl => $self } );
|
||||
}
|
||||
}
|
||||
|
||||
sub _create_interface {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $service_name = $opt->{ service }->get_name();
|
||||
my $file_name = "$opt->{ base_path }/$opt->{ interface_prefix }/$service_name.pm";
|
||||
$file_name =~s{::}{/}gms;
|
||||
my $path = dirname $file_name;
|
||||
my $name = basename $file_name;
|
||||
my $binding = $self->find_binding( $self->_expand( $opt->{ service }->first_port()->get_binding() ) );
|
||||
my $portType = $self->find_portType( $self->_expand( $binding->get_type() ) );
|
||||
my $portType_operation_from_ref = $portType->get_operation();
|
||||
my $operation_ref = $binding->get_operation();
|
||||
$operation_ref = [ $operation_ref ] if ref $operation_ref ne 'ARRAY';
|
||||
my %operations = map {
|
||||
do {
|
||||
my $operation_name = $_->get_name();
|
||||
my $port_op = first { $_->get_name eq $operation_name } @{ $portType_operation_from_ref };
|
||||
my $input = $port_op->first_input()->get_message();
|
||||
my $message = $self->find_message( $self->_expand( $input ) );
|
||||
my $parts = $message->get_part;
|
||||
( $operation_name => [
|
||||
map {
|
||||
do {
|
||||
my $name;
|
||||
($name = $_->get_element())
|
||||
? do {
|
||||
my ($prefix, $localname) = split m{:}xms , $name;
|
||||
"$opt->{ element_prefix }$localname";
|
||||
}
|
||||
: ($name = $_->get_type())
|
||||
? do {
|
||||
my ($prefix, $localname) = split m{:}xms , $name;
|
||||
"$opt->{ type_prefix }$localname";
|
||||
}
|
||||
: ()
|
||||
}
|
||||
} @{ $parts }
|
||||
] );
|
||||
};
|
||||
} @{ $operation_ref };
|
||||
|
||||
# use Data::Dumper;
|
||||
# die Dumper \%operations;
|
||||
|
||||
my $template = <<'EOT';
|
||||
package [% interface_prefix %][% service.get_name %];
|
||||
use strict;
|
||||
use warnings;
|
||||
use [% typemap_prefix %][% service.get_name %];
|
||||
use base 'SOAP::WSDL::Client::Base';
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $arg_ref = shift || {};
|
||||
my $self = $class->SUPER::new({
|
||||
class_resolver => '[% typemap_prefix %][% service.get_name %]',
|
||||
proxy => '[% service.first_port.get_location %]',
|
||||
%{ $arg_ref }
|
||||
});
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
__PACKAGE__->__create_methods(
|
||||
[% FOREACH name = operations.keys -%]
|
||||
[% name %] => [ [% FOREACH class = operations.$name %]'[% class %]', [% END %]],
|
||||
[% END %]
|
||||
);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
[% interface_prefix %][% service.get_name %] - SOAP interface to [% service.get_name %] at
|
||||
[% service.first_port.get_location %]
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $interface = [% interface_prefix %][% service.get_name %]->new();
|
||||
my $[% operations.keys.1 %] = $interface->[% operations.keys.1 %]();
|
||||
|
||||
|
||||
[% service.explain({ wsdl => wsdl }) %]
|
||||
|
||||
=cut
|
||||
|
||||
EOT
|
||||
|
||||
require Template;
|
||||
my $tt = Template->new(
|
||||
OUTPUT_PATH => $path,
|
||||
);
|
||||
$tt->process(\$template, { %{ $opt }, operations => \%operations, binding => $binding, wsdl => $self }, $name)
|
||||
or die $tt->error();
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub _create_typemap {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $service_name = $opt->{ service }->get_name();
|
||||
my $file_name = "$opt->{ base_path }/$opt->{ typemap_prefix }/$service_name.pm";
|
||||
$file_name =~s{::}{/}gms;
|
||||
my $path = dirname $file_name;
|
||||
my $name = basename $file_name;
|
||||
|
||||
my $typemap = $opt->{ service }->to_typemap( { %{ $opt }, wsdl => $self } );
|
||||
|
||||
my $template = <<'EOT';
|
||||
package [% typemap_prefix %][% service.get_name %];
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my %typemap = (
|
||||
[% typemap %]
|
||||
[% custom_types %]
|
||||
);
|
||||
|
||||
sub get_class {
|
||||
my $name = join '/', @{ $_[1] };
|
||||
exists $typemap{ $name } or die "Cannot resolve $name via " . __PACKAGE__;
|
||||
return $typemap{ $name };
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
EOT
|
||||
|
||||
require Template;
|
||||
my $tt = Template->new(
|
||||
OUTPUT_PATH => $path,
|
||||
);
|
||||
$tt->process(\$template, { %{ $opt }, typemap => $typemap }, $name)
|
||||
or die $tt->error();
|
||||
|
||||
}
|
||||
|
||||
sub listify {
|
||||
my $data = shift;
|
||||
return if not defined $data;
|
||||
return [ $data ] if not ref $data;
|
||||
return [ $data ] if not ref $data eq 'ARRAY';
|
||||
return $data;
|
||||
}
|
||||
#sub listify {
|
||||
# my $data = shift;
|
||||
# return if not defined $data;
|
||||
# return [ $data ] if not ref $data;
|
||||
# return [ $data ] if not ref $data eq 'ARRAY';
|
||||
# return $data;
|
||||
#}
|
||||
|
||||
1;
|
||||
|
||||
@@ -311,142 +114,6 @@ Returns the message matching the namespace/localname pair passed as arguments.
|
||||
Accessors/Mutators for accessing / setting the E<gt>typesE<lt> child
|
||||
element(s).
|
||||
|
||||
=head2 explain
|
||||
|
||||
Returns a POD string describing how to call the methods of the service(s)
|
||||
described in the WSDL.
|
||||
|
||||
=head2 to_typemap
|
||||
|
||||
Creates a typemap for use with a generated type class library.
|
||||
|
||||
Options:
|
||||
|
||||
NAME DESCRIPTION
|
||||
-------------------------------------------------------------------------
|
||||
prefix Prefix to use for all classes
|
||||
type_prefix Prefix to use for all (Complex/Simple)Type classes
|
||||
element_prefix Prefix to use for all Element classes (with atomic types)
|
||||
|
||||
As some webservices tend to use globally unique type definitions, but
|
||||
locally unique elements with atomic types, type and element classes may
|
||||
be separated by specifying type_prefix and element_prefix instead of
|
||||
prefix.
|
||||
|
||||
The typemap is plain text which can be used as snipped for building a
|
||||
SOAP::WSDL class_resolver perl class.
|
||||
|
||||
Try something like this for creating typemap classes:
|
||||
|
||||
my $parser = XML::LibXML->new();
|
||||
my $handler = SOAP::WSDL::SAX::WSDLHandler->new()
|
||||
$parser->set_handler( $handler );
|
||||
|
||||
$parser->parse_url('file:///path/to/wsdl');
|
||||
|
||||
my $wsdl = $handler->get_data();
|
||||
my $typemap = $wsdl->to_typemap();
|
||||
|
||||
print <<"EOT"
|
||||
package MyTypemap;
|
||||
my \%typemap = (
|
||||
$typemap
|
||||
);
|
||||
sub get_class { return \$typemap{\$_[1] } };
|
||||
1;
|
||||
"EOT"
|
||||
|
||||
=head2 create_interface
|
||||
|
||||
Creates a typemap class, classes for all types and elements, and interface
|
||||
classes for every service.
|
||||
|
||||
See L<CODE GENERATOR|CODE GENERATOR> below.
|
||||
|
||||
Options:
|
||||
|
||||
Name Description
|
||||
----------------------------------------------------------------------------
|
||||
prefix Prefix to use for types and elements. Should end with '::'.
|
||||
element_prefix Prefix to use for element packages. Should end with '::'.
|
||||
Must be specified if prefix is not given.
|
||||
type_prefix Prefix to use for type packages. Should end with '::'.
|
||||
Must be specified if prefix is not given.
|
||||
typemap_prefix Prefix to use for type packages. Should end with '::'.
|
||||
Mandatory.
|
||||
custom_types A perl source code snippet defining custom types for the
|
||||
class resolver (typemap).
|
||||
Must look like this:
|
||||
q{
|
||||
'path/to/my/element' => 'My::Element',
|
||||
'path/to/my/element/prop' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'path/to/my/element/prop2' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
};
|
||||
|
||||
=head2 _expand
|
||||
|
||||
Expands a qualified name into a list consisting of namespace URI and
|
||||
localname by using the definition's xmlns table.
|
||||
|
||||
Used internally by SOAP::WSDL::* classes.
|
||||
|
||||
=head1 CODE GENERATOR
|
||||
|
||||
TODO: move somewhere else - maybe SOAP::WSDL::Client ?
|
||||
|
||||
SOAP::WSDL::Definitions features a code generation facility for generating
|
||||
perl classes (packages) from a WSDL definition.
|
||||
|
||||
The following classes are generated:
|
||||
|
||||
=over
|
||||
|
||||
=item * Typemaps
|
||||
|
||||
A typemap class is created for every service.
|
||||
|
||||
Typemaps are basically lookup classes. They allow the
|
||||
SOAP::WSDL::SAX::MessageHandler to find out which class a XML element
|
||||
in a SOAP message shoud be processed as.
|
||||
|
||||
Typemaps are passed to SOAP::WSDL::Client via the class_resolver
|
||||
method.
|
||||
|
||||
=item * Interfaces
|
||||
|
||||
TODO: Implement Interface generation
|
||||
|
||||
Interface classes are just convenience shortcuts for accessing web
|
||||
service methods. They define a method for every web service method,
|
||||
dispatching the request to SOAP::WSDL::Client.
|
||||
|
||||
=item * Type and Element classes
|
||||
|
||||
For every top-level E<lt>elementE<gt>, E<lt>complexTypeE<gt> and
|
||||
E<lt>simpleTypeE<gt> definition in the WSDL's schema, a perl class is
|
||||
created.
|
||||
|
||||
Classes for E<lt>complexTypeE<gt> and E<lt>simpleTypeE<gt> definitions
|
||||
are prefixed by the C<type_prefix> argument passed to
|
||||
L<create_interface|create_interface>, classes for E<lt>elementE<gt>
|
||||
definitions are prefixed by the C<element_prefix> passed to
|
||||
L<create_interface|create_interface>. If the specific prefixes are not
|
||||
specified, the C<prefix> argument is used instead.
|
||||
|
||||
If your web service is part of a bigger framework which defines types
|
||||
globally, you probably do well always using the same C<type_prefix>:
|
||||
This reduces the number of classes generated (provided types
|
||||
are re-used by more than one service).
|
||||
|
||||
You probably should use different element prefixes, though -
|
||||
E<lt>elementE<gt> definitions tend to be unique in the defining WSDL
|
||||
only, especially when using document/literal style/encoding.
|
||||
|
||||
If not, you probably want to specify just C<prefix> (and use a
|
||||
different one for every web service).
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
@@ -0,0 +1,160 @@
|
||||
package SOAP::WSDL::Deserializer::Hash;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
use SOAP::WSDL::Expat::Message2Hash;
|
||||
|
||||
use SOAP::WSDL::Factory::Deserializer;
|
||||
SOAP::WSDL::Factory::Deserializer->register( '1.1', __PACKAGE__ );
|
||||
|
||||
our $VERSION='2.00_17';
|
||||
|
||||
sub BUILD {
|
||||
my ($self, $ident, $args_of_ref) = @_;
|
||||
|
||||
# ignore all options
|
||||
for (keys %{ $args_of_ref }) {
|
||||
delete $args_of_ref->{ $_ }
|
||||
}
|
||||
}
|
||||
|
||||
sub deserialize {
|
||||
my ($self, $content) = @_;
|
||||
|
||||
my $parser = SOAP::WSDL::Expat::Message2Hash->new();
|
||||
eval { $parser->parse_string( $content ) };
|
||||
if ($@) {
|
||||
die $self->generate_fault({
|
||||
code => 'soap:Server',
|
||||
role => 'urn:localhost',
|
||||
message => "Error deserializing message: $@. \n"
|
||||
. "Message was: \n$content"
|
||||
});
|
||||
}
|
||||
return $parser->get_data();
|
||||
}
|
||||
|
||||
sub generate_fault {
|
||||
my ($self, $args_from_ref) = @_;
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
faultcode => $args_from_ref->{ code } || 'soap:Client',
|
||||
faultactor => $args_from_ref->{ role } || 'urn:localhost',
|
||||
faultstring => $args_from_ref->{ message } || "Unknown error"
|
||||
});
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Deserializer::Hash - Deserializer SOAP messages into perl hash refs
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use SOAP::WSDL;
|
||||
use SOAP::WSDL::Deserializer::Hash;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Deserializer for creating perl hash refs as result of a SOAP call.
|
||||
|
||||
=head2 Output structure
|
||||
|
||||
The XML structure is converted into a perl data structure consisting of
|
||||
hash and or list references. List references are used for holding array data.
|
||||
|
||||
SOAP::WSDL::Deserializer::Hash creates list references always at the maximum
|
||||
depth possible.
|
||||
|
||||
Examples:
|
||||
|
||||
XML:
|
||||
<MyDataArray>
|
||||
<MyData>1</MyData>
|
||||
<MyData>1</MyData>
|
||||
</MyDataArray>
|
||||
|
||||
Perl:
|
||||
{
|
||||
MyDataArray => {
|
||||
MyData => [ 1, 1 ]
|
||||
}
|
||||
}
|
||||
|
||||
XML:
|
||||
<DeepArray>
|
||||
<MyData><int>1<int>/MyData>
|
||||
<MyData><int>1<int>/MyData>
|
||||
</DeepArray>
|
||||
|
||||
Perl:
|
||||
{
|
||||
MyDataArray => {
|
||||
MyData => [
|
||||
{ int => 1 },
|
||||
{ int => 1 }
|
||||
]
|
||||
}
|
||||
}
|
||||
|
||||
List reference creation is triggered by the second occurance of an element.
|
||||
XML Array types with one element only will not be represented as list
|
||||
references.
|
||||
|
||||
=head1 USAGE
|
||||
|
||||
All you need to do is to use SOAP::WSDL::Deserializer::Hash.
|
||||
|
||||
SOAP::WSDL::Deserializer::Hash autoregisters itself for SOAP1.1 messages
|
||||
|
||||
You may register SOAP::WSDLDeserializer::Hash for other SOAP Versions by
|
||||
calling
|
||||
|
||||
SOAP::Factory::Deserializer->register('1.2',
|
||||
SOAP::WSDL::Deserializer::Hash)
|
||||
|
||||
=head1 Limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * Namespaces
|
||||
|
||||
All namespaces are ignored.
|
||||
|
||||
=item * XML attributes
|
||||
|
||||
All XML attributes are ignored.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Differences from other SOAP::WSDL::Deserializer classes
|
||||
|
||||
=over
|
||||
|
||||
=item * generate_fault
|
||||
|
||||
SOAP::WSDL::Deserializer::Hash will die with a SOAP::WSDL::Fault11 object when
|
||||
a parse error appears
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Serializer.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,49 @@
|
||||
package SOAP::WSDL::Deserializer::SOAP11;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
use SOAP::WSDL::Expat::MessageParser;
|
||||
|
||||
our $VERSION='2.00_17';
|
||||
|
||||
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
|
||||
|
||||
sub BUILD {
|
||||
my ($self, $ident, $args_of_ref) = @_;
|
||||
|
||||
# ignore all options except 'class_resolver'
|
||||
for (keys %{ $args_of_ref }) {
|
||||
delete $args_of_ref->{ $_ } if $_ ne 'class_resolver';
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub deserialize {
|
||||
my ($self, $content) = @_;
|
||||
|
||||
my $parser = SOAP::WSDL::Expat::MessageParser->new({
|
||||
class_resolver => $class_resolver_of{ ident $self },
|
||||
});
|
||||
eval { $parser->parse_string( $content ) };
|
||||
if ($@) {
|
||||
return $self->generate_fault({
|
||||
code => 'soap:Server',
|
||||
role => 'urn:localhost',
|
||||
message => "Error deserializing message: $@. \n"
|
||||
. "Message was: \n$content"
|
||||
});
|
||||
}
|
||||
return ( $parser->get_data(), $parser->get_header() );
|
||||
}
|
||||
|
||||
sub generate_fault {
|
||||
my ($self, $args_from_ref) = @_;
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
faultcode => $args_from_ref->{ code } || 'soap:Client',
|
||||
faultactor => $args_from_ref->{ role } || 'urn:localhost',
|
||||
faultstring => $args_from_ref->{ message } || "Unknown error"
|
||||
});
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,124 @@
|
||||
package SOAP::WSDL::Deserializer::SOM;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.00_15';
|
||||
our @ISA;
|
||||
|
||||
eval {
|
||||
require SOAP::Lite;
|
||||
push @ISA, 'SOAP::Deserializer';
|
||||
}
|
||||
or die "Cannot load SOAP::Lite.
|
||||
Cannot deserialize to SOM object without SOAP::Lite.
|
||||
Please install SOAP::Lite.";
|
||||
|
||||
sub generate_fault {
|
||||
my ($self, $args_from_ref) = @_;
|
||||
# code, message, detail, actor
|
||||
die SOAP::Fault->new(
|
||||
faultcode => $args_from_ref->{ code },
|
||||
faultstring => $args_from_ref->{ message },
|
||||
faultactor => $args_from_ref->{ role },
|
||||
);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Deserializer::SOM - Deserializer SOAP messages into SOM objects
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use SOAP::WSDL;
|
||||
use SOAP::WSDL::Deserializer::SOM;
|
||||
use SOAP::WSDL::Factory::Deserializer;
|
||||
SOAP::WSDL::Factory::Deserializer->register( '1.1', __PACKAGE__ );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Deserializer for creating SOAP::Lite's SOM object as result of a SOAP call.
|
||||
|
||||
This package is here for two reasons:
|
||||
|
||||
=over
|
||||
|
||||
=item * Compatibility
|
||||
|
||||
You don't have to change the rest of your SOAP::Lite based app when switching
|
||||
to SOAP::WSDL, but can just use SOAP::WSDL::Deserializer::SOM to get back the
|
||||
same objects as you were used to.
|
||||
|
||||
=item * Completeness
|
||||
|
||||
SOAP::Lite covers much more of the SOAP specification than SOAP::WSDL.
|
||||
|
||||
SOAP::WSDL::Deserializer::SOM can be used for content which cannot be
|
||||
deserialized by L<SOAP::WSDL::Deserializer::SOAP11|SOAP::WSDL::Deserializer::SOAP11>.
|
||||
This may be XML including mixed content, attachements and other XML data not
|
||||
(yet) handled by L<SOAP::WSDL::Deserializer::SOAP11|SOAP::WSDL::Deserializer::SOAP11>.
|
||||
|
||||
=back
|
||||
|
||||
SOAP::WSDL::Deserializer::SOM is a subclass of L<SOAP::Deserializer|SOAP::Deserializer>
|
||||
from the L<SOAP::Lite|SOAP::Lite> package.
|
||||
|
||||
You may
|
||||
|
||||
=head1 USAGE
|
||||
|
||||
SOAP::WSDL::Deserializer will not auroregister itself - to use it for a particular
|
||||
SOAP version just use the following lines:
|
||||
|
||||
my $soap_version = '1.1'; # or '1.2', further versions may appear.
|
||||
|
||||
use SOAP::WSDL::Deserializer::SOM;
|
||||
use SOAP::WSDL::Factory::Deserializer;
|
||||
SOAP::WSDL::Factory::Deserializer->register( $soap_version, __PACKAGE__ );
|
||||
|
||||
=head1 DIFFERENCES FROM OTHER CLASSES
|
||||
|
||||
=head2 Differences from SOAP::Lite
|
||||
|
||||
=over
|
||||
|
||||
=item * No on_fault handler
|
||||
|
||||
You cannot specify what to do when an error occurs - SOAP::WSDL will die
|
||||
with a SOAP::Fault object on transport errors.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Differences from other SOAP::WSDL::Deserializer classes
|
||||
|
||||
=over
|
||||
|
||||
=item * generate_fault
|
||||
|
||||
SOAP::WSDL::Deserializer::SOM will die with a SOAP::Fault object on calls
|
||||
to generate_fault.
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Serializer.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
|
||||
|
||||
=cut
|
||||
@@ -1,66 +0,0 @@
|
||||
#!/usr/bin/perl -w
|
||||
package SOAP::WSDL::Envelope;
|
||||
use strict;
|
||||
use base qw/SOAP::WSDL::Base/;
|
||||
|
||||
my $SOAP_NS = 'http://schemas.xmlsoap.org/soap/envelope/';
|
||||
my $XML_INSTANCE_NS = 'http://www.w3.org/2001/XMLSchema-instance';
|
||||
|
||||
sub serialize {
|
||||
my ($self, $name, $data, $opt) = @_;
|
||||
|
||||
if (not $opt->{ namespace }->{ $SOAP_NS })
|
||||
{
|
||||
$opt->{ namespace }->{ $SOAP_NS } = 'SOAP-ENV';
|
||||
}
|
||||
|
||||
if (not $opt->{ namespace }->{ $XML_INSTANCE_NS })
|
||||
{
|
||||
$opt->{ namespace }->{ $XML_INSTANCE_NS } = 'xsi';
|
||||
}
|
||||
|
||||
my $soap_prefix = $opt->{ namespace }->{ $SOAP_NS };
|
||||
|
||||
# envelope start with namespaces
|
||||
my $xml = "<$soap_prefix\:Envelope ";
|
||||
|
||||
while (my ($uri, $prefix) = each %{ $opt->{ namespace } })
|
||||
{
|
||||
$xml .= "\n\t" if ($opt->{'readable'});
|
||||
$xml .= "xmlns:$prefix=\"$uri\" ";
|
||||
}
|
||||
|
||||
# TODO insert encoding
|
||||
$xml.='>';
|
||||
$xml .= $self->serialize_header($name, $data, $opt);
|
||||
$xml .= $self->serialize_body($name, $data, $opt);
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
$xml .= '</' . $soap_prefix .':Envelope>';
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub serialize_header {
|
||||
my $xml = '';
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub serialize_body {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my $data = shift;
|
||||
my $opt = shift;
|
||||
|
||||
my $soap_prefix = $opt->{ namespace }->{ $SOAP_NS };
|
||||
|
||||
my $xml = '';
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
$xml .= "<$soap_prefix\:Body>";
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
|
||||
# include parts
|
||||
$xml .= $data if ( defined($data) );
|
||||
|
||||
$xml .= "</$soap_prefix\:Body>";
|
||||
return $xml;
|
||||
}
|
||||
@@ -0,0 +1,42 @@
|
||||
package SOAP::WSDL::Expat::Base;
|
||||
use strict;
|
||||
use warnings;
|
||||
use XML::Parser::Expat;
|
||||
|
||||
sub new {
|
||||
my ($class, $args) = @_;
|
||||
my $self = {};
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub parse {
|
||||
eval {
|
||||
$_[0]->_initialize( XML::Parser::Expat->new( Namespaces => 1 ) )->parse( $_[1] );
|
||||
$_[0]->{ parser }->release();
|
||||
};
|
||||
$_[0]->{ parser }->xpcroak( $@ ) if $@;
|
||||
return $_[0]->{ data };
|
||||
}
|
||||
|
||||
sub parsefile {
|
||||
eval {
|
||||
$_[0]->_initialize( XML::Parser::Expat->new(Namespaces => 1) )->parsefile( $_[1] );
|
||||
$_[0]->{ parser }->release();
|
||||
};
|
||||
$_[0]->{ parser }->xpcroak( $@ ) if $@;
|
||||
return $_[0]->{ data };
|
||||
}
|
||||
|
||||
# SAX-like aliases
|
||||
sub parse_string;
|
||||
*parse_string = \&parse;
|
||||
|
||||
sub parse_file;
|
||||
*parse_file = \&parsefile;
|
||||
|
||||
sub get_data {
|
||||
return $_[0]->{ data };
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,127 @@
|
||||
#!/usr/bin/perl
|
||||
package SOAP::WSDL::Expat::Message2Hash;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(SOAP::WSDL::Expat::Base);
|
||||
|
||||
sub _initialize {
|
||||
my ($self, $parser) = @_;
|
||||
$self->{ parser } = $parser;
|
||||
delete $self->{ data }; # remove potential old results
|
||||
|
||||
my $characters;
|
||||
my $current = {};
|
||||
my $list = []; # node list
|
||||
my $current_part = q{}; # are we in header or body ?
|
||||
$self->{ data } = $current;
|
||||
|
||||
# use "globals" for speed
|
||||
my ($_element, $_method,
|
||||
$_class, $_parser, %_attrs) = ();
|
||||
|
||||
no strict qw(refs);
|
||||
$parser->setHandlers(
|
||||
Start => sub {
|
||||
push @$list, $current;
|
||||
#If our element exists and is a list ref, add to it
|
||||
if ( exists $current->{ $_[1] }
|
||||
&& ( ref ($current->{ $_[1] }) eq 'ARRAY')
|
||||
) {
|
||||
push @{ $current->{ $_[1] } }, {};
|
||||
$current = $current->{ $_[1] }->[-1];
|
||||
}
|
||||
elsif ( exists $current->{ $_[1] } )
|
||||
{
|
||||
$current->{ $_[1] } = [ $current->{ $_[1] }, {} ];
|
||||
$current = $current->{ $_[1] }->[-1];
|
||||
}
|
||||
else {
|
||||
$current->{ $_[1] } = {};
|
||||
$current = $current->{ $_[1] };
|
||||
}
|
||||
return;
|
||||
},
|
||||
|
||||
Char => sub {
|
||||
$characters .= $_[1] if $_[1] !~m{ \A \s* \z}xms;
|
||||
return;
|
||||
},
|
||||
|
||||
End => sub {
|
||||
$_element = $_[1];
|
||||
|
||||
# This one easily handles ignores for us, too...
|
||||
# return if not ref $$list[-1];
|
||||
|
||||
if (length $characters) {
|
||||
if (ref $list->[-1]->{ $_element } eq 'ARRAY') {
|
||||
$list->[-1]->{ $_element }->[-1] = $characters ;
|
||||
}
|
||||
else {
|
||||
$list->[-1]->{ $_element } = $characters;
|
||||
}
|
||||
}
|
||||
$characters = q{};
|
||||
$current = pop @$list; # step up in object hierarchy...
|
||||
return;
|
||||
}
|
||||
);
|
||||
return $parser;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Expat::Message2Hash - Convert SOAP messages to perl hash refs
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $parser = SOAP::WSDL::Expat::MessageParser->new({
|
||||
class_resolver => 'My::Resolver'
|
||||
});
|
||||
$parser->parse( $xml );
|
||||
my $obj = $parser->get_data();
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Real fast expat based SOAP message parser.
|
||||
|
||||
See L<SOAP::WSDL::Manual::Parser> for details.
|
||||
|
||||
=head1 Bugs and Limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * Ignores all namespaces
|
||||
|
||||
=item * Ignores all attributes
|
||||
|
||||
=item * Does not handle mixed content
|
||||
|
||||
=item * The SOAP header is ignored
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Replace the whitespace by @ for E-Mail Address.
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
This module may be used under the same terms as perl itself.
|
||||
|
||||
=head1 Repository information
|
||||
|
||||
$ID: $
|
||||
|
||||
$LastChangedDate: 2007-09-10 18:19:23 +0200 (Mo, 10 Sep 2007) $
|
||||
$LastChangedRevision: 218 $
|
||||
$LastChangedBy: kutterma $
|
||||
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $
|
||||
|
||||
@@ -3,31 +3,13 @@ package SOAP::WSDL::Expat::MessageParser;
|
||||
use strict;
|
||||
use warnings;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use XML::Parser::Expat;
|
||||
|
||||
=pod
|
||||
|
||||
=head2 new
|
||||
|
||||
=over
|
||||
|
||||
=item SYNOPSIS
|
||||
|
||||
my $obj = ->new();
|
||||
|
||||
=item DESCRIPTION
|
||||
|
||||
Constructor.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
use base qw(SOAP::WSDL::Expat::Base);
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $args = shift;
|
||||
my ($class, $args) = @_;
|
||||
my $self = {
|
||||
class_resolver => $args->{ class_resolver }
|
||||
class_resolver => $args->{ class_resolver },
|
||||
strict => exists $args->{ strict } ? $args->{ strict } : 1,
|
||||
};
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
@@ -35,115 +17,167 @@ sub new {
|
||||
|
||||
sub class_resolver {
|
||||
my $self = shift;
|
||||
$self->{ class_resolver } = shift;
|
||||
$self->{ class_resolver } = shift if @_;
|
||||
return $self->{ class_resolver };
|
||||
}
|
||||
|
||||
sub parse {
|
||||
my $self = shift;
|
||||
my $xml = shift;
|
||||
$self->{ data } = undef;
|
||||
sub _initialize {
|
||||
my ($self, $parser) = @_;
|
||||
$self->{ parser } = $parser;
|
||||
|
||||
delete $self->{ data }; # remove potential old results
|
||||
delete $self->{ header };
|
||||
|
||||
my $characters;
|
||||
my $current = '__STOP__';
|
||||
my $ignore = [ 'Envelope', 'Body' ];
|
||||
my $list = [];
|
||||
my $namespace = {};
|
||||
my $path = [];
|
||||
my $parser = XML::Parser::Expat->new();
|
||||
#my @characters_from = ();
|
||||
my $current = undef;
|
||||
my $list = []; # node list
|
||||
my $path = []; # current path
|
||||
my $skip = 0; # skip elements
|
||||
my $current_part = q{}; # are we in header or body ?
|
||||
|
||||
my $depth = 0;
|
||||
|
||||
my %content_check = $self->{strict}
|
||||
? (
|
||||
0 => sub {
|
||||
die "Bad top node $_[1]" if $_[1] ne 'Envelope';
|
||||
die "Bad namespace for SOAP envelope: " . $_[0]->recognized_string()
|
||||
if $_[0]->namespace($_[1]) ne 'http://schemas.xmlsoap.org/soap/envelope/';
|
||||
$depth++;
|
||||
return;
|
||||
},
|
||||
1 => sub {
|
||||
$depth++;
|
||||
if ($_[1] eq 'Body') {
|
||||
if (exists $self->{ data }) { # there was header data
|
||||
$self->{ header } = $self->{ data };
|
||||
delete $self->{ data };
|
||||
$list = [];
|
||||
$path = [];
|
||||
undef $current;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
)
|
||||
: ();
|
||||
|
||||
my $char_handler = sub {
|
||||
# push @characters_from, $_[1] if $_[1] =~m{ [^s] }xms;
|
||||
$characters .= $_[1] if $_[1] =~m{ [^\s] }xms;
|
||||
|
||||
return;
|
||||
};
|
||||
|
||||
# use "globals" for speed
|
||||
my ($_prefix, $_method,
|
||||
$_class) = ();
|
||||
|
||||
no strict qw(refs);
|
||||
$parser->setHandlers(
|
||||
Start => sub {
|
||||
my ($parser, $element, %attrs) = @_;
|
||||
my ($prefix, $localname) = split m{:}xms , $element;
|
||||
# for non-prefixed elements
|
||||
if (not $localname) {
|
||||
$localname = $element;
|
||||
$prefix = q{};
|
||||
}
|
||||
# ignore top level elements
|
||||
if (@{ $ignore } && $localname eq $ignore->[0]) {
|
||||
shift @{ $ignore };
|
||||
return;
|
||||
}
|
||||
# empty characters
|
||||
$characters = q{};
|
||||
# my ($parser, $element, %_attrs) = @_;
|
||||
# $depth = $parser->depth();
|
||||
|
||||
push @{ $path }, $localname; # step down...
|
||||
push @{ $list }, $current; # remember current
|
||||
# call methods without using their parameter stack
|
||||
# That's slightly faster than $content_check{ $depth }->()
|
||||
# and we don't have to pass $_[1] to the method.
|
||||
# Yup, that's dirty.
|
||||
return &{$content_check{ $depth }} if exists $content_check{ $depth };
|
||||
|
||||
push @{ $path }, $_[1]; # step down in path
|
||||
return if $skip; # skip inside __SKIP__
|
||||
|
||||
# resolve class of this element
|
||||
my $class = $self->{ class_resolver }->get_class( $path )
|
||||
$_class = $self->{ class_resolver }->get_class( $path )
|
||||
or die "Cannot resolve class for "
|
||||
. join('/', @{ $path }) . " via $self->{ class_resolver }";
|
||||
. join('/', @{ $path }) . " via " . $self->{ class_resolver };
|
||||
|
||||
# Check whether we have a primitive - we implement them as classes
|
||||
# TODO replace with UNIVERSAL->isa()
|
||||
if ($_class eq '__SKIP__') {
|
||||
$skip = join('/', @{ $path });
|
||||
$self->setHandlers( Char => undef );
|
||||
return;
|
||||
}
|
||||
|
||||
push @$list, $current; # step down in tree ()remember current)
|
||||
|
||||
$characters = q(); # empty characters
|
||||
#@characters_from = ();
|
||||
|
||||
# Check whether we have a builtin - we implement them as classes
|
||||
# We could replace this with UNIVERSAL->isa() - but it's slow...
|
||||
# match is a bit faster if the string does not match, but WAY slower
|
||||
# if $class matches...
|
||||
# if (not $class=~m{^SOAP::WSDL::XSD::Typelib::Builtin}xms) {
|
||||
|
||||
if (index $class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
|
||||
|
||||
# check wheter there is a CODE reference for $class::new.
|
||||
if (index $_class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
|
||||
# check wheter there is a non-empty ARRAY reference for $_class::ISA
|
||||
# or a "new" method
|
||||
# If not, require it - all classes required here MUST
|
||||
# define new()
|
||||
# This is the same as $class->can('new'), but it's way faster
|
||||
*{ "$class\::new" }{ CODE }
|
||||
or eval "require $class" ## no critic qw(ProhibitStringyEval)
|
||||
or die $@;
|
||||
# This is not exactly the same as $class->can('new'), but it's way faster
|
||||
defined *{ "$_class\::new" }{ CODE }
|
||||
or scalar @{ *{ "$_class\::ISA" }{ ARRAY } }
|
||||
or eval "require $_class" ## no critic qw(ProhibitStringyEval)
|
||||
or die $@;
|
||||
}
|
||||
# create object
|
||||
# set current object
|
||||
$current = $class->new({ %attrs });
|
||||
|
||||
$current = $_class->new({ @_[2..$#_] }); # set new current object
|
||||
|
||||
# remember top level element
|
||||
defined $self->{ data }
|
||||
exists $self->{ data }
|
||||
or ($self->{ data } = $current);
|
||||
$depth++;
|
||||
return;
|
||||
},
|
||||
Char => sub {
|
||||
$characters .= $_[1];
|
||||
},
|
||||
End => sub {
|
||||
my $element = $_[1];
|
||||
|
||||
my ($prefix, $localname) = split m{:}xms , $element;
|
||||
# for non-prefixed elements
|
||||
if (not $localname) {
|
||||
$localname = $element;
|
||||
$prefix = q{};
|
||||
Char => $char_handler,
|
||||
|
||||
End => sub {
|
||||
pop @{ $path }; # step up in path
|
||||
|
||||
if ($skip) {
|
||||
return if $skip ne join '/', @{ $path }, $_[1];
|
||||
$skip = 0;
|
||||
$_[0]->setHandler( Char => $char_handler );
|
||||
return;
|
||||
}
|
||||
|
||||
$depth--;
|
||||
|
||||
# This one easily handles ignores for us, too...
|
||||
return if not ref $list->[-1];
|
||||
|
||||
if ( $current
|
||||
->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType') ) {
|
||||
$current->set_value( $characters );
|
||||
}
|
||||
|
||||
# set characters in current if we are a simple type
|
||||
# we may have characters in complexTypes with simpleContent,
|
||||
# too - maybe we should rely on the presence of characters ?
|
||||
# may get a speedup by defining a ident method in anySimpleType
|
||||
# and looking it up via exists &$class::ident;
|
||||
# if ( $current->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType') ) {
|
||||
# $current->set_value( $characters );
|
||||
# }
|
||||
# currently doesn't work, as anyType does not implement value -
|
||||
# maybe change ?
|
||||
$current->set_value( $characters ) if (length $characters);
|
||||
#$current->set_value( join @characters_from ) if (@characters_from);
|
||||
$characters = q{};
|
||||
# undef @characters_from;
|
||||
# set appropriate attribute in last element
|
||||
# multiple values must be implemented in base class
|
||||
my $method = "add_$localname";
|
||||
#$_method = "add_$_localname";
|
||||
$_method = "add_$_[1]";
|
||||
$list->[-1]->$_method( $current );
|
||||
|
||||
$list->[-1]->$method( $current );
|
||||
|
||||
# step up in path
|
||||
pop @{ $path };
|
||||
|
||||
# step up in object hierarchy...
|
||||
$current = pop @{ $list };
|
||||
$current = pop @$list; # step up in object hierarchy...
|
||||
return;
|
||||
}
|
||||
);
|
||||
|
||||
$parser->parse( $xml );
|
||||
return $parser;
|
||||
}
|
||||
|
||||
sub get_data {
|
||||
my $self = shift;
|
||||
return $self->{ data };
|
||||
}
|
||||
|
||||
sub get_header {
|
||||
return $_[0]->{ header };
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
@@ -165,7 +199,14 @@ SOAP::WSDL::Expat::MessageParser - Convert SOAP messages to custom object trees
|
||||
|
||||
Real fast expat based SOAP message parser.
|
||||
|
||||
See L<SOAP::WSDL::Parser> for details.
|
||||
See L<SOAP::WSDL::Manual::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
|
||||
|
||||
@@ -193,9 +234,9 @@ This module may be used under the same terms as perl itself.
|
||||
|
||||
$ID: $
|
||||
|
||||
$LastChangedDate: $
|
||||
$LastChangedRevision: $
|
||||
$LastChangedBy: $
|
||||
$LastChangedDate: 2007-10-07 19:27:58 +0200 (Son, 07 Okt 2007) $
|
||||
$LastChangedRevision: 313 $
|
||||
$LastChangedBy: kutterma $
|
||||
|
||||
$HeadURL: $
|
||||
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $
|
||||
|
||||
@@ -2,148 +2,26 @@
|
||||
package SOAP::WSDL::Expat::MessageStreamParser;
|
||||
use strict;
|
||||
use warnings;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use XML::Parser::Expat;
|
||||
use SOAP::WSDL::Expat::MessageParser;
|
||||
use base qw(SOAP::WSDL::Expat::MessageParser);
|
||||
|
||||
=pod
|
||||
|
||||
=head2 new
|
||||
|
||||
=over
|
||||
|
||||
=item SYNOPSIS
|
||||
|
||||
my $obj = ->new();
|
||||
|
||||
=item DESCRIPTION
|
||||
|
||||
Constructor.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
class_resolver => shift->{ class_resolver }
|
||||
};
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub class_resolver {
|
||||
sub parse_start {
|
||||
my $self = shift;
|
||||
$self->{ class_resolver } = shift;
|
||||
$self->{ parser } = $_[0]->_initialize( XML::Parser::ExpatNB->new( Namespaces => 1 ) );
|
||||
}
|
||||
sub init;
|
||||
*init = \&parse_start;
|
||||
|
||||
sub parse_more {
|
||||
$_[0]->{ parser }->parse_more( $_[1] );
|
||||
}
|
||||
|
||||
sub init {
|
||||
my $self = shift;
|
||||
my $xml = shift;
|
||||
$self->{ data } = undef;
|
||||
|
||||
my $characters;
|
||||
my $current = '__STOP__';
|
||||
my $ignore = [ 'Envelope', 'Body' ];
|
||||
my $list = [];
|
||||
my $namespace = {};
|
||||
my $path = [];
|
||||
my $parser = XML::Parser::ExpatNB->new();
|
||||
|
||||
no strict qw(refs);
|
||||
$parser->setHandlers(
|
||||
Start => sub {
|
||||
my ($parser, $element, %attrs) = @_;
|
||||
my ($prefix, $localname) = split m{:}xms , $element;
|
||||
# for non-prefixed elements
|
||||
if (not $localname) {
|
||||
$localname = $element;
|
||||
$prefix = q{};
|
||||
}
|
||||
# ignore top level elements
|
||||
if (@{ $ignore } && $localname eq $ignore->[0]) {
|
||||
shift @{ $ignore };
|
||||
return;
|
||||
}
|
||||
# empty characters
|
||||
$characters = q{};
|
||||
|
||||
push @{ $path }, $localname; # step down...
|
||||
push @{ $list }, $current; # remember current
|
||||
|
||||
# resolve class of this element
|
||||
my $class = $self->{ class_resolver }->get_class( $path )
|
||||
or die "Cannot resolve class for "
|
||||
. join('/', @{ $path }) . " via $self->{ class_resolver }";
|
||||
|
||||
# Check whether we have a primitive - we implement them as classes
|
||||
# TODO replace with UNIVERSAL->isa()
|
||||
# match is a bit faster if the string does not match, but WAY slower
|
||||
# if $class matches...
|
||||
# if (not $class=~m{^SOAP::WSDL::XSD::Typelib::Builtin}xms) {
|
||||
|
||||
if (index $class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
|
||||
|
||||
# check wheter there is a CODE reference for $class::new.
|
||||
# If not, require it - all classes required here MUST
|
||||
# define new()
|
||||
# This is the same as $class->can('new'), but it's way faster
|
||||
*{ "$class\::new" }{ CODE }
|
||||
or eval "require $class" ## no critic qw(ProhibitStringyEval)
|
||||
or die $@;
|
||||
}
|
||||
# create object
|
||||
# set current object
|
||||
$current = $class->new({ %attrs });
|
||||
|
||||
# remember top level element
|
||||
defined $self->{ data }
|
||||
or ($self->{ data } = $current);
|
||||
},
|
||||
Char => sub {
|
||||
$characters .= $_[1];
|
||||
},
|
||||
End => sub {
|
||||
my $element = $_[1];
|
||||
|
||||
my ($prefix, $localname) = split m{:}xms , $element;
|
||||
# for non-prefixed elements
|
||||
if (not $localname) {
|
||||
$localname = $element;
|
||||
$prefix = q{};
|
||||
}
|
||||
|
||||
# This one easily handles ignores for us, too...
|
||||
return if not ref $list->[-1];
|
||||
|
||||
if ( $current
|
||||
->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType') ) {
|
||||
$current->set_value( $characters );
|
||||
}
|
||||
|
||||
# set appropriate attribute in last element
|
||||
# multiple values must be implemented in base class
|
||||
my $method = "add_$localname";
|
||||
|
||||
$list->[-1]->$method( $current );
|
||||
|
||||
# step up in path
|
||||
pop @{ $path };
|
||||
|
||||
# step up in object hierarchy...
|
||||
$current = pop @{ $list };
|
||||
}
|
||||
);
|
||||
|
||||
return $parser;
|
||||
sub parse_done {
|
||||
$_[0]->{ parser }->parse_done();
|
||||
$_[0]->{ parser }->release();
|
||||
}
|
||||
|
||||
sub get_data {
|
||||
my $self = shift;
|
||||
return $self->{ data };
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
@@ -170,19 +48,11 @@ SOAP::WSDL::Expat::MessageStreamParser - Convert SOAP messages to custom object
|
||||
|
||||
ExpatNB based parser for parsing huge documents.
|
||||
|
||||
See L<SOAP::WSDL::Parser> for details.
|
||||
See L<SOAP::WSDL::Manual::Parser> for details.
|
||||
|
||||
=head1 Bugs and Limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * Ignores all namespaces
|
||||
|
||||
=item * Does not handle mixed content
|
||||
|
||||
=item * The SOAP header is ignored
|
||||
|
||||
=back
|
||||
See SOAP::WSDL::Expat::MessageParser
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
@@ -198,9 +68,9 @@ This module may be used under the same terms as perl itself.
|
||||
|
||||
$ID: $
|
||||
|
||||
$LastChangedDate: $
|
||||
$LastChangedRevision: $
|
||||
$LastChangedBy: $
|
||||
$LastChangedDate: 2007-10-07 19:27:58 +0200 (Son, 07 Okt 2007) $
|
||||
$LastChangedRevision: 313 $
|
||||
$LastChangedBy: kutterma $
|
||||
|
||||
$HeadURL: $
|
||||
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageStreamParser.pm $
|
||||
|
||||
@@ -0,0 +1,143 @@
|
||||
package SOAP::WSDL::Expat::WSDLParser;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use SOAP::WSDL::TypeLookup;
|
||||
use base qw(SOAP::WSDL::Expat::Base);
|
||||
|
||||
sub _initialize {
|
||||
my ($self, $parser) = @_;
|
||||
|
||||
# init object data
|
||||
$self->{ parser } = $parser;
|
||||
delete $self->{ data };
|
||||
|
||||
# setup local variables for keeping temp data
|
||||
my $characters = undef;
|
||||
my $current = undef;
|
||||
my $list = []; # node list
|
||||
|
||||
# TODO skip non-XML Schema namespace tags
|
||||
$parser->setHandlers(
|
||||
Start => sub {
|
||||
my ($parser, $localname, %attrs) = @_;
|
||||
$characters = q{};
|
||||
|
||||
my $action = SOAP::WSDL::TypeLookup->lookup(
|
||||
$parser->namespace($localname),
|
||||
$localname
|
||||
);
|
||||
|
||||
return if not $action;
|
||||
|
||||
if ($action->{ type } eq 'CLASS') {
|
||||
eval "require $action->{ class }";
|
||||
croak $@ if ($@);
|
||||
|
||||
my $obj = $action->{ class }->new({ parent => $current })
|
||||
->init( _fixup_attrs( $parser, %attrs ) );
|
||||
|
||||
if ($current) {
|
||||
# inherit namespace, but don't override
|
||||
$obj->set_targetNamespace( $current->get_targetNamespace() )
|
||||
if not $obj->get_targetNamespace();
|
||||
|
||||
# push on parent's element/type list
|
||||
my $method = "push_$localname";
|
||||
|
||||
no strict qw(refs);
|
||||
$current->$method( $obj );
|
||||
|
||||
# remember element for stepping back
|
||||
push @{ $list }, $current;
|
||||
}
|
||||
else {
|
||||
$self->{ data } = $obj;
|
||||
}
|
||||
# set new element (step down)
|
||||
$current = $obj;
|
||||
}
|
||||
elsif ($action->{ type } eq 'PARENT') {
|
||||
$current->init( _fixup_attrs($parser, %attrs) );
|
||||
}
|
||||
elsif ($action->{ type } eq 'METHOD') {
|
||||
my $method = $action->{ method } || $localname;
|
||||
|
||||
no strict qw(refs);
|
||||
# call method with
|
||||
# - default value ($action->{ value } if defined,
|
||||
# dereferencing lists
|
||||
# - the values of the elements Attributes hash
|
||||
# TODO: add namespaces declared to attributes.
|
||||
# Expat consumes them, so we have to re-add them here.
|
||||
$current->$method( defined $action->{ value }
|
||||
? ref $action->{ value }
|
||||
? @{ $action->{ value } }
|
||||
: ($action->{ value })
|
||||
: _fixup_attrs($parser, %attrs)
|
||||
);
|
||||
}
|
||||
|
||||
return;
|
||||
},
|
||||
|
||||
Char => sub { $characters .= $_[1]; return; },
|
||||
|
||||
End => sub {
|
||||
my ($parser, $localname) = @_;
|
||||
|
||||
my $action = SOAP::WSDL::TypeLookup->lookup(
|
||||
$parser->namespace( $localname ),
|
||||
$localname
|
||||
) || {};
|
||||
|
||||
return if not ($action->{ type });
|
||||
if ( $action->{ type } eq 'CLASS' ) {
|
||||
$current = pop @{ $list };
|
||||
}
|
||||
elsif ($action->{ type } eq 'CONTENT' ) {
|
||||
my $method = $action->{ method };
|
||||
|
||||
# normalize whitespace
|
||||
$characters =~s{ ^ \s+ (.+) \s+ $ }{$1}xms;
|
||||
$characters =~s{ \s+ }{ }xmsg;
|
||||
|
||||
no strict qw(refs);
|
||||
$current->$method( $characters );
|
||||
}
|
||||
return;
|
||||
}
|
||||
);
|
||||
return $parser;
|
||||
}
|
||||
|
||||
# make attrs SAX style
|
||||
sub _fixup_attrs {
|
||||
my ($parser, %attrs_of) = @_;
|
||||
|
||||
my @attrs_from = map { $_ =
|
||||
{
|
||||
Name => $_,
|
||||
Value => $attrs_of{ $_ },
|
||||
LocalName => $_
|
||||
}
|
||||
} keys %attrs_of;
|
||||
|
||||
# add xmlns: attrs. expat eats them.
|
||||
push @attrs_from, map {
|
||||
# ignore xmlns=FOO namespaces - must be XML schema
|
||||
# Other nodes should be ignored somewhere else
|
||||
($_ eq '#default')
|
||||
? ()
|
||||
:
|
||||
{
|
||||
Name => "xmlns:$_",
|
||||
Value => $parser->expand_ns_prefix( $_ ),
|
||||
LocalName => $_
|
||||
}
|
||||
} $parser->new_ns_prefixes();
|
||||
return @attrs_from;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
@@ -0,0 +1,152 @@
|
||||
package SOAP::WSDL::Factory::Deserializer;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my %DESERIALIZER = (
|
||||
'1.1' => 'SOAP::WSDL::Deserializer::SOAP11',
|
||||
);
|
||||
|
||||
# class method
|
||||
sub register {
|
||||
my ($class, $ref_type, $package) = @_;
|
||||
$DESERIALIZER{ $ref_type } = $package;
|
||||
}
|
||||
|
||||
sub get_deserializer {
|
||||
my ($self, $args_of_ref) = @_;
|
||||
|
||||
# sanity check
|
||||
die "no deserializer registered for SOAP version $args_of_ref->{ soap_version }"
|
||||
if not exists ($DESERIALIZER{ $args_of_ref->{ soap_version } });
|
||||
|
||||
# load module
|
||||
eval "require $DESERIALIZER{ $args_of_ref->{ soap_version } }"
|
||||
or die "Cannot load serializer $DESERIALIZER{ $args_of_ref->{ soap_version } }", $@;
|
||||
|
||||
return $DESERIALIZER{ $args_of_ref->{ soap_version } }->new($args_of_ref);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Factory::Deserializer - Factory for retrieving Deserializer objects
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# from SOAP::WSDL::Client:
|
||||
$deserializer = SOAP::WSDL::Factory::Deserializer->get_deserializer({
|
||||
soap_version => $soap_version,
|
||||
class_resolver => $class_resolver,
|
||||
});
|
||||
|
||||
# in deserializer class:
|
||||
package MyWickedDeserializer;
|
||||
use SOAP::WSDL::Factory::Deserializer;
|
||||
|
||||
# register class as deserializer for SOAP1.2 messages
|
||||
SOAP::WSDL::Factory::Deserializer->register( '1.2' , __PACKAGE__ );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL::Factory::Deserializer serves as factory for retrieving
|
||||
deserializer objects for SOAP::WSDL.
|
||||
|
||||
The actual work is done by specific deserializer classes.
|
||||
|
||||
SOAP::WSDL::Deserializer tries to load one of the following classes:
|
||||
|
||||
=over
|
||||
|
||||
=item * The class registered for the scheme via register()
|
||||
|
||||
=back
|
||||
|
||||
By default, L<SOAP::WSDL::Deserializer::SOAP11|SOAP::WSDL::Deserializer::SOAP11>
|
||||
is registered for SOAP1.1 messages.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 register
|
||||
|
||||
SOAP::WSDL::Deserializer->register('1.1', 'MyWickedDeserializer');
|
||||
|
||||
Globally registers a class for use as deserializer class.
|
||||
|
||||
=head2 get_deserializer
|
||||
|
||||
Returns an object of the deserializer class for this endpoint.
|
||||
|
||||
=head1 WRITING YOUR OWN DESERIALIZER CLASS
|
||||
|
||||
Deserializer classes may register with SOAP::WSDL::Factory::Deserializer.
|
||||
|
||||
=head2 Registering a deserializer
|
||||
|
||||
Registering a deserializer class with SOAP::WSDL::Factory::Deserializer
|
||||
is done by executing the following code where $version is the SOAP version
|
||||
the class should be used for, and $class is the class name.
|
||||
|
||||
SOAP::WSDL::Factory::Deserializer->register( $version, $class);
|
||||
|
||||
To auto-register your transport class on loading, execute register()
|
||||
in your tranport class (see L<SYNOPSIS|SYNOPSIS> above).
|
||||
|
||||
=head2 Deserializer package layout
|
||||
|
||||
Deserializer modules must be named equal to the deserializer class they
|
||||
contain. There can only be one deserializer class per deserializer module.
|
||||
|
||||
=head2 Methods to implement
|
||||
|
||||
Deserializer classes must implement the following methods:
|
||||
|
||||
=over
|
||||
|
||||
=item * new
|
||||
|
||||
Constructor.
|
||||
|
||||
=item * deserialize
|
||||
|
||||
Deserialize data from XML to arbitrary formats.
|
||||
|
||||
deserialize() must return a fault indicating that deserializing failed if
|
||||
any error is encountered during the process of deserializing the XML message.
|
||||
|
||||
The following positional parameters are passed to the deserialize method:
|
||||
|
||||
$content - the xml message
|
||||
|
||||
=item * generate_fault
|
||||
|
||||
Generate a fault in the supported format. The following named parameters are
|
||||
passed as a single hash ref:
|
||||
|
||||
code - The fault code, e.g. 'soap:Server' or the like
|
||||
role - The fault role (actor in SOAP1.1)
|
||||
message - The fault message (faultstring in SOAP1.1)
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 176 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Serializer.pm 176 2007-08-31 15:28:29Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,172 @@
|
||||
package SOAP::WSDL::Factory::Generator;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION='2.00_18';
|
||||
|
||||
my %GENERATOR = (
|
||||
'XSD' => 'SOAP::WSDL::Generator::Template::XSD',
|
||||
);
|
||||
|
||||
# class method
|
||||
sub register {
|
||||
my ($class, $ref_type, $package) = @_;
|
||||
$GENERATOR{ $ref_type } = $package;
|
||||
}
|
||||
|
||||
sub get_generator {
|
||||
my ($self, $args_of_ref) = @_;
|
||||
|
||||
# sanity check
|
||||
# die "no generator registered for generation method $args_of_ref->{ type }"
|
||||
#
|
||||
my $generator_class = (exists ($GENERATOR{ $args_of_ref->{ type } }))
|
||||
? $GENERATOR{ $args_of_ref->{ type } }
|
||||
: $args_of_ref->{ type };
|
||||
|
||||
# load module
|
||||
eval "require $generator_class"
|
||||
or die "Cannot load generator $generator_class", $@;
|
||||
|
||||
return $generator_class->new();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Factory:Generator - Factory for retrieving generator objects
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# from SOAP::WSDL::Client:
|
||||
$generator = SOAP::WSDL::Factory::Generator->get_generator({
|
||||
soap_version => $soap_version,
|
||||
});
|
||||
|
||||
# in generator class:
|
||||
package MyWickedGenerator;
|
||||
use SOAP::WSDL::Factory::Generator;
|
||||
|
||||
# register as generator for SOAP1.2 messages
|
||||
SOAP::WSDL::Factory::Generator->register( '1.2' , __PACKAGE__ );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL::Factory::Generator serves as factory for retrieving
|
||||
generator objects for SOAP::WSDL.
|
||||
|
||||
The actual work is done by specific generator classes.
|
||||
|
||||
SOAP::WSDL::Generator tries to load one of the following classes:
|
||||
|
||||
=over
|
||||
|
||||
=item * the class registered for the scheme via register()
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 register
|
||||
|
||||
SOAP::WSDL::Generator->register('Lite', 'MyWickedGenerator');
|
||||
|
||||
Globally registers a class for use as generator class.
|
||||
|
||||
=head2 get_generator
|
||||
|
||||
Returns an object of the generator class for this endpoint.
|
||||
|
||||
=head1 WRITING YOUR OWN GENERATOR CLASS
|
||||
|
||||
=head2 Registering a generator
|
||||
|
||||
Generator classes may register with SOAP::WSDL::Factory::Generator.
|
||||
|
||||
Registering a generator class with SOAP::WSDL::Factory::Generator is done
|
||||
by executing the following code where $version is the SOAP version the
|
||||
class should be used for, and $class is the class name.
|
||||
|
||||
SOAP::WSDL::Factory::Generator->register( $version, $class);
|
||||
|
||||
To auto-register your transport class on loading, execute register() in
|
||||
your generator class (see L<SYNOPSIS|SYNOPSIS> above).
|
||||
|
||||
=head2 Generator package layout
|
||||
|
||||
Generator modules must be named equal to the generator class they contain.
|
||||
There can only be one generator class per generator module.
|
||||
|
||||
=head2 Methods to implement
|
||||
|
||||
Generator classes must implement the following methods:
|
||||
|
||||
=over
|
||||
|
||||
=item * new
|
||||
|
||||
Constructor.
|
||||
|
||||
=item * generate
|
||||
|
||||
Generate SOAP interface
|
||||
|
||||
=back
|
||||
|
||||
Generators may implements one or more of the following configuration
|
||||
methods. All of them are tried via can() by wsdl2perl.
|
||||
|
||||
=over
|
||||
|
||||
=item * set_wsdl
|
||||
|
||||
Set the raw WSDL XML. Implement if you have your own WSDL parser.
|
||||
|
||||
=item * set_definitions
|
||||
|
||||
Sets the (parsed) SOAP::WSDL::Definitions object.
|
||||
|
||||
=item * set_type_prefix
|
||||
|
||||
Sets the prefix for XML Schema type classes
|
||||
|
||||
=item * set_element_prefix
|
||||
|
||||
Sets the prefix for XML Schema element classes
|
||||
|
||||
=item * set_typemap_prefix
|
||||
|
||||
Sets the prefix for typemap classes (class resolvers).
|
||||
|
||||
=item * set_interface_prefix
|
||||
|
||||
Sets the prefix for interface classes
|
||||
|
||||
=item * set_typemap
|
||||
|
||||
Set user-defined typemap snippet
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright (c) 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under the same
|
||||
terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 302 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Generator.pm 302 2007-09-30 19:25:25Z kutterma $
|
||||
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Generator.pm $
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,146 @@
|
||||
package SOAP::WSDL::Factory::Serializer;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION='2.00_17';
|
||||
|
||||
my %SERIALIZER = (
|
||||
'1.1' => 'SOAP::WSDL::Serializer::SOAP11',
|
||||
);
|
||||
|
||||
# class method
|
||||
sub register {
|
||||
my ($class, $ref_type, $package) = @_;
|
||||
$SERIALIZER{ $ref_type } = $package;
|
||||
}
|
||||
|
||||
sub get_serializer {
|
||||
my ($self, $args_of_ref) = @_;
|
||||
|
||||
# sanity check
|
||||
die "no serializer registered for SOAP version $args_of_ref->{ soap_version }"
|
||||
if not exists ($SERIALIZER{ $args_of_ref->{ soap_version } });
|
||||
|
||||
# load module
|
||||
eval "require $SERIALIZER{ $args_of_ref->{ soap_version } }"
|
||||
or die "Cannot load serializer $SERIALIZER{ $args_of_ref->{ soap_version } }", $@;
|
||||
|
||||
return $SERIALIZER{ $args_of_ref->{ soap_version } }->new();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Factory::Serializer - Factory for retrieving serializer objects
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# from SOAP::WSDL::Client:
|
||||
$serializer = SOAP::WSDL::Factory::Serializer->get_serializer({
|
||||
soap_version => $soap_version,
|
||||
});
|
||||
|
||||
# in serializer class:
|
||||
package MyWickedSerializer;
|
||||
use SOAP::WSDL::Factory::Serializer;
|
||||
|
||||
# register as serializer for SOAP1.2 messages
|
||||
SOAP::WSDL::Factory::Serializer->register( '1.2' , __PACKAGE__ );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL::Factory::Serializer serves as factory for retrieving
|
||||
serializer objects for SOAP::WSDL.
|
||||
|
||||
The actual work is done by specific serializer classes.
|
||||
|
||||
SOAP::WSDL::Serializer tries to load one of the following classes:
|
||||
|
||||
=over
|
||||
|
||||
=item * the class registered for the scheme via register()
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 register
|
||||
|
||||
SOAP::WSDL::Serializer->register('1.1', 'MyWickedSerializer');
|
||||
|
||||
Globally registers a class for use as serializer class.
|
||||
|
||||
=head2 get_serializer
|
||||
|
||||
Returns an object of the serializer class for this endpoint.
|
||||
|
||||
=head1 WRITING YOUR OWN SERIALIZER CLASS
|
||||
|
||||
=head2 Registering a deserializer
|
||||
|
||||
Serializer classes may register with SOAP::WSDL::Factory::Serializer.
|
||||
|
||||
Serializer objects may also be passed directly to SOAP::WSDL::Client by
|
||||
using the set_serializer method. Note that serializers objects set via
|
||||
SOAP::WSDL::Client's set_serializer method are discarded when the SOAP
|
||||
version is changed via set_soap_version.
|
||||
|
||||
Registering a serializer class with SOAP::WSDL::Factory::Serializer is done
|
||||
by executing the following code where $version is the SOAP version the
|
||||
class should be used for, and $class is the class name.
|
||||
|
||||
SOAP::WSDL::Factory::Serializer->register( $version, $class);
|
||||
|
||||
To auto-register your transport class on loading, execute register() in
|
||||
your tranport class (see L<SYNOPSIS|SYNOPSIS> above).
|
||||
|
||||
=head2 Serializer package layout
|
||||
|
||||
Serializer modules must be named equal to the serializer class they contain.
|
||||
There can only be one serializer class per serializer module.
|
||||
|
||||
=head2 Methods to implement
|
||||
|
||||
Serializer classes must implement the following methods:
|
||||
|
||||
=over
|
||||
|
||||
=item * new
|
||||
|
||||
Constructor.
|
||||
|
||||
=item * serialize
|
||||
|
||||
Serializes data to XML. The following named parameters are passed to the
|
||||
serialize method in a anonymous hash ref:
|
||||
|
||||
{
|
||||
method => $operation_name,
|
||||
header => $header_data,
|
||||
body => $body_data,
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 302 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Serializer.pm 302 2007-09-30 19:25:25Z kutterma $
|
||||
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,244 @@
|
||||
package SOAP::WSDL::Factory::Transport;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION='2.00_17';
|
||||
|
||||
# class data
|
||||
my %registered_transport_of = ();
|
||||
|
||||
# Local constants
|
||||
# Could be made readonly, but that's just for the paranoid...
|
||||
my %SOAP_LITE_TRANSPORT_OF = (
|
||||
ftp => 'SOAP::Transport::FTP',
|
||||
http => 'SOAP::Transport::HTTP',
|
||||
https => 'SOAP::Transport::HTTPS',
|
||||
mailto => 'SOAP::Transport::MAILTO',
|
||||
'local' => 'SOAP::Transport::LOCAL',
|
||||
jabber => 'SOAP::Transport::JABBER',
|
||||
mq => 'SOAP::Transport::MQ',
|
||||
);
|
||||
|
||||
my %SOAP_WSDL_TRANSPORT_OF = (
|
||||
http => 'SOAP::WSDL::Transport::HTTP',
|
||||
https => 'SOAP::WSDL::Transport::HTTP',
|
||||
);
|
||||
|
||||
# class methods only
|
||||
sub register {
|
||||
my ($class, $scheme, $package) = @_;
|
||||
die "cannot use reference as scheme" if ref $scheme;
|
||||
$registered_transport_of{ $scheme } = $package;
|
||||
}
|
||||
|
||||
sub get_transport {
|
||||
my ($class, $scheme, %attrs) = @_;
|
||||
|
||||
$scheme =~s{ \A ([^\:]+) \: .+ }{$1}smx;
|
||||
|
||||
if ($registered_transport_of{ $scheme }) {
|
||||
eval "require $registered_transport_of{ $scheme }"
|
||||
or die "Cannot load transport class $registered_transport_of{ $scheme } : $@";
|
||||
|
||||
# try "foo::Client" class first - SOAP::Tranport always requires
|
||||
# a package withoug the ::Client appended, and then
|
||||
# instantiates a ::Client object...
|
||||
# ... pretty weird ...
|
||||
# ... must be from some time when the max number of files was a
|
||||
# sparse resource ...
|
||||
# ... but we've decided to mimic SOAP::Lite...
|
||||
|
||||
# my $protocol_class = $SOAP_LITE_TRANSPORT_OF{ $scheme } . '::Client';
|
||||
# my $transport;
|
||||
# eval {
|
||||
# $transport = $protocol_class->new( %attrs );
|
||||
# };
|
||||
# return $transport if not $@;
|
||||
return $registered_transport_of{ $scheme }->new( %attrs );
|
||||
}
|
||||
|
||||
# try SOAP::Lite's Transport module - just skip if not require'able
|
||||
SOAP_Lite: {
|
||||
if (exists $SOAP_LITE_TRANSPORT_OF{ $scheme }) {
|
||||
eval "require $SOAP_LITE_TRANSPORT_OF{ $scheme }"
|
||||
or last SOAP_Lite;
|
||||
my $protocol_class = $SOAP_LITE_TRANSPORT_OF{ $scheme } . '::Client';
|
||||
return $protocol_class->new( %attrs );
|
||||
}
|
||||
}
|
||||
|
||||
if (exists $SOAP_WSDL_TRANSPORT_OF{ $scheme }) {
|
||||
eval "require $SOAP_WSDL_TRANSPORT_OF{ $scheme }"
|
||||
or die "Cannot load transport class $SOAP_WSDL_TRANSPORT_OF{ $scheme } : $@";
|
||||
return $SOAP_WSDL_TRANSPORT_OF{ $scheme }->new( %attrs );
|
||||
}
|
||||
|
||||
die "no transport class found for scheme <$scheme>";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Factory::Transport - Factory for retrieving transport objects
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# from SOAP::WSDL::Client:
|
||||
$transport = SOAP::WSDL::Factory::Transport->get_transport( $url, @opt );
|
||||
|
||||
# in transport class:
|
||||
package MyWickedTransport;
|
||||
use SOAP::WSDL::Factory::Transport;
|
||||
|
||||
# register class as transport module for httpr and https
|
||||
# (httpr is "reliable http", a protocol developed by IBM).
|
||||
SOAP::WSDL::Factory::Transport->register( 'httpr' , __PACKAGE__ );
|
||||
SOAP::WSDL::Factory::Transport->register( 'https' , __PACKAGE__ );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL::Transport serves as factory for retrieving transport objects for
|
||||
SOAP::WSDL.
|
||||
|
||||
The actual work is done by specific transport classes.
|
||||
|
||||
SOAP::WSDL::Transport tries to load one of the following classes:
|
||||
|
||||
=over
|
||||
|
||||
=item * the class registered for the scheme via register()
|
||||
|
||||
=item * the SOAP::Lite class matching the scheme
|
||||
|
||||
=item * the SOAP::WSDL class matching the scheme
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 register
|
||||
|
||||
SOAP::WSDL::Transport->register('https', 'MyWickedTransport');
|
||||
|
||||
Globally registers a class for use as transport class.
|
||||
|
||||
=head2 proxy
|
||||
|
||||
$trans->proxy('http://soap-wsdl.sourceforge.net');
|
||||
|
||||
Sets the proxy (endpoint).
|
||||
|
||||
Returns the transport for this protocol.
|
||||
|
||||
=head2 set_transport
|
||||
|
||||
Sets the current transport object.
|
||||
|
||||
=head2 get_transport
|
||||
|
||||
Gets the current transport object.
|
||||
|
||||
=head1 WRITING YOUR OWN TRANSPORT CLASS
|
||||
|
||||
=head2 Registering a transport class
|
||||
|
||||
Transport classes must be registered with SOAP::WSDL::Factory::Transport.
|
||||
|
||||
This is done by executing the following code where $scheme is the URL scheme
|
||||
the class should be used for, and $module is the class' module name.
|
||||
|
||||
SOAP::WSDL::Factory::Transport->register( $scheme, $module);
|
||||
|
||||
To auto-register your transport class on loading, execute register() in your
|
||||
tranport class (see L<SYNOPSIS|SYNOPSIS> above).
|
||||
|
||||
Multiple protocols ore multiple classes are registered by multiple calls to
|
||||
register().
|
||||
|
||||
=head2 Transport plugin package layout
|
||||
|
||||
You may only use transport classes whose name is either
|
||||
the module name or the module name with '::Client' appended.
|
||||
|
||||
=head2 Methods to implement
|
||||
|
||||
Transport classes must implement the interface required for SOAP::Lite
|
||||
transport classes (see L<SOAP::Lite::Transport> for details,
|
||||
L<SOAP::WSDL::Transport::HTTP|SOAP::WSDL::Transport::HTTP> for an example).
|
||||
|
||||
To provide this interface, transport modules must implement the following
|
||||
methods:
|
||||
|
||||
=over
|
||||
|
||||
=item * new
|
||||
|
||||
=item * send_receive
|
||||
|
||||
Dispatches a request and returns the content of the response.
|
||||
|
||||
=item * code
|
||||
|
||||
Returns the status code of the last send_receive call (if any).
|
||||
|
||||
=item * message
|
||||
|
||||
Returns the status message of the last send_receive call (if any).
|
||||
|
||||
=item * status
|
||||
|
||||
Returns the status of the last send_receive call (if any).
|
||||
|
||||
=item * is_success
|
||||
|
||||
Returns true after a send_receive was successful, false if it was not.
|
||||
|
||||
=back
|
||||
|
||||
SOAP::Lite requires transport modules to pack client and server
|
||||
classes in one file, and to follow this naming scheme:
|
||||
|
||||
Module name:
|
||||
"SOAP::Transport::" . uc($scheme)
|
||||
|
||||
Client class (additional package in module):
|
||||
"SOAP::Transport::" . uc($scheme) . "::Client"
|
||||
|
||||
Server class (additional package in module):
|
||||
"SOAP::Transport::" . uc($scheme) . "::Client"
|
||||
|
||||
SOAP::WSDL does not require you to follow these restrictions.
|
||||
|
||||
There is only one restriction in SOAP::WSDL:
|
||||
|
||||
You may only use transport classes whose name is either the module name or
|
||||
the module name with '::Client' appended.
|
||||
|
||||
SOAP::WSDL will try to instantiate an object of your transport class with
|
||||
'::Client' appended to allow using transport classes written for SOAP::Lite.
|
||||
|
||||
This may lead to errors when a different module with the name of your
|
||||
transport module suffixed with ::Client is also loaded.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 304 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Transport.pm 304 2007-10-02 20:07:21Z kutterma $
|
||||
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Transport.pm $
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,49 @@
|
||||
package SOAP::WSDL::Generator::Template;
|
||||
use strict;
|
||||
use Template;
|
||||
use Class::Std::Storable;
|
||||
|
||||
our $VERSION='2.00_17';
|
||||
|
||||
my %tt_of :ATTR(:get<tt>);
|
||||
my %definitions_of :ATTR(:name<definitions> :default<()>);
|
||||
my %interface_prefix_of :ATTR(:name<interface_prefix> :default<MyInterfaces>);
|
||||
my %typemap_prefix_of :ATTR(:name<typemap_prefix> :default<MyTypemaps>);
|
||||
my %type_prefix_of :ATTR(:name<type_prefix> :default<MyTypes>);
|
||||
my %element_prefix_of :ATTR(:name<element_prefix> :default<MyElements>);
|
||||
my %INCLUDE_PATH_of :ATTR(:name<INCLUDE_PATH> :default<()>);
|
||||
my %EVAL_PERL_of :ATTR(:name<EVAL_PERL> :default<0>);
|
||||
my %RECURSION_of :ATTR(:name<RECURSION> :default<0>);
|
||||
my %OUTPUT_PATH_of :ATTR(:name<OUTPUT_PATH> :default<.>);
|
||||
|
||||
sub START {
|
||||
my ($self, $ident, $arg_ref) = @_;
|
||||
}
|
||||
|
||||
sub _process :PROTECTED {
|
||||
my ($self, $template, $arg_ref, $output) = @_;
|
||||
my $ident = ident $self;
|
||||
my $tt = $tt_of{$ident} ||= Template->new(
|
||||
DEBUG => 1,
|
||||
EVAL_PERL => $EVAL_PERL_of{ $ident },
|
||||
RECURSION => $RECURSION_of{ $ident },
|
||||
INCLUDE_PATH => $INCLUDE_PATH_of{ $ident },
|
||||
OUTPUT_PATH => $OUTPUT_PATH_of{ $ident },
|
||||
);
|
||||
$tt->process( $template,
|
||||
{
|
||||
definitions => $self->get_definitions,
|
||||
interface_prefix => $self->get_interface_prefix,
|
||||
type_prefix => $self->get_type_prefix,
|
||||
typemap_prefix => $self->get_typemap_prefix,
|
||||
TYPE_PREFIX => $self->get_type_prefix,
|
||||
element_prefix => $self->get_element_prefix,
|
||||
NO_POD => delete $arg_ref->{ NO_POD } ? 1 : 0 ,
|
||||
%{ $arg_ref }
|
||||
},
|
||||
$output)
|
||||
or die $tt->error();
|
||||
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,135 @@
|
||||
package SOAP::WSDL::Generator::Template::XSD;
|
||||
use strict;
|
||||
use Template;
|
||||
use Class::Std::Storable;
|
||||
use File::Basename;
|
||||
use File::Spec;
|
||||
|
||||
use SOAP::WSDL::Generator::Visitor::Typemap;
|
||||
use SOAP::WSDL::Generator::Visitor::Typelib;
|
||||
use base qw(SOAP::WSDL::Generator::Template);
|
||||
|
||||
my %output_of :ATTR(:name<output> :default<()>);
|
||||
my %typemap_of :ATTR(:name<typemap> :default<({})>);
|
||||
|
||||
sub BUILD {
|
||||
my ($self, $ident, $arg_ref) = @_;
|
||||
$self->set_EVAL_PERL(1);
|
||||
$self->set_RECURSION(1);
|
||||
$self->set_INCLUDE_PATH( exists $arg_ref->{INCLUDE_PATH}
|
||||
? $arg_ref->{INCLUDE_PATH}
|
||||
: File::Spec->rel2abs( dirname __FILE__ ). '/XSD/'
|
||||
);
|
||||
}
|
||||
|
||||
sub generate {
|
||||
my $self = shift;
|
||||
$self->generate_typelib();
|
||||
$self->generate_interface();
|
||||
$self->generate_typemap();
|
||||
}
|
||||
|
||||
sub generate_typelib {
|
||||
my ($self) = @_;
|
||||
|
||||
# $output_of{ ident $self } = "";
|
||||
|
||||
my @schema = @{ $self->get_definitions()->first_types()->get_schema() };
|
||||
for my $type (map { @{ $_->get_type() } , @{ $_->get_element() } } @schema[1..$#schema] ) {
|
||||
$type->_accept( $self );
|
||||
}
|
||||
|
||||
# return $output_of{ ident $self };
|
||||
|
||||
}
|
||||
|
||||
sub generate_interface {
|
||||
my $self = shift;
|
||||
my $ident = ident $self;
|
||||
my $arg_ref = shift;
|
||||
my $tt = $self->get_tt();
|
||||
for my $service (@{ $self->get_definitions->get_service }) {
|
||||
for my $port (@{ $service->get_port() }) {
|
||||
# Skip ports without (known) address
|
||||
next if not $port->first_address;
|
||||
next if not $port->first_address->isa('SOAP::WSDL::SOAP::Address');
|
||||
|
||||
my $output = $arg_ref->{ output }
|
||||
? $arg_ref->{ output }
|
||||
: $self->_generate_filename( $self->get_interface_prefix(), $service->get_name(), $port->get_name );
|
||||
|
||||
$self->_process('Interface.tt',
|
||||
{
|
||||
service => $service,
|
||||
port => $port,
|
||||
NO_POD => $arg_ref->{ NO_POD } ? 1 : 0 ,
|
||||
},
|
||||
$output);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub generate_typemap {
|
||||
my ($self, $arg_ref) = @_;
|
||||
|
||||
my $visitor = SOAP::WSDL::Generator::Visitor::Typemap->new({
|
||||
type_prefix => $self->get_type_prefix(),
|
||||
element_prefix => $self->get_element_prefix(),
|
||||
definitions => $self->get_definitions(),
|
||||
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',
|
||||
%{ $typemap_of{ident $self }},
|
||||
}
|
||||
});
|
||||
for my $service (@{ $self->get_definitions->get_service }) {
|
||||
$visitor->visit_Service( $service );
|
||||
my $output = $arg_ref->{ output }
|
||||
? $arg_ref->{ output }
|
||||
: $self->_generate_filename( $self->get_typemap_prefix(), $service->get_name() );
|
||||
$self->_process('Typemap.tt',
|
||||
{
|
||||
service => $service,
|
||||
typemap => $visitor->get_typemap(),
|
||||
NO_POD => $arg_ref->{ NO_POD } ? 1 : 0 ,
|
||||
},
|
||||
$output);
|
||||
}
|
||||
}
|
||||
|
||||
sub _generate_filename :PRIVATE {
|
||||
my ($self, @parts) = @_;
|
||||
my $name = join '::', @parts;
|
||||
$name =~s{ \. }{::}xmsg;
|
||||
$name =~s{ :: }{/}xmsg;
|
||||
return "$name.pm";
|
||||
}
|
||||
|
||||
sub visit_XSD_Element {
|
||||
my ($self, $element) = @_;
|
||||
my $output = defined $output_of{ ident $self }
|
||||
? $output_of{ ident $self }
|
||||
: $self->_generate_filename( $self->get_element_prefix(), $element->get_name() );
|
||||
$self->_process('element.tt', { element => $element } , $output);
|
||||
}
|
||||
|
||||
sub visit_XSD_SimpleType {
|
||||
my ($self, $type) = @_;
|
||||
my $output = defined $output_of{ ident $self }
|
||||
? $output_of{ ident $self }
|
||||
: $self->_generate_filename( $self->get_type_prefix(), $type->get_name() );
|
||||
$self->_process('simpleType.tt', { simpleType => $type } , $output);
|
||||
}
|
||||
|
||||
sub visit_XSD_ComplexType {
|
||||
my ($self, $type) = @_;
|
||||
my $output = defined $output_of{ ident $self }
|
||||
? $output_of{ ident $self }
|
||||
: $self->_generate_filename( $self->get_type_prefix(), $type->get_name() );
|
||||
$self->_process('complexType.tt', { complexType => $type } , $output);
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,69 @@
|
||||
package [% interface_prefix %]::[% service.get_name %]::[% port.get_name %];
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Client::Base);
|
||||
|
||||
sub START {
|
||||
$_[0]->set_proxy('[% port.first_address.get_location %]') if not $_[2]->{proxy};
|
||||
$_[0]->set_class_resolver('[% typemap_prefix %]::[% service.get_name %]')
|
||||
if not $_[2]->{class_resolver};
|
||||
}
|
||||
|
||||
[% binding = definitions.find_binding( port.expand( port.get_binding ) );
|
||||
FOREACH operation = binding.get_operation;
|
||||
%][% INCLUDE Interface/Operation.tt %]
|
||||
[%
|
||||
END;
|
||||
%]
|
||||
|
||||
1;
|
||||
|
||||
[% IF NO_POD; STOP; END %]
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
|
||||
[% interface_prefix %]::[% service.get_name %]::[% port.get_name %] - SOAP Interface for the [% service.get_name %] Web Service
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP Interface for the [% service.get_name %] web service
|
||||
located at [% port.first_address.get_location %].
|
||||
|
||||
=head1 SERVICE [% service.get_name %]
|
||||
|
||||
[% service.get_documentation %]
|
||||
|
||||
=head2 Port [% port.get_name %]
|
||||
|
||||
[% port.get_documentation %]
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 General methods
|
||||
|
||||
=head3 new
|
||||
|
||||
Constructor.
|
||||
|
||||
All arguments are forwarded to L<SOAP::WSDL::Client|SOAP::WSDL::Client>.
|
||||
|
||||
=head2 SOAP Service methods
|
||||
|
||||
[% INCLUDE Interface/POD/method_info.tt %]
|
||||
|
||||
|
||||
[% FOREACH operation = binding.get_operation;
|
||||
%][% INCLUDE Interface/POD/Operation.tt %]
|
||||
[% END %]
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Generated by SOAP::WSDL on [% PERL %]print scalar localtime() [% END %]
|
||||
|
||||
=pod
|
||||
@@ -0,0 +1,65 @@
|
||||
[% RETURN IF NOT item;
|
||||
type = definitions.find_portType( binding.expand( binding.get_type ) );
|
||||
port_op = type.find_operation( definitions.get_targetNamespace, operation.get_name );
|
||||
message = definitions.find_message( port_op.first_input.expand( port_op.first_input.get_message ) );
|
||||
part_from = message.get_part;
|
||||
PERL %]
|
||||
my $item = $stash->{ item };
|
||||
my $def = $stash->{ definitions };
|
||||
my $part_from = $stash->{ part_from };
|
||||
my $type_prefix = $stash->{ type_prefix };
|
||||
my $element_prefix = $stash->{ element_prefix };
|
||||
|
||||
my @body_part_from = split m{\s}, $item->get_parts;
|
||||
|
||||
my @parts;
|
||||
if (@body_part_from) {
|
||||
@parts = map {
|
||||
my $part = $_;
|
||||
(grep {
|
||||
my ($ns, $lname) = $def->expand( $_ );
|
||||
($lname eq $part->get_name)
|
||||
} @body_part_from
|
||||
)
|
||||
? do {
|
||||
my $name;
|
||||
($name = $part->get_element)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
$element_prefix . '::' . $name;
|
||||
}
|
||||
: ($name = $part->get_type)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
$type_prefix . '::' . $name;
|
||||
}
|
||||
: die "input must have either type or element"
|
||||
}
|
||||
: ()
|
||||
} @{ $part_from };
|
||||
}
|
||||
else {
|
||||
@parts = map {
|
||||
my $part = $_;
|
||||
my $name;
|
||||
($name = $part->get_element)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
"$element_prefix\::$name"
|
||||
}
|
||||
: ($name = $part->get_type)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
"$type_prefix\::$name"
|
||||
}
|
||||
: die "input must have either type or element";
|
||||
} @{ $part_from };
|
||||
}
|
||||
$stash->{ parts } = \@parts;
|
||||
|
||||
[% END;
|
||||
%]
|
||||
'use' => '[% item.get_use %]',
|
||||
namespace => '[% item.get_namespace %]',
|
||||
encodingStyle => '[% item.get_encodingStyle %]',
|
||||
parts => [qw( [% parts.join(' ') %] )],
|
||||
@@ -0,0 +1,38 @@
|
||||
[%
|
||||
RETURN IF NOT item;
|
||||
message_name = item.get_message;
|
||||
IF NOT message_name;
|
||||
THROW BAD_WSDL "missing <message> attribute in header for operation ${operation.get_name}";
|
||||
END;
|
||||
message = definitions.find_message( item.expand( message_name ) );
|
||||
PERL %]
|
||||
my $message = $stash->{ message };
|
||||
my $item = $stash->{ item };
|
||||
my $def = $stash->{ definitions };
|
||||
my $type_prefix = $stash->{ type_prefix };
|
||||
my $element_prefix = $stash->{ element_prefix };
|
||||
my ($ns, $lname) = $def->expand( $item->get_part() );
|
||||
my ($part) = grep {
|
||||
$_->get_name eq $lname
|
||||
&& $_->get_targetNamespace eq $ns } @{ $message->get_part( ) };
|
||||
my $part_class = do {
|
||||
my $name;
|
||||
($name = $part->get_element)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
$element_prefix . '::' . $name;
|
||||
}
|
||||
: ($name = $part->get_type)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
$type_prefix . '::' . $name;
|
||||
}
|
||||
: die "input must have either type or element"
|
||||
};
|
||||
$stash->{ part_class } = $part_class;
|
||||
[% END;
|
||||
%]
|
||||
'use' => '[% item.get_use %]',
|
||||
namespace => '[% item.get_namespace %]',
|
||||
encodingStyle => '[% item.get_encodingStyle %]',
|
||||
parts => [qw( [% part_class %] )],
|
||||
@@ -0,0 +1,17 @@
|
||||
sub [% operation.get_name %] {
|
||||
my ($self, $body, $header) = @_;
|
||||
return $self->SUPER::call({
|
||||
operation => '[% operation.get_name %]',
|
||||
soap_action => '[% operation.first_operation.get_soapAction %]',
|
||||
style => '[% operation.get_style || binding.get_style %]',
|
||||
body => {
|
||||
[% INCLUDE Interface/Body.tt( item = operation.first_input.first_body ); %]
|
||||
},
|
||||
header => {
|
||||
[% INCLUDE Interface/Header.tt( item = operation.first_input.first_header ); %]
|
||||
},
|
||||
headerfault => {
|
||||
[% INCLUDE Interface/Header.tt( item = operation.first_input.first_headerfault ); %]
|
||||
}
|
||||
}, $body, $header);
|
||||
}
|
||||
@@ -0,0 +1,13 @@
|
||||
|
||||
[% INDENT; %][% element.get_name %] => [%-
|
||||
IF (element.get_ref);
|
||||
element = element.get_ref();
|
||||
END;
|
||||
IF (type_name = element.get_type);
|
||||
INCLUDE Interface/POD/Type.tt(type = definitions.first_types.find_type( element.expand(type_name) ) );
|
||||
ELSIF (type = element.first_complexType);
|
||||
INCLUDE Interface/POD/Type.tt(type = type );
|
||||
ELSIF (type = element.first_simpleType);
|
||||
INCLUDE Interface/POD/Type.tt(type = type );
|
||||
END;
|
||||
%]
|
||||
@@ -0,0 +1,9 @@
|
||||
[%
|
||||
message_name = port_op.first_input.get_message();
|
||||
# message_name;
|
||||
|
||||
part_from = definitions.find_message( port_op.first_input.expand( message_name ) ).get_part;
|
||||
FOREACH part = part_from;
|
||||
INCLUDE Interface/POD/Part.tt(part = part);
|
||||
END;
|
||||
%]
|
||||
@@ -0,0 +1,8 @@
|
||||
=head3 [% operation.get_name %]
|
||||
|
||||
[% type = definitions.find_portType( binding.expand( binding.get_type ) );
|
||||
port_op = type.find_operation( definitions.get_targetNamespace, operation.get_name );
|
||||
port_op.get_documentation %]
|
||||
|
||||
$interface->[% operation.get_name %]([% INCLUDE Interface/POD/Message.tt %] );
|
||||
|
||||
@@ -0,0 +1,7 @@
|
||||
[% element = definitions.first_types.find_element( part.expand( part.get_element ) );
|
||||
#element.get_name();
|
||||
#element;
|
||||
#STOP;
|
||||
type = element.first_complexType || element.first_simpleType || definitions.first_types.find_type(
|
||||
element.expand( element.get_type ) );
|
||||
INCLUDE Interface/POD/Type.tt;%],
|
||||
@@ -0,0 +1,7 @@
|
||||
[%- indent = ' ';
|
||||
IF type.isa('SOAP::WSDL::XSD::ComplexType');
|
||||
INCLUDE complexType/POD/structure.tt(complexType = type);
|
||||
ELSE;
|
||||
INCLUDE simpleType/POD/structure.tt(simpleType = type);
|
||||
END;
|
||||
indent.replace('\s{2}$',''); %]
|
||||
@@ -0,0 +1,7 @@
|
||||
Method synopsis is displayed with hash refs as parameters.
|
||||
|
||||
The commented class names in the method's parameters denote that objects
|
||||
of the corresponding class can be passed instead of the marked hash ref.
|
||||
|
||||
You may pass any combination of objects, hash and list refs to these
|
||||
methods, as long as you meet the structure.
|
||||
@@ -0,0 +1,28 @@
|
||||
package [% typemap_prefix %]::[% service.get_name.replace('\.','::') %];
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our [% USE Dumper(varname = 'typemap_'); Dumper.dump( typemap ) %];
|
||||
|
||||
sub get_class {
|
||||
my $name = join '/', @{ $_[1] };
|
||||
exists $typemap_1->{ $name } or die "Cannot resolve $name via " . __PACKAGE__;
|
||||
return $typemap_1->{ $name };
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
[% typemap_prefix %]::[% service.get_name.replace('\.','::') %]; - typemap for ::[% service.get_name %];
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Typemap created by SOAP::WSDL for map-based SOAP message parsers.
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,6 @@
|
||||
[% type_name = node.expand( type );
|
||||
IF (type_name.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::[% type_name.1 %]
|
||||
[% ELSE -%]
|
||||
[% type_prefix %]::[% type_name.1 %]
|
||||
[% END -%]
|
||||
@@ -0,0 +1,44 @@
|
||||
package [% type_prefix %]::[% complexType.get_name %];
|
||||
use strict;
|
||||
use warnings;
|
||||
[% INCLUDE complexType/contentModel.tt %]
|
||||
[%#
|
||||
# Don't include any perl source here - there may be sub-packages...
|
||||
#-%]
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
[% type_prefix %]::[% complexType.get_name %]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Perl data type class for the XML Schema defined complextype
|
||||
[% complexType.get_name %] from the namespace [% complexType.get_targetNamespace %].
|
||||
|
||||
=head2 PROPERTIES
|
||||
|
||||
The following properties may be accessed using get_PROPERTY / set_PROPERTY
|
||||
methods:
|
||||
|
||||
[% FOREACH element = complexType.get_element -%]
|
||||
[% element.get_name %]
|
||||
[% END %]
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 new
|
||||
|
||||
Constructor. The following data structure may be passed to new():
|
||||
|
||||
[% indent = ' '; INCLUDE complexType/POD/structure.tt %]
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Generated by SOAP::WSDL
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,7 @@
|
||||
[% indent %]{
|
||||
[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% END %]
|
||||
[%- indent = indent _ ' ';
|
||||
FOREACH element = complexType.get_element %]
|
||||
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
|
||||
[% END %]
|
||||
[% indent.replace('\s{2}$', ''); %]}
|
||||
@@ -0,0 +1,9 @@
|
||||
[% indent %]{
|
||||
[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% END %]
|
||||
[%- indent = indent _ ' ' %]
|
||||
[% indent %]# One of the following elements.
|
||||
[% indent %]# No occurance checks yet, so be sure to pass just one...
|
||||
[%- FOREACH element = complexType.get_element %]
|
||||
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
|
||||
[% END %]
|
||||
[% indent.replace('\s{2}$', ''); %]}
|
||||
@@ -0,0 +1,9 @@
|
||||
[% IF (complexType.get_variety == 'restriction');
|
||||
INCLUDE complexType/POD/restriction.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'sequence');
|
||||
THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType complexContent extension not implemented yet";
|
||||
ELSE;
|
||||
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
|
||||
END;
|
||||
|
||||
%]
|
||||
@@ -0,0 +1,7 @@
|
||||
[% indent %]{
|
||||
[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% END %]
|
||||
[%- indent = indent _ ' ';
|
||||
FOREACH element = complexType.get_element %]
|
||||
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
|
||||
[% END %]
|
||||
[% indent.replace('\s{2}$', ''); %]}
|
||||
@@ -0,0 +1,13 @@
|
||||
[% IF (complexType.get_variety == 'all');
|
||||
INCLUDE complexType/POD/all.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'sequence');
|
||||
INCLUDE complexType/POD/all.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'group');
|
||||
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType group not implemented yet";
|
||||
ELSIF (complexType.get_variety == 'choice');
|
||||
INCLUDE complexType/POD/choice.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_contentModel == 'simpleContent');
|
||||
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType simpleContent not implemented yet";
|
||||
ELSIF (complexType.get_contentModel == 'complexContent');
|
||||
INCLUDE complexType/POD/complexContent.tt(complexType = complexType);
|
||||
END %]
|
||||
@@ -0,0 +1,46 @@
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
|
||||
|
||||
{ # BLOCK to scope variables
|
||||
[%
|
||||
atomic_types = [];
|
||||
|
||||
FOREACH element = complexType.get_element %]
|
||||
my %[% element.get_name %]_of :ATTR(:get<[% element.get_name %]>);
|
||||
[%- END %]
|
||||
|
||||
__PACKAGE__->_factory(
|
||||
[ qw([% FOREACH element = complexType.get_element %]
|
||||
[% element.get_name -%]
|
||||
[% END %]
|
||||
) ],
|
||||
{
|
||||
[% FOREACH element = complexType.get_element -%]
|
||||
[% element.get_name %] => \%[% element.get_name %]_of,
|
||||
[% END -%]
|
||||
},
|
||||
{
|
||||
[% FOREACH element = complexType.get_element;
|
||||
IF (type = element.get_type);
|
||||
element_type = complexType.expand( type );
|
||||
IF (element_type.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
|
||||
[% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% element_type.1 %]',
|
||||
[% ELSE -%]
|
||||
[% element.get_name %] => '[% type_prefix %]::[% element_type.1 %]',
|
||||
[% END;
|
||||
ELSE;
|
||||
IF (element.first_simpleType);
|
||||
atomic_types.push( element.first_simpleType );
|
||||
ELSIF (element.first_simpleType);
|
||||
atomic_types.push( element.first_simpleType );
|
||||
ELSE;
|
||||
THROW NOT_IMPLEMENTED , "atomic types in complexType elements not supported yet";
|
||||
END; %]
|
||||
[% element.get_name %] => '[% type_prefix %]::[% complexType.get_name %]::_[% element.get_name %]',
|
||||
[% END;
|
||||
END -%]
|
||||
}
|
||||
);
|
||||
|
||||
} # end BLOCK
|
||||
|
||||
[% INCLUDE complexType/atomicTypes.tt(atomic_types = atomic_types) %]
|
||||
@@ -0,0 +1,19 @@
|
||||
|
||||
[% FOREACH type = atomic_types; %]
|
||||
|
||||
package [% type_prefix %]::[% complexType.get_name %]::_[% element.get_name %];
|
||||
use strict;
|
||||
use warnings;
|
||||
{
|
||||
[% IF ( type.isa('SOAP::WSDL::XSD::ComplexType') );
|
||||
INCLUDE complexType/contentModel.tt(complexType = type );
|
||||
ELSIF ( type.isa('SOAP::WSDL::XSD::SimpleType') );
|
||||
INCLUDE simpleType/contentModel.tt(simpleType = type );
|
||||
ELSE;
|
||||
PERL; %] die $stash->{ type }->_DUMP [% END;
|
||||
THROW UNKNOWN, "neither complex nor simple type - don't know what to do";
|
||||
END
|
||||
%]
|
||||
}
|
||||
|
||||
[% END %]
|
||||
@@ -0,0 +1,8 @@
|
||||
[% IF (complexType.get_variety == 'restriction');
|
||||
INCLUDE complexType/restriction.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'sequence');
|
||||
THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType complexContent extension not implemented yet";
|
||||
ELSE;
|
||||
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
|
||||
END;
|
||||
%]
|
||||
@@ -0,0 +1,15 @@
|
||||
[% IF (complexType.get_variety == 'all');
|
||||
INCLUDE complexType/all.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'sequence');
|
||||
INCLUDE complexType/all.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'group');
|
||||
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType group not implemented yet";
|
||||
ELSIF (complexType.get_variety == 'choice');
|
||||
INCLUDE complexType/all.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_contentModel == 'simpleContent');
|
||||
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType simpleContent not implemented yet";
|
||||
ELSIF (complexType.get_contentModel == 'complexContent');
|
||||
INCLUDE complexType/complexContent.tt(complexType = complexType);
|
||||
ELSE;
|
||||
THROW NOT_IMPLEMENTED, "Unknown content model ${ complexType.get_contentModel }";
|
||||
END %]
|
||||
@@ -0,0 +1,8 @@
|
||||
[% IF (base=complexType.get_base);
|
||||
base_name=complexType.expand(base);
|
||||
-%]
|
||||
use base qw([% type_prefix %]::[% base_name.1 %]);
|
||||
[%
|
||||
ELSE;
|
||||
THROW NOT_IMPLEMENTED, "restriction without base not supported";
|
||||
END %]
|
||||
@@ -0,0 +1,71 @@
|
||||
package [% element_prefix %]::[% element.get_name %];
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
{ # BLOCK to scope variables
|
||||
|
||||
sub get_xmlns { '[% element.get_targetNamespace %]' }
|
||||
|
||||
__PACKAGE__->__set_name('[% element.get_name %]');
|
||||
__PACKAGE__->__set_nillable([% element.get_nillable %]);
|
||||
__PACKAGE__->__set_minOccurs([% element.get_minOccurs %]);
|
||||
__PACKAGE__->__set_maxOccurs([% element.get_maxOccurs %]);
|
||||
__PACKAGE__->__set_ref([% IF element.get_ref; %]'[% element.get_ref %]'[% END %]);
|
||||
|
||||
[%- IF (type = element.get_type); -%]
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
[% INCLUDE _type_class.tt( type = type, node = element ) %]
|
||||
);
|
||||
[%- ELSIF (ref = element.get_ref); -%]
|
||||
# element ref="[% ref %]"
|
||||
use base qw(
|
||||
[% element_prefix %]::[% ref.split(':').1 %]
|
||||
);
|
||||
[%- ELSIF (simpleType = element.first_simpleType) %]
|
||||
# atomic simpleType: <element><simpleType
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
);
|
||||
[% INCLUDE simpleType/contentModel.tt %]
|
||||
[% ELSIF (complexType = element.first_complexType) %]
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType
|
||||
);
|
||||
[% INCLUDE complexType/contentModel.tt;
|
||||
END %]
|
||||
|
||||
|
||||
} # end of BLOCK
|
||||
1;
|
||||
|
||||
# __END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
[% element_prefix %]::[% element.get_name %]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Perl data type class for the XML Schema defined element
|
||||
[% element.get_name %] from the namespace [% element.get_targetNamespace %].
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 new
|
||||
|
||||
my $element = [% element_prefix %]::[% element.get_name %]->new($data);
|
||||
|
||||
Constructor. The following data structure may be passed to new():
|
||||
|
||||
[% indent = ' '; INCLUDE element/POD/structure.tt; %]
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Generated by SOAP::WSDL
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,30 @@
|
||||
[%- IF (name = element.get_type);
|
||||
type_name = element.expand(name);
|
||||
IF (type_name.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
|
||||
$some_value, # [% type_name.1 %]
|
||||
[%-
|
||||
RETURN;
|
||||
ELSIF (type = definitions.first_types.find_type( type_name ));
|
||||
IF (type.isa('SOAP::WSDL::XSD::ComplexType') );
|
||||
INCLUDE complexType/POD/structure.tt(complexType = type);
|
||||
RETURN;
|
||||
ELSE;
|
||||
INCLUDE simpleType/POD/structure.tt(simpleType = type);
|
||||
END;
|
||||
RETURN;
|
||||
END;
|
||||
THROW NOT_FOUND, "no type found for {${type_name.0}}${type_name.1}";
|
||||
ELSIF (ref = element.get_ref);
|
||||
ref_element = definitions.first_types.find_element( element.expand( ref ) );
|
||||
INCLUDE element/POD/structure.tt(element = ref_element);
|
||||
RETURN;
|
||||
ELSIF (type = element.first_simpleType);
|
||||
INCLUDE simpleType/POD/structure.tt(simpleType = type);
|
||||
RETURN;
|
||||
ELSIF (type = element.first_complexType);
|
||||
INCLUDE complexType/POD/structure.tt(complexType = type);
|
||||
ELSE;
|
||||
THROW NOT_FOUND, "no type found for ${element.get_name}";
|
||||
%]
|
||||
NO TYPE FOUND FOR ELEMENT [% element.get_name %]
|
||||
[% END -%]
|
||||
@@ -0,0 +1,56 @@
|
||||
package [% type_prefix %]::[% simpleType.get_name %];
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub get_xmlns { '[% simpleType.get_targetNamespace %]'};
|
||||
|
||||
[% INCLUDE simpleType/contentModel.tt %]
|
||||
[%#
|
||||
# Don't include any perl source here - there may be sub-packages...
|
||||
#-%]
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 [% type_prefix %]::[% simpleType.get_name %]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Perl data type class for the XML Schema defined simpleType
|
||||
[% simpleType.get_name %] from the namespace [% simpleType.get_targetNamespace %].
|
||||
|
||||
[% IF (simpleType.get_variety == 'list');
|
||||
INCLUDE simpleType/POD/list.tt;
|
||||
ELSIF (simpleType.get_variety == 'restriction');
|
||||
INCLUDE simpleType/POD/restriction.tt;
|
||||
ELSE;
|
||||
THROW NOT_IMPLEMENTED "simpleType union not implemented yet in $simpleType.get_name";
|
||||
END %]
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 new
|
||||
|
||||
Constructor.
|
||||
|
||||
=head2 get_value / set_value
|
||||
|
||||
Getter and setter for the simpleType's value.
|
||||
|
||||
=head1 OVERLOADING
|
||||
|
||||
Depending on the simple type's base type, the following operations are overloaded
|
||||
|
||||
Stringification
|
||||
Numerification
|
||||
Boolification
|
||||
|
||||
Check L<SOAP::WSDL::XSD::Typelib::Builtin> for more information.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Generated by SOAP::WSDL
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,20 @@
|
||||
This clase is derived from
|
||||
[%-
|
||||
IF (name = simpleType.get_itemType);
|
||||
type_name = simpleType.expand( name );
|
||||
IF (type_name.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::[% type_name.1 %]
|
||||
[% ELSE -%]
|
||||
[% type_prefix %]::[% type_name.1 %]
|
||||
[% END;
|
||||
ELSE;
|
||||
# THROW NOT_IMPLEMENTED "atomic simpleType list not implemented yet in $simpleType.get_name";
|
||||
%] a atomic base type. Unfortunately there's no documenatation generation for atomic base types yet. [%
|
||||
END -%].
|
||||
|
||||
You may pass the following structure to new():
|
||||
|
||||
[ $value_1, .. $value_n ]
|
||||
|
||||
All elements of the list must be of the class' base type (or
|
||||
valid arguments to it's constructor).
|
||||
@@ -0,0 +1,17 @@
|
||||
This clase is derived from
|
||||
[%-
|
||||
IF (name = simpleType.get_base);
|
||||
type_name = simpleType.expand( name );
|
||||
IF (type_name.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::[% type_name.1 %]
|
||||
[% ELSE -%]
|
||||
[% type_prefix %]::[% type_name.1 %]
|
||||
[% END;
|
||||
ELSE;
|
||||
# THROW NOT_IMPLEMENTED "atomic simpleType restriction not implemented yet in $simpleType.get_name";
|
||||
%] a atomic base type. Unfortunately there's no documenatation generation for atomic base types yet. [%
|
||||
END -%]
|
||||
. SOAP::WSDL's schema implementation does not validate data, so you can use it exactly
|
||||
like it's base type.
|
||||
|
||||
# Description of restrictions not implemented yet.
|
||||
@@ -0,0 +1 @@
|
||||
$some_value, # [% IF (simpleType.get_name); simpleType.get_name; ELSE %]atomic[% END %]
|
||||
@@ -0,0 +1,3 @@
|
||||
# atomic simple type.
|
||||
|
||||
[% INCLUDE simpleType/contentModel.tt(simpleType = type ); %]
|
||||
@@ -0,0 +1,7 @@
|
||||
[% IF (simpleType.get_variety == 'list');
|
||||
INCLUDE simpleType/list.tt(simpleType = simpleType);
|
||||
ELSIF (simpleType.get_variety == 'restriction');
|
||||
INCLUDE simpleType/restriction.tt(type = simpleType);
|
||||
ELSE;
|
||||
THROW NOT_IMPLEMENTED "${ element.get_name } - ${ simpleType.get_variety } not supported yet";
|
||||
END %]
|
||||
@@ -0,0 +1,21 @@
|
||||
# list derivation
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list
|
||||
[%
|
||||
IF (name = simpleType.get_itemType);
|
||||
type_name = simpleType.expand( name );
|
||||
IF (type_name.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::[% type_name.1 %]
|
||||
);
|
||||
[% ELSE -%]
|
||||
[% type_prefix %]::[% type_name.1 %]
|
||||
);
|
||||
[% END;
|
||||
ELSIF (type = simpleType.first_simpleType); %]
|
||||
);
|
||||
|
||||
[% INCLUDE simpleType/atomicType.tt(type = type);
|
||||
ELSE; PERL %]die $stash->{simpleType}._DUMP [% END;
|
||||
THROW UNKNOWN , "No list itemTape and no atomic simpleType - don't know what to do";
|
||||
END %]
|
||||
|
||||
@@ -0,0 +1,9 @@
|
||||
# derivation by restriction
|
||||
[% IF (base = simpleType.get_base) -%]
|
||||
use base qw(
|
||||
[% INCLUDE _type_class.tt(type = base, node=simpleType) %]);
|
||||
[% ELSIF (type = simpleType.first_simpleType() );
|
||||
INCLUDE simpleType/atomicType.tt(type = type);
|
||||
ELSE;
|
||||
THROW "neither base nor atomic type - don't know what to do" %]
|
||||
[% END %]
|
||||
@@ -0,0 +1,315 @@
|
||||
package SOAP::WSDL::Generator::Visitor;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
our $VERSION = '2.00_17';
|
||||
|
||||
my %definitions_of :ATTR(:name<definitions> :default<()>);
|
||||
my %type_prefix_of :ATTR(:name<type_prefix> :default<()>);
|
||||
my %element_prefix_of :ATTR(:name<element_prefix> :default<()>);
|
||||
|
||||
sub START {
|
||||
my ($self, $ident, $arg_ref) = @_;
|
||||
$type_prefix_of{ $ident } = 'MyType' if not exists
|
||||
$arg_ref->{ 'type_prefix' };
|
||||
$element_prefix_of{ $ident } = 'MyElement' if not exists
|
||||
$arg_ref->{ 'element_prefix' };
|
||||
|
||||
}
|
||||
|
||||
|
||||
# WSDL stuff
|
||||
sub visit_Definitions {}
|
||||
sub visit_Binding {}
|
||||
sub visit_Message {}
|
||||
sub visit_Operation {}
|
||||
sub visit_OpMessage {}
|
||||
sub visit_Part {}
|
||||
sub visit_Port {}
|
||||
sub visit_PortType {}
|
||||
sub visit_Service {}
|
||||
sub visit_SoapOperation {}
|
||||
sub visit_Types {}
|
||||
|
||||
# XML Schema stuff
|
||||
sub visit_XSD_Schema {}
|
||||
sub visit_XSD_ComplexType {}
|
||||
sub visit_XSD_Element {}
|
||||
sub visit_XSD_SimpleType {}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Generator::Visitor - SOAP::WSDL's Visitor-based Code Generator
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL featores a code generating facility. This code generation facility
|
||||
(in fact there are several of them) is implemented as Visitor to
|
||||
SOAP::WSDL::Base-derived objects.
|
||||
|
||||
=head2 The Visitor Pattern
|
||||
|
||||
The Visitor design pattern is one of the object oriented design pattern
|
||||
described by [GHJV1995].
|
||||
|
||||
A Visitor is an object implementing some behaviour for a fixed set of classes,
|
||||
whose implementation would otherwise need to be scattered accross those
|
||||
classes' implementations.
|
||||
|
||||
Visitors are usually combined with Iterators for traversing either a list or
|
||||
tree of objects.
|
||||
|
||||
A Visitor's methods are called using the so-called double dispatch technique.
|
||||
To allow double dispatching, the Visitor implements one method for every class
|
||||
ro be handled, whereas every class implements just one method (commonly named
|
||||
"access"), which does nothing more than calling a method on the reference
|
||||
given, with the self object as parameter.
|
||||
|
||||
If all this sounds strange, maybe an example helps. Imagine you had a list of
|
||||
person objects and wanted to print out a list of their names (or address
|
||||
stamps or everything elseyou like). This can easily be implemented with a
|
||||
Visitor:
|
||||
|
||||
package PersonVisitor;
|
||||
use Class::Std; # handles all basic stuff like constructors etc.
|
||||
|
||||
sub visit_Person {
|
||||
my ( $self, $object ) = @_;
|
||||
print "Person name is ", $object->get_name(), "\n";
|
||||
}
|
||||
|
||||
package Person;
|
||||
use Class::Std;
|
||||
my %name : ATTR(:name<name> :default<anonymous>);
|
||||
|
||||
sub accept { $_[1]->visit_Person( $_[0] ) }
|
||||
|
||||
package main;
|
||||
my @person_from = ();
|
||||
for (qw(Gamma Helm Johnson Vlissides)) {
|
||||
push @person_from, Person->new( { name => $_ } );
|
||||
}
|
||||
|
||||
my $visitor = PersonVisitor->new();
|
||||
for (@person_from) {
|
||||
$_->accept($visitor);
|
||||
}
|
||||
|
||||
# will print
|
||||
Person name is Gamma
|
||||
Person name is Helm
|
||||
Person name is Johnson
|
||||
Person name is Vlissides
|
||||
|
||||
While using this pattern for just printing a list may look a bit over-sized,
|
||||
but it may become handy if you need multiple output formats and different
|
||||
classes to operate on.
|
||||
|
||||
The main benefits using visitors are:
|
||||
|
||||
=over
|
||||
|
||||
=item * Grouping related behaviour in one class
|
||||
|
||||
Related behaviour for several classes can be grouped together in the Visitor
|
||||
class. The behaviour can easily be changed by changing the code in one class,
|
||||
instead of having to change all the visited classes.
|
||||
|
||||
=item * Cleaning up the data classes' implementations
|
||||
|
||||
If classes holding data also implement several different output formats or
|
||||
other (otherwise unrelated) behaviour, they tend to get bloated.
|
||||
|
||||
=item * Adding behaviour is easy
|
||||
|
||||
Swapping out the visitor class allows easy alterations of behaviour. So on a
|
||||
list of Persons, one Visitor may print address stamps, while another one prints
|
||||
out a phone number list.
|
||||
|
||||
=back
|
||||
|
||||
Of course, there are also drawbacks in the visitor pattern:
|
||||
|
||||
=over
|
||||
|
||||
=item * Changes in the visited classes are expensive
|
||||
|
||||
If one of the visited classes changes (or is added), all visitors must be
|
||||
updated to reflect this change. This may be rather expensive if classes change
|
||||
often.
|
||||
|
||||
=item * The visited classes must expose all data required
|
||||
|
||||
Visitors may need to use the internals of a class. This may result in fidelling
|
||||
with a object's internals, or a bloated interface in the visited class.
|
||||
|
||||
=back
|
||||
|
||||
Visitors are usually accompanied by a Iterator. The Iterator may be implemented
|
||||
in the visited classes, in the Visitor, or somewhere else (in the example it
|
||||
was somewhere else).
|
||||
|
||||
The Iterator decides which object to visit next.
|
||||
|
||||
=head2 Why SOAP::WSDL uses the Visitor pattern for Code Generation
|
||||
|
||||
Code generation in SOAP::WSDL means generating various artefacts:
|
||||
|
||||
=over
|
||||
|
||||
=item * Typemaps
|
||||
|
||||
For every WSDL definition, a Typemap is created. The Typemap is used later as
|
||||
an aid in parsing the SOAP XML messages.
|
||||
|
||||
=item * Type Classes
|
||||
|
||||
For every type defined in the WSDL's schema, a Type Class is generated.
|
||||
|
||||
These classes are instantiated later as a result of parsing SOAP XML messages.
|
||||
|
||||
=item * Interface Classes
|
||||
|
||||
For every service, a interface class is generated. This class is later used by
|
||||
programmers accessing the service
|
||||
|
||||
=item * Documentation
|
||||
|
||||
Both Type Classes and Interface Classes include documentation. Additional
|
||||
documentation may be generated as a hint for programmers, or later for
|
||||
mimicing .NET's .asmx example pages.
|
||||
|
||||
=back
|
||||
|
||||
All these behaviours could well (and has historically been) implemented in the
|
||||
classes holding the WSDL data. This made these classes rather bloated, and
|
||||
made it hard to change behaviour (like, supporting SOAP Headers,
|
||||
supporting atomic types and other features which were missing from early
|
||||
versions of SOAP::WSDL).
|
||||
|
||||
Implementing these behaviours in Visitor classes eases adding new behaviours,
|
||||
and reducing the incompletenesses still inherent in SOAP::WSDL's WSDL and XML
|
||||
schema implementation.
|
||||
|
||||
=head2 Implementation
|
||||
|
||||
=head3 accept
|
||||
|
||||
SOAP::WSDL::Base defines an accept method which expects a Visitor as only
|
||||
parameter.
|
||||
|
||||
The method visit_Foo_Bar is called on the visitor, whith the self object as
|
||||
parameter.
|
||||
|
||||
The actual method name is constructed this way:
|
||||
|
||||
=over
|
||||
|
||||
=item * SOAP::WSDL is stripped from the class name
|
||||
|
||||
=item * All remaining :: s are replaced by _
|
||||
|
||||
=back
|
||||
|
||||
Example:
|
||||
|
||||
When visiting a SOAP::WSDL::XSD::ComplexType object, the method
|
||||
visit_XSD_ComplexType is called on the visitor.
|
||||
|
||||
=head2 Writing your own visitor
|
||||
|
||||
SOAP::WSDL eases writing your own visitor. This might be required if you need
|
||||
some special output format from a WSDL file, or want to feed your own
|
||||
serializer/deserializer pair with custom configuration data. Or maybe you want
|
||||
to generate C# code from it...
|
||||
|
||||
To write your own code generating visitor, you should subclass
|
||||
SOAP::WSDL::Generator::Visitor. It implements (empty) default methods for all
|
||||
SOAP::WSDL data classes:
|
||||
|
||||
=over
|
||||
|
||||
=item * visit_Definitions
|
||||
|
||||
=item * visit_Binding
|
||||
|
||||
=item * visit_Message
|
||||
|
||||
=item * visit_Operation
|
||||
|
||||
=item * visit_OpMessage
|
||||
|
||||
=item * visit_Part
|
||||
|
||||
=item * visit_Port
|
||||
|
||||
=item * visit_PortType
|
||||
|
||||
=item * visit_Service
|
||||
|
||||
=item * visit_SoapOperation
|
||||
|
||||
=item * visit_Types
|
||||
|
||||
=item * visit_XSD_Schema
|
||||
|
||||
=item * visit_XSD_ComplexType
|
||||
|
||||
=item * visit_XSD_Element
|
||||
|
||||
=item * visit_XSD_SimpleType
|
||||
|
||||
=back
|
||||
|
||||
In your Visitor, you must implement visit_Foo methods for all classes you wish
|
||||
to visit.
|
||||
|
||||
Currently, all SOAP::WSDL::Generator::Visitor implementations include their own
|
||||
Iterator (which means they know how to find the next objects to visit). You
|
||||
may or may not choose to implement a separate Iterator.
|
||||
|
||||
Letting a visitor implementing it's own Iterator visit a WSDL definition is as
|
||||
easy as writing something like this:
|
||||
|
||||
my $visitor = MyVisitor->new();
|
||||
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
|
||||
my $definitions = $parser->parse_file('my.wsdl'):
|
||||
|
||||
$definitions->_accept( $visitor );
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over
|
||||
|
||||
=item * [GHJV1995]
|
||||
|
||||
Erich Gamma, Richard Helm, Ralph E. Johnson, John Vlissides, (1995):
|
||||
Design Patterns. Elements of Reusable Object-Oriented Software.
|
||||
Addison-Wesley Longman, Amsterdam.
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 REPOSITORY INFORMATION
|
||||
|
||||
$Rev: 239 $
|
||||
$LastChangedBy: kutterma $
|
||||
$Id: Client.pm 239 2007-09-11 09:45:42Z kutterma $
|
||||
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,10 @@
|
||||
package SOAP::WSDL::Generator::Visitor::Typelib;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(SOAP::WSDL::Generator::Visitor
|
||||
SOAP::WSDL::Generator::Template
|
||||
);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
@@ -0,0 +1,227 @@
|
||||
package SOAP::WSDL::Generator::Visitor::Typemap;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
use base qw(SOAP::WSDL::Generator::Visitor);
|
||||
|
||||
my %path_of :ATTR(:name<path> :default<[]>);
|
||||
my %typemap_of :ATTR(:name<typemap> :default<()>);
|
||||
my %type_prefix_of :ATTR(:name<type_prefix> :default<()>);
|
||||
my %element_prefix_of :ATTR(:name<element_prefix> :default<()>);
|
||||
|
||||
sub START {
|
||||
my ($self, $ident, $arg_ref) = @_;
|
||||
$type_prefix_of{ $ident } ||= 'MyTypes';
|
||||
$element_prefix_of{ $ident } ||= 'MyElements';
|
||||
}
|
||||
|
||||
sub set_typemap_entry {
|
||||
my ($self, $value) = @_;
|
||||
$typemap_of{ ident $self }->{
|
||||
join( q{/}, @{ $path_of{ ident $self } } )
|
||||
} = $value;
|
||||
}
|
||||
|
||||
sub add_element_path {
|
||||
my ($self, $element) = @_;
|
||||
|
||||
# Swapping out this lines against the ones below generates
|
||||
# a namespace-sensitive typemap.
|
||||
# Well almost: Class names are not constructed in a namespace-sensitive
|
||||
# manner, yet - there should be some facility to allow binding a (perl)
|
||||
# prefix to a namespace...
|
||||
push @{ $path_of{ ident $self } }, $element->get_name();
|
||||
|
||||
# push @{ $path_of{ ident $self } },
|
||||
# "{". $element->get_targetNamespace . "}"
|
||||
# . $element->get_name();
|
||||
}
|
||||
|
||||
sub visit_Definitions {
|
||||
my ( $self, $ident, $definitions ) = ( $_[0], ident $_[0], $_[1] );
|
||||
|
||||
$self->set_definitions( $definitions );
|
||||
|
||||
for ( @{ $definitions->get_service() } ) {
|
||||
$_->_accept($self);
|
||||
}
|
||||
}
|
||||
|
||||
sub visit_Service {
|
||||
my ( $self, $service ) = ( $_[0], $_[1] );
|
||||
|
||||
for ( @{ $service->get_port() } ) { $_->_accept($self); }
|
||||
}
|
||||
|
||||
sub visit_Port {
|
||||
my ( $self, $ident, $port ) = ( $_[0], ident $_[0], $_[1] );
|
||||
|
||||
# This is a false assumption - typemaps may be valid for non-soap
|
||||
# bindings as well.
|
||||
# TODO check and correct
|
||||
return if not $port->first_address();
|
||||
return if not $port->first_address()->isa('SOAP::WSDL::SOAP::Address');
|
||||
|
||||
my $binding = $self->get_definitions()
|
||||
->find_binding( $port->expand( $port->get_binding() ) )
|
||||
or die 'binding ' . $port->get_binding() . ' not found!';
|
||||
|
||||
$binding->_accept($self);
|
||||
}
|
||||
|
||||
sub visit_Binding {
|
||||
my ( $self, $ident, $binding ) = ( $_[0], ident $_[0], $_[1] );
|
||||
|
||||
my $portType = $self->get_definitions()
|
||||
->find_portType( $binding->expand( $binding->get_type ) )
|
||||
or die 'portType not found: ' . $binding->binding_type;
|
||||
|
||||
for my $operation ( @{ $binding->get_operation() } ) {
|
||||
my $name = $operation->get_name();
|
||||
|
||||
# get the equally named operation from the portType
|
||||
my ($op) = grep { $_->get_name eq $name }
|
||||
@{ $portType->get_operation() }
|
||||
or die "operation <$name> not found";
|
||||
|
||||
# visit every input, output and fault message...
|
||||
for ( @{ $op->get_input }, @{ $op->get_output }, @{ $op->get_fault } ) {
|
||||
$_->_accept($self);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub visit_OpMessage {
|
||||
my ( $self, $ident, $operation_message ) = ( $_[0], ident $_[0], $_[1] );
|
||||
return if not( $operation_message->get_message() ); # we're in binding
|
||||
|
||||
# TODO maybe allow more messages && overloading by specifying name
|
||||
|
||||
# find message referenced in operation
|
||||
my $message = $self->get_definitions()->find_message(
|
||||
$operation_message->expand( $operation_message->get_message() ) );
|
||||
|
||||
for my $part ( @{ $message->get_part() } ) {
|
||||
$part->_accept($self);
|
||||
}
|
||||
}
|
||||
|
||||
sub visit_Part {
|
||||
my ( $self, $ident, $part ) = ( $_[0], ident $_[0], $_[1] );
|
||||
|
||||
my $types_ref = $self->get_definitions()->first_types()
|
||||
or warn "Empty part" . $part->get_name();
|
||||
|
||||
# resolve type
|
||||
# If we have a type, this type is to be used in document/literal
|
||||
# as global type. However this is forbidden, at least by WS-I.
|
||||
# We should store the style/encoding somewhere, and regard it.
|
||||
# TODO: auto-generate element for RPC bindings
|
||||
if ( my $type_name = $part->get_type ) {
|
||||
# FIXME support RPC-style calls
|
||||
die "unsupported global type <$type_name> found in part";
|
||||
}
|
||||
|
||||
# TODO factor out iterator or replace by lookup (probably better)
|
||||
if ( my $element_name = $part->get_element() ) {
|
||||
my $element = $types_ref->find_element(
|
||||
$part->expand($element_name) )
|
||||
|| die "no element $element_name found for part " . $part->get_name();
|
||||
$element->_accept($self);
|
||||
return;
|
||||
}
|
||||
|
||||
warn 'neither type nor element - do not know what to do for part '
|
||||
. $part->get_name();
|
||||
return;
|
||||
}
|
||||
|
||||
sub process_referenced_type {
|
||||
my ( $self, $ns, $localname ) = @_;
|
||||
return if not $localname;
|
||||
my $ident = ident $self;
|
||||
|
||||
# get type's class name
|
||||
# Caveat: visits type if it's a referenced type from the
|
||||
# a ? b : c operation.
|
||||
my $typeclass =
|
||||
( $ns eq 'http://www.w3.org/2001/XMLSchema' )
|
||||
? "SOAP::WSDL::XSD::Typelib::Builtin::$localname"
|
||||
: do {
|
||||
my $type =
|
||||
$self->get_definitions()->first_types()->find_type( $ns, $localname );
|
||||
$type->_accept($self);
|
||||
join( q{::}, $type_prefix_of{$ident}, $type->get_name() );
|
||||
};
|
||||
|
||||
$self->set_typemap_entry($typeclass);
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub process_atomic_type {
|
||||
my ( $self, $type, $callback ) = @_;
|
||||
return if not $type;
|
||||
|
||||
my $ident = ident $self;
|
||||
$callback->( $self, $type ) if $callback;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub visit_XSD_Element {
|
||||
my ( $self, $ident, $element ) = ( $_[0], ident $_[0], $_[1] );
|
||||
|
||||
# TODO: what about element ref="" ?
|
||||
# when we're hopping from one element to the next one...
|
||||
|
||||
# step down in tree
|
||||
$self->add_element_path( $element );
|
||||
|
||||
# now call all possible variants.
|
||||
# They all just return if no argument is given,
|
||||
# and return $self on success.
|
||||
SWITCH: {
|
||||
if ($element->get_type) {
|
||||
$self->process_referenced_type( $element->expand( $element->get_type() ) )
|
||||
&& last;
|
||||
}
|
||||
# for atomic simple and comples types , and ref elements
|
||||
my $typeclass = join q{::}, $element_prefix_of{$ident}, $element->get_name();
|
||||
|
||||
$self->set_typemap_entry($typeclass);
|
||||
|
||||
# kind of double-dispatch: returns true on success, but does nothing
|
||||
$self->process_atomic_type( $element->first_simpleType() )
|
||||
&& last;
|
||||
|
||||
$self->process_atomic_type( $element->first_complexType()
|
||||
, sub { $_[1]->_accept($_[0]) } )
|
||||
&& last;
|
||||
|
||||
# TODO: add element ref handling
|
||||
};
|
||||
# step up in hierarchy
|
||||
pop @{ $path_of{$ident} };
|
||||
}
|
||||
|
||||
sub visit_XSD_ComplexType {
|
||||
my ($self, $ident, $type) = ($_[0], ident $_[0], $_[1] );
|
||||
my $content_model = $type->get_flavor();
|
||||
# TODO is this allowed ? or should we better die ?
|
||||
return if not $content_model; # empty complexType
|
||||
|
||||
if ( grep { $_ eq $content_model} qw(all sequence choice) )
|
||||
{
|
||||
# visit child elements
|
||||
for (@{ $type->get_element() }) {
|
||||
$_->_accept( $self );
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
warn "unsupported content model $content_model found in "
|
||||
. "complex type " . $type->get_name()
|
||||
. " - typemap may be incomplete";
|
||||
}
|
||||
|
||||
1;
|
||||
+237
-13
@@ -2,9 +2,9 @@
|
||||
|
||||
=head1 NAME
|
||||
|
||||
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
|
||||
|
||||
@@ -17,29 +17,28 @@ SOAP::WSDL::Manual - accessing WSDL based web services
|
||||
=item * Look what has been generated
|
||||
|
||||
Check the results of the generator. There should be one
|
||||
MyInterface/SERVICE_NAME.pm file per service.
|
||||
MyInterfaces/SERVICE_NAME/PORT_NAME.pm file per port (and one directory per
|
||||
service).
|
||||
|
||||
=item * Write script
|
||||
|
||||
use MyInterface::SERVICE_NAME;
|
||||
my $service = MyInterface::SERVICE_NAME->new();
|
||||
use MyInterface::SERVICE_NAME::PORT_NAME;
|
||||
my $service = MyInterface::SERVICE_NAME::PORT_NAME->new();
|
||||
|
||||
my $result = $service->SERVICE_METHOD();
|
||||
die $result if not $result;
|
||||
|
||||
print $result;
|
||||
|
||||
C<perldoc MyInterface::SERVICE_NAME> should give you some overview about
|
||||
the service's interface structure.
|
||||
C<perldoc MyInterface::SERVICE_NAME::PORT_NAME> should give you some overview
|
||||
about the service's interface structure.
|
||||
|
||||
The results of all calls to your service object's methods (except new)
|
||||
are objects based on SOAP::WSDL's XML schema implementation.
|
||||
|
||||
These objects are false in boolean context, and serialize to XML when
|
||||
printed.
|
||||
The results of all calls to your service object's methods (except new) are
|
||||
objects based on SOAP::WSDL's XML schema implementation.
|
||||
|
||||
To access the object's properties use get_NAME / set_NAME getter/setter
|
||||
methods whith NAME corresponding to the XML tag name.
|
||||
methods whith NAME corresponding to the XML tag name / the hash structure as
|
||||
showed in the generated pod.
|
||||
|
||||
=item * Run script
|
||||
|
||||
@@ -57,6 +56,231 @@ classes and returned to the user as objects.
|
||||
To find out which class a particular XML node should be, SOAP::WSDL uses
|
||||
typemaps. For every Web service, there's also a typemap created.
|
||||
|
||||
=head2 Interface class creation
|
||||
|
||||
To create interface classes, follow the steps above from
|
||||
L<Quick walk-through for the unpatient|Quick walk-through for the unpatient>.
|
||||
|
||||
If this works fine for you, skip the next paragraphs. If not, read on.
|
||||
|
||||
The steps to instrument a web service with SOAP::WSDL perl bindings
|
||||
(in detail) are as follows:
|
||||
|
||||
=over
|
||||
|
||||
=item * Gather web service information
|
||||
|
||||
You'll need to know at least a URL pointing to the web service's WSDL
|
||||
definition.
|
||||
|
||||
If you already know more - like which methods the service provides, or how
|
||||
the XML messages look like, that's fine. All these things will help you
|
||||
later.
|
||||
|
||||
=item * Create WSDL bindings
|
||||
|
||||
perl wsdl2perl.pl -b base_dir URL
|
||||
|
||||
This will generate the perl bindings in the directory specified by base_dir.
|
||||
|
||||
For more options, see L<wsdl2perl.pl> - you may want to specify class
|
||||
prefixes for XML type and element classes, type maps and interface classes,
|
||||
and you may even want to add custom typemap elements.
|
||||
|
||||
=item * Check the result
|
||||
|
||||
There should be a bunch of classes for types (in the MyTypes:: namespace by
|
||||
default), elements (in MyElements::), and at least one typemap (in
|
||||
MyTypemaps::) and one ore more interface classes (in MyInterfaces::).
|
||||
|
||||
If you don't already know the details of the web service you're going to
|
||||
instrument, it's now time to read the perldoc of the generated interface
|
||||
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 - if not, blame the web service author.
|
||||
|
||||
=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 errors 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 expressions
|
||||
without occurence numbers (like [1]) relative to the Body element.
|
||||
Namespaces are ignored.
|
||||
|
||||
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.
|
||||
|
||||
Note that typemap include files for wsdl2perl.pl must evaluate to a valid
|
||||
perl hash - it will be imported via eval (OK, to be honest: via I<do $file>,
|
||||
but that's almost the same...).
|
||||
|
||||
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
|
||||
|
||||
Accessing a web service without a WSDL definition is more cumbersome. There
|
||||
are two ways to go:
|
||||
|
||||
=over
|
||||
|
||||
=item * Write a WSDL definition and generate interface
|
||||
|
||||
This is the way to go if you already are experienced in writing WSDL files.
|
||||
If you are not, be warned: Writing a correct WSDL is not an easy task, and
|
||||
writing correct WSDL files with only a text editor is almost impossible.
|
||||
|
||||
You should definitely use a WSDL editor. The WSDL editor should support
|
||||
conformance checks for the WS-I Basic Profile (1.0 is preferred by
|
||||
SOAP::WSDL)
|
||||
|
||||
=item * Write a typemap and class library from scratch
|
||||
|
||||
If the web service is relatively simple, this is probably easier than first
|
||||
writing a WSDL definition. Besides, it can be done in perl, a language you
|
||||
are probably more familiar with than WSDL.
|
||||
|
||||
L<SOAP::WSDL::XSD::Typelib::ComplexType>, L<SOAP::WSDL::XSD::Typelib::SimpleType> and
|
||||
L<SOAP::WSDL::XSD::Typelib::Element> tell you how to create subclasses of XML schema
|
||||
types.
|
||||
|
||||
L<SOAP::WSDL::Manual::Parser> will tell you how to create a typemap class.
|
||||
|
||||
=back
|
||||
|
||||
=head1 Troubleshooting
|
||||
|
||||
=head2 Accessing HTTPS webservices
|
||||
|
||||
You need Crypt::SSLeay installed to access HTTPS webservices.
|
||||
|
||||
=head2 Accessing protected web services
|
||||
|
||||
Passing a userndame and password, or a client certificate and key, to the
|
||||
transport layer is highly dependent on the transport backend.
|
||||
|
||||
=head3 Accessing HTTP(S) webservices with basic/digest authentication
|
||||
|
||||
When using SOAP::WSDL::Transport::HTTP (SOAP::Lite not installed), add a
|
||||
method called "get_basic_credentials" to SOAP::WSDL::Transport::HTTP:
|
||||
|
||||
*SOAP::WSDL::Transport::HTTP::get_basic_credentials = sub {
|
||||
return ($user, $password);
|
||||
};
|
||||
|
||||
When using SOAP::Transport::HTTP (SOAP::Lite is installed), do the same to
|
||||
this backend:
|
||||
|
||||
*SOAP::Transport::HTTP::get_basic_credentials = sub {
|
||||
return ($user, $password);
|
||||
};
|
||||
|
||||
=head3 Accessing HTTP(S) webservices protected by NTLM authentication
|
||||
|
||||
Besides passing user credentials as when accessing a web service protected
|
||||
by basic or digest authentication, you also need to enforce connection
|
||||
keep_alive on the transport backens.
|
||||
|
||||
To do so, pass a I<proxy> argument to the new() method of the generated
|
||||
class. This unfortunately means that you have to set the endpoint URL, too:
|
||||
|
||||
my $interface = MyInterfaces::SERVICE_NAME::PORT_NAME->new({
|
||||
proxy => [ $url, keep_alive => 1 ]
|
||||
});
|
||||
|
||||
You may, of course, decide to just hack the generated class. Be advised that
|
||||
subclassing might be a more appropriate solution - re-generating overwrites
|
||||
changes in interface classes.
|
||||
|
||||
=head3 Accessing HTTPS webservices protected by certificate authentication
|
||||
|
||||
You need Crypt::SSLeay installed to access HTTPS webservices.
|
||||
|
||||
See L<Crypt::SSLeay> on how to configure client certificate authentication.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<SOAP::WSDL::Manual::Glossary> The meaning of all these words
|
||||
|
||||
@@ -7,13 +7,16 @@ SOAP::WSDL::Manual::Glossary - Those acronyms and stuff
|
||||
=head2 web service
|
||||
|
||||
Web services are RPC (Remote Procedure Call) interfaces accessible via
|
||||
the internet, typically via HTTP(S).
|
||||
some internet protocol, typically via HTTP(S).
|
||||
|
||||
=head2 SOAP
|
||||
|
||||
SOAP (the Simple Object Access Protocol) is a specification for
|
||||
defining RPC interfaces, including (but not neccessarily limited to)
|
||||
web services.
|
||||
SOAP is an acronym for Simple Object Access Protocol.
|
||||
SOAP is a W3C recommendation. The latest version of the SOAP
|
||||
specification may be found at L<http://www.w3.org/TR/soap/>.
|
||||
|
||||
SOAP defines a protocoll for message exchange between applications.
|
||||
The most popular usage is to use SOAP for remote procedure calls (RPC).
|
||||
|
||||
While one of the constituting aspects of a web service is its
|
||||
reachability via some internet protocol, you might as well define
|
||||
@@ -21,20 +24,57 @@ SOAP services accessible via postcards.
|
||||
|
||||
Despite it's name, SOAP has nothing more to do with objects than
|
||||
cars have with pets - SOAP messages may, but not neccessarily do
|
||||
carry object, very much like your car may, but does not need to
|
||||
carry objects, very much like your car may, but does not need to
|
||||
carry your pet.
|
||||
|
||||
=head2 WSDL
|
||||
|
||||
WSDL (Web Service Definition Language) is a XML-based markup language
|
||||
for defining web service interfaces.
|
||||
WSDL is an acronym for Web Services Description Language.
|
||||
WSDL is a W3C recommendation. The latest version of the WSDL specification
|
||||
may be found at L<http://www.w3.org/TR/wsdl20/>.
|
||||
|
||||
WSDL defines a XML-based language for describing web service interfaces,
|
||||
including SOAP interfaces.
|
||||
|
||||
=head2 WS-I
|
||||
|
||||
WS-I (Web Service Interoperability) is a industry consortium dedicated
|
||||
to finding interoperability rules for web services.
|
||||
WS-I (Web Services Interoperability Organization) is an open industry
|
||||
organisation chartered to promote Web service interoperability across
|
||||
platforms, operating systems, and programming languages.
|
||||
|
||||
SOAP::WSDL aims to be a WS-I compliant SOAP client.
|
||||
WS-I publishes profiles, which provide implementation guidelines for
|
||||
how related Web services specifications should be used together for
|
||||
best interoperability. To date, WS-I has finalized the Basic Profile,
|
||||
Attachments Profile and Simple SOAP Binding Profile.
|
||||
|
||||
SOAP::WSDL aims at complying to the Basic Profile (but does not
|
||||
implement full support yet).
|
||||
|
||||
=head2 SOAP message styles
|
||||
|
||||
=head3 rpc
|
||||
|
||||
Meant for transporting a RPC message. All contents of the SOAP body are
|
||||
put into a top-level node named equal to the SOAP operation.
|
||||
|
||||
WS-I Basic Profile allows the use of rpc message style.
|
||||
|
||||
SOAP::WSDL does not support rpc message style yet.
|
||||
|
||||
SOAP::Lite supports rpc message style only.
|
||||
|
||||
=head3 document
|
||||
|
||||
Meant for transporting arbitrary content. No additional nodes are inserted
|
||||
between the SOAP body and the actual content.
|
||||
|
||||
WS-I Basic Profile allows the use of document message style.
|
||||
|
||||
=head2 SOAP encoding styles
|
||||
|
||||
=head3 encoded
|
||||
|
||||
=head3 literal
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
|
||||
@@ -2,12 +2,12 @@
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Parser - How SOAP::WSDL parses XML messages
|
||||
SOAP::WSDL::Manual::Parser - How SOAP::WSDL parses XML messages
|
||||
|
||||
=head1 Which XML message does SOAP::WSDL parse ?
|
||||
|
||||
Naturally, there are two kinds of XMLdocuments (or messages) SOAP::WSDL
|
||||
has to parse:
|
||||
Naturally, there are two kinds of XML documents (or messages) SOAP::WSDL has
|
||||
to parse:
|
||||
|
||||
=over
|
||||
|
||||
@@ -19,38 +19,60 @@ has to parse:
|
||||
|
||||
=head1 Parser implementations
|
||||
|
||||
There are different parser implementations available for SOAP messages -
|
||||
currently there's only one for WSDL definitions.
|
||||
There are different parser implementations available for SOAP messages and
|
||||
WSDL definitions.
|
||||
|
||||
Historically, SOAP::WSDL used SAX for parsing XML. The SAX handlers were
|
||||
implemented as L<XML::LibXML|XML::LibXML> handlers, which also worked with
|
||||
L<XML::SAX::ParserFactory|XML::SAX::ParserFactory>.
|
||||
|
||||
Support for SAX and L<XML::LibXML|XML::LibXML> in SOAP::WSDL is discontinued
|
||||
for the following reasons:
|
||||
|
||||
=over
|
||||
|
||||
=item * Speed
|
||||
|
||||
L<XML::Parser::Expat|XML::Parser::Expat> is faster than
|
||||
L<XML::LibXML|XML::LibXML> - at least when optimized for speed.
|
||||
|
||||
High parsing speed is one of the key requirements for a SOAP toolkit - if XML
|
||||
serializing and (more important) deserializing are not fast enough, the whole
|
||||
toolkit is unusable.
|
||||
|
||||
=item * Availability
|
||||
|
||||
L<XML::Parser|XML::Parser> is more popular than L<XML::LibXML|XML::LibXML>.
|
||||
|
||||
=item * Stability
|
||||
|
||||
XML::LibXML is based on the libxml2 library. Several versions of
|
||||
libxml2 are known to have specific bugs. As a workaround, there are
|
||||
often several versions of libxml2 installed on one system. This may
|
||||
lead to problems on operating systems which cannot load more than
|
||||
one version of a shared library simultaneously.
|
||||
|
||||
XML::LibXML is also still under development, while XML::Parser has had time
|
||||
to stabilize.
|
||||
|
||||
=item * SOAP::Lite uses XML::Parser
|
||||
|
||||
L<SOAP::Lite|SOAP::Lite> uses L<XML::Parser|XML::Parser> if available.
|
||||
SOAP::WSDL should not require users to install both L<XML::Parser|XML::Parser>
|
||||
and L<XML::LibXML|XML::LibXML>.
|
||||
|
||||
=back
|
||||
|
||||
=head2 WSDL definitions parser
|
||||
|
||||
=over
|
||||
|
||||
=item * SOAP::WSDL::SAX::WSDLHandler
|
||||
=item * SOAP::WSDL::Expat::WSDLParser
|
||||
|
||||
This is a SAX handler for parsing WSDL files into object trees SOAP::WSDL
|
||||
works with.
|
||||
A parser for WSDL definitions based on L<XML::Parser::Expat|XML::Parser::Expat>.
|
||||
|
||||
It's built as a native handler for XML::LibXML, but will also work with
|
||||
XML::SAX::ParserFactory.
|
||||
|
||||
To parse a WSDL file, use one of the following variants:
|
||||
|
||||
my $parser = XML::LibXML->new();
|
||||
my $handler = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||
$parser->set_handler( $handler );
|
||||
$parser->parse( $xml );
|
||||
my $data = $handler->get_data();
|
||||
|
||||
|
||||
my $handler = SOAP::WSDL::SAX::WSDLHandler->new({
|
||||
base => 'XML::SAX::Base'
|
||||
});
|
||||
my $parser = XML::SAX::ParserFactor->parser(
|
||||
Handler => $handler
|
||||
);
|
||||
$parser->parse( $xml );
|
||||
my $data = $handler->get_data();
|
||||
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
|
||||
my $wsdl = $parser->parse_file( $filename );
|
||||
|
||||
=back
|
||||
|
||||
@@ -90,6 +112,29 @@ A class resolver package might look like this:
|
||||
};
|
||||
1;
|
||||
|
||||
=head3 Skipping unwanted items
|
||||
|
||||
Sometimes there's unneccessary information transported in SOAP messages.
|
||||
|
||||
To skip XML nodes (including all child nodes), just edit the type map for
|
||||
the message and set the type map entry to '__SKIP__'.
|
||||
|
||||
In the example above, EnqueueMessage/StuffIDontNeed and all child elements
|
||||
are skipped.
|
||||
|
||||
my %class_list = (
|
||||
'EnqueueMessage' => 'Typelib::TEnqueueMessage',
|
||||
'EnqueueMessage/MMessage' => 'Typelib::TMessage',
|
||||
'EnqueueMessage/MMessage/MRecipientURI' => 'SOAP::WSDL::XSD::Builtin::anyURI',
|
||||
'EnqueueMessage/MMessage/MMessageContent' => 'SOAP::WSDL::XSD::Builtin::string',
|
||||
'EnqueueMessage/StuffIDontNeed' => '__SKIP__',
|
||||
'EnqueueMessage/StuffIDontNeed/Foo' => 'SOAP::WSDL::XSD::Builtin::string',
|
||||
'EnqueueMessage/StuffIDontNeed/Bar' => 'SOAP::WSDL::XSD::Builtin::string',
|
||||
);
|
||||
|
||||
Note that only SOAP::WSDL::Expat::MessageParser implements skipping elements
|
||||
at the time of writing.
|
||||
|
||||
=head3 Creating type lib classes
|
||||
|
||||
Every element must have a correspondent one in the type library.
|
||||
@@ -109,18 +154,6 @@ L<SOAP::WSDL::XSD::Typelib::ComplexType> and L<SOAP::WSDL::XSD::Typelib::SimpleT
|
||||
|
||||
=over
|
||||
|
||||
=item * SOAP::WSDL::SAX::MessageHandler
|
||||
|
||||
This is a SAX handler for parsing WSDL files into object trees SOAP::WSDL
|
||||
works with.
|
||||
|
||||
It's built as a native handler for XML::LibXML, but will also work with
|
||||
XML::SAX::ParserFactory.
|
||||
|
||||
Can be used for parsing both streams (chunks) and documents.
|
||||
|
||||
See L<SOAP::WSDL::SAX::MessageHandler> for details.
|
||||
|
||||
=item * SOAP::WSDL::Expat::MessageParser
|
||||
|
||||
A L<XML::Parser::Expat|XML::Parser::Expat> based parser. This is the fastest
|
||||
@@ -131,7 +164,8 @@ parser for most SOAP messages and the default for SOAP::WSDL::Client.
|
||||
A XML::Parser::ExpatNB based parser. Useful for parsing huge HTTP responses,
|
||||
as you don't need to keep everything in memory.
|
||||
|
||||
See L<SOAP::WSDL::Expat::MessageStreamParser|SOAP::WSDL::Expat::MessageStreamParser> for details.
|
||||
See L<SOAP::WSDL::Expat::MessageStreamParser|SOAP::WSDL::Expat::MessageStreamParser>
|
||||
for details.
|
||||
|
||||
=back
|
||||
|
||||
@@ -175,4 +209,56 @@ to a response size of around 500k:
|
||||
|
||||
Response size: 344330 bytes
|
||||
|
||||
=head1 OLD SAX HANDLER
|
||||
|
||||
The old SAX handler historically used in SOAP::WSDL are not included in
|
||||
the SOAP::WSDL package any more.
|
||||
|
||||
However, they may be obtained from the "attic" directory in
|
||||
SOAP::WSDL's SVN repository at
|
||||
|
||||
https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/attic
|
||||
|
||||
=over
|
||||
|
||||
=item * SOAP::WSDL::SAX::WSDLHandler
|
||||
|
||||
This is a SAX handler for parsing WSDL files into object trees SOAP::WSDL
|
||||
works with.
|
||||
|
||||
It's built as a native handler for XML::LibXML, but will also work with
|
||||
XML::SAX::ParserFactory.
|
||||
|
||||
To parse a WSDL file, use one of the following variants:
|
||||
|
||||
my $parser = XML::LibXML->new();
|
||||
my $handler = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||
$parser->set_handler( $handler );
|
||||
$parser->parse( $xml );
|
||||
my $data = $handler->get_data();
|
||||
|
||||
|
||||
my $handler = SOAP::WSDL::SAX::WSDLHandler->new({
|
||||
base => 'XML::SAX::Base'
|
||||
});
|
||||
my $parser = XML::SAX::ParserFactor->parser(
|
||||
Handler => $handler
|
||||
);
|
||||
$parser->parse( $xml );
|
||||
my $data = $handler->get_data();
|
||||
|
||||
|
||||
=item * SOAP::WSDL::SAX::MessageHandler
|
||||
|
||||
This is a SAX handler for parsing WSDL files into object trees SOAP::WSDL
|
||||
works with.
|
||||
|
||||
It's built as a native handler for XML::LibXML, but will also work with
|
||||
XML::SAX::ParserFactory.
|
||||
|
||||
Can be used for parsing both streams (chunks) and documents.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=cut
|
||||
File diff suppressed because it is too large.
Load diff
@@ -0,0 +1,311 @@
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Manual::XSD - SOAP::WSDL's XML Schema implementation
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL's XML Schema implementation translates XML Schema definitions into
|
||||
perl classes.
|
||||
|
||||
Every top-level type or element in a XML schema is translated into a perl
|
||||
class (usually in it's own file).
|
||||
|
||||
Atomic types are either directly included in the class of their parent's
|
||||
node, or as sub-package in their parent class' file.
|
||||
|
||||
While the implementation is still incomplete, it covers the XML schema
|
||||
definitions used by most object mappers.
|
||||
|
||||
=head1 USAGE
|
||||
|
||||
You can use SOAP::WSDL::XSD based classes just like any perl class - you may
|
||||
instantiate it, inherit from it etc.
|
||||
|
||||
You should be aware, that SOAP::WSDL::XSD based classes are inside-out
|
||||
classes using Class::Std, though - things you would expect from hash-based
|
||||
classes like using the blessed hash ref as data storage won't work.
|
||||
|
||||
Moreover, most classes override Class::Std's default constructor for speed -
|
||||
you should not expect BUILD or START methods to work, unless you call them
|
||||
yourself (or define a new constructor).
|
||||
|
||||
All SOAP::WSDL::XSD based complexType classes allow a hash ref mathing their
|
||||
data structure as only parameter to new(). You may mix hash and list refs and
|
||||
objects in the structure passed to new - as long as the structure matches, it
|
||||
will work fine.
|
||||
|
||||
All SOAP::WSDL::XSD based simpleType (and builtin) classes accept a single
|
||||
hash ref with the only key "value" and the value to be set as value.
|
||||
|
||||
=head1 HOW IT WORKS
|
||||
|
||||
=head2 Base classes
|
||||
|
||||
SOAP::WSDL::XSD provides a set of base classes for the construction of XML
|
||||
schema defined type classes.
|
||||
|
||||
=head3 Builtin types
|
||||
|
||||
SOAP::WSDL::XSD provides classes for all builtin XML Schema datatypes.
|
||||
|
||||
For a list and reference on these classes, see
|
||||
SOAP::WSDL::XSD::Typelib::Builtin.
|
||||
|
||||
=head3 Derivation classes
|
||||
|
||||
For derivation by list, the list derivation class
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list exists.
|
||||
|
||||
Derivation by restriction is handled without the help of additional classes.
|
||||
|
||||
=head3 Element construction class
|
||||
|
||||
For the construction of element classes, the element superclass
|
||||
SOAP::WSDL::XSD::Typelib::Element exists. All elements are ultimately derived
|
||||
from this class. Elements may inherit from type classes, too - see
|
||||
L</TRANSLATION RULES> for details.
|
||||
|
||||
=head3 complexType construction class
|
||||
|
||||
For the construction of complexType classes, the construction class
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType is provided. It provides a __factory
|
||||
method for placing attributes in generated classes, and generating
|
||||
appropriate setter/getter accessors.
|
||||
|
||||
The setters are special: They handle complex data structures of any type
|
||||
(meaning hash refs, list refs and objects, and any combination of them), as
|
||||
long as their structure matches the expected structure.
|
||||
|
||||
=head1 TRANSLATION RULES
|
||||
|
||||
=head2 element
|
||||
|
||||
TODO add more elaborate description
|
||||
|
||||
=head3 element with type attribute
|
||||
|
||||
Elements defined by referencing a builtin or user defined type inherit
|
||||
from SOAP::WSDL::XSD::Typelib::Element and from the corresponding type class.
|
||||
|
||||
Element Type
|
||||
base class class
|
||||
^ ^
|
||||
| |
|
||||
------------
|
||||
|
|
||||
Element type="" class
|
||||
|
||||
=head3 element with ref attribute
|
||||
|
||||
Elements defined by referencing another element inherit from the
|
||||
corresponding element class.
|
||||
|
||||
referenced Element class
|
||||
^
|
||||
|
|
||||
Element ref="" class
|
||||
|
||||
=head3 element with atomic simpleType
|
||||
|
||||
Elements defined by a atomic simpleType from
|
||||
SOAP::WSDL::XSD::Typelib::Element and from the base type of the atomic type.
|
||||
|
||||
Element atomic Type
|
||||
base class base class
|
||||
^ ^
|
||||
| |
|
||||
--------------
|
||||
|
|
||||
element simpleType class
|
||||
|
||||
=head3 element with atomic complexType
|
||||
|
||||
Elements defined with a atomic complexType inherit from
|
||||
SOAP::WSDL::XSD::Typelib::Element and from
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType.
|
||||
|
||||
Element complexType
|
||||
base class base class
|
||||
^ ^
|
||||
| |
|
||||
--------------
|
||||
|
|
||||
element complexType class
|
||||
|
||||
=head2 complexType
|
||||
|
||||
TODO add more elaborate description
|
||||
|
||||
Some content models are not implemented yet. The content models
|
||||
implemented are described below.
|
||||
|
||||
=head3 complexType with "all" variety
|
||||
|
||||
Complex types with "all" variety inherit from
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType, and call it's factory method for
|
||||
creating fields and accessors/mutators for the complexType's elements.
|
||||
|
||||
All element's type classes are loaded. Complex type classes have a "has a"
|
||||
relationship to their element fields.
|
||||
|
||||
Element fields may either be element classes (for element ref="") or type
|
||||
classes (for element type=""). No extra element classes are created for
|
||||
a complexType's elements.
|
||||
|
||||
complexType
|
||||
base class
|
||||
^
|
||||
|
|
||||
complexType all
|
||||
---------------- has a
|
||||
element name="a" ------------> Element or type class object
|
||||
element name="b" ------------> Element or type class object
|
||||
|
||||
The implementation for all does enforce the order of elements as described
|
||||
in the WSDL, even though this is not required by the XML Schema
|
||||
specification.
|
||||
|
||||
=head3 complexType with "sequence" variety
|
||||
|
||||
The implementation of the "sequence" variety is the same as for all.
|
||||
|
||||
=head3 complexType with "choice" variety
|
||||
|
||||
The implementation for choice currently is the same as for all - which means,
|
||||
no check for occurence are made.
|
||||
|
||||
=head3 complexType with complexContent content model
|
||||
|
||||
=over
|
||||
|
||||
=item * restriction variety
|
||||
|
||||
ComplexType classes with restriction variety inherit from their base type.
|
||||
No additional processing or content checking is performed yet.
|
||||
|
||||
complexType
|
||||
base type class
|
||||
^
|
||||
|
|
||||
complexType
|
||||
restriction
|
||||
|
||||
Note that complexType with restriction variety classes don't exhibit their
|
||||
type via the xsi:type attribute yet, so they currently cannot be used as
|
||||
a replacement for their base type.
|
||||
|
||||
=item * extension variety
|
||||
|
||||
=back
|
||||
|
||||
=head2 SimpleType
|
||||
|
||||
TODO add more elaborate description
|
||||
|
||||
Some derivation methods are not implemented yet. The derivation methods
|
||||
implemented are described below.
|
||||
|
||||
=head3 Derivation by list
|
||||
|
||||
Derivation by list is implemented by inheriting from both the base type and
|
||||
SOAP::WSDL::XSD::Typelib::XSD::list.
|
||||
|
||||
=head3 Derivation by restriction
|
||||
|
||||
Derivation by restriction is implemented by inheriting from a base type and
|
||||
applying the required restrictions.
|
||||
|
||||
=head2 Complex Types
|
||||
|
||||
=head1 FACETS
|
||||
|
||||
XML Schema facets are not implemented yet.
|
||||
|
||||
They will probably implemented some day by putting constant methods into
|
||||
the correspondent classes.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
XML attributes are not implemented yet. If you have a good idea on how to
|
||||
implement them, feel free to email me a proposal.
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
The following XML Schema declaration elements are not supported yet:
|
||||
|
||||
=over
|
||||
|
||||
=item * Declaration elements
|
||||
|
||||
attribute
|
||||
notation
|
||||
|
||||
=item * Type definition elements
|
||||
|
||||
complexContent - only restriction supported
|
||||
simpleContent
|
||||
union
|
||||
|
||||
=item * Content model definition elements
|
||||
|
||||
any
|
||||
anyAttribute
|
||||
attributeGroup
|
||||
group
|
||||
|
||||
=item * Identity definition elements
|
||||
|
||||
field
|
||||
key
|
||||
keyref
|
||||
selector
|
||||
unique
|
||||
|
||||
=item * Inclusion elements
|
||||
|
||||
import
|
||||
include
|
||||
redefine
|
||||
|
||||
=back
|
||||
|
||||
The following XML Schema declaration elements are supported, but have no
|
||||
effect yet:
|
||||
|
||||
=over
|
||||
|
||||
=item * Factes
|
||||
|
||||
enumeration
|
||||
fractionDigits
|
||||
lenght
|
||||
maxExclusive
|
||||
maxInclusiove
|
||||
maxLength
|
||||
minExclusive
|
||||
minInclusive
|
||||
minLength
|
||||
pattern
|
||||
totalDigits
|
||||
whitespace
|
||||
|
||||
=item * Documentation elements
|
||||
|
||||
appinfo
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 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
|
||||
@@ -4,61 +4,9 @@ use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %body_of :ATTR(:name<body> :default<()>);
|
||||
my %message_of :ATTR(:name<message> :default<()>);
|
||||
my %use_of :ATTR(:name<use> :default<()>);
|
||||
my %namespace :ATTR(:name<namespace> :default<()>);
|
||||
my %encodingStyle_of :ATTR(:name<encodingStyle> :default<()>);
|
||||
|
||||
sub explain
|
||||
{
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $name = shift;
|
||||
my $txt = '';
|
||||
|
||||
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
|
||||
if ( $self->get_message() ) {
|
||||
|
||||
my ($prefix, $localname) = split /:/ , $self->get_message();
|
||||
|
||||
# TODO allow more messages && overloading by specifying name
|
||||
my $message = $opt->{ wsdl }->get_message(
|
||||
$ns_map{ $prefix }, $localname
|
||||
);
|
||||
|
||||
for my $part(@{ $message->[0]->get_part() }) {
|
||||
$txt .= $part->explain($opt);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if ($self->use())
|
||||
{
|
||||
$txt .= " $name use: " . $self->use(). "\n";
|
||||
}
|
||||
}
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
|
||||
my ($self, $opt) = @_;
|
||||
my $txt = q{};
|
||||
return q{} if not ( $self->get_message() ); # we're in binding
|
||||
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
my ($prefix, $localname) = split /:/ , $self->get_message();
|
||||
|
||||
# TODO allow more messages && overloading by specifying name
|
||||
my $message = $opt->{ wsdl }->find_message(
|
||||
$ns_map{ $prefix }, $localname
|
||||
);
|
||||
|
||||
for my $part(@{ $message->get_part() }) {
|
||||
$txt .= $part->to_typemap($opt);
|
||||
}
|
||||
return $txt;
|
||||
}
|
||||
my %body_of :ATTR(:name<body> :default<[]>);
|
||||
my %header_of :ATTR(:name<header> :default<[]>);
|
||||
my %headerfault_of :ATTR(:name<headerfault> :default<[]>);
|
||||
my %message_of :ATTR(:name<message> :default<()>);
|
||||
|
||||
1;
|
||||
@@ -5,14 +5,12 @@ use Class::Std::Storable;
|
||||
use base qw/SOAP::WSDL::Base/;
|
||||
|
||||
my %operation_of :ATTR(:name<operation> :default<()>);
|
||||
my %input_of :ATTR(:name<input> :default<()>);
|
||||
my %output_of :ATTR(:name<output> :default<()>);
|
||||
my %fault_of :ATTR(:name<fault> :default<()>);
|
||||
my %input_of :ATTR(:name<input> :default<[]>);
|
||||
my %output_of :ATTR(:name<output> :default<[]>);
|
||||
my %fault_of :ATTR(:name<fault> :default<[]>);
|
||||
my %type_of :ATTR(:name<type> :default<()>);
|
||||
my %style_of :ATTR(:name<style> :default<()>);
|
||||
my %transport_of :ATTR(:name<transport> :default<()>);
|
||||
my %parameterOrder_of :ATTR(:name<parameterOrder> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
|
||||
@@ -41,49 +41,4 @@ sub serialize
|
||||
die "Neither type nor element - don't know what to do";
|
||||
}
|
||||
|
||||
sub explain {
|
||||
my ($self, $opt, $name ) = @_;
|
||||
my $typelib = $opt->{ wsdl }->first_types() || die "No typelib";
|
||||
my $element = $self->get_type() || $self->get_element();
|
||||
|
||||
# resolve type
|
||||
my $type = $typelib->find_type( $opt->{ wsdl }->_expand( $element ) )
|
||||
|| $typelib->find_element( $opt->{ wsdl }->_expand( $element ) );
|
||||
|
||||
if (not $type)
|
||||
{
|
||||
warn "no type/element $element found for part " . $self->get_name();
|
||||
return q{};
|
||||
}
|
||||
return " {\n" . $type->explain( $opt, $self->get_name() ) . " }\n";
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
my ($self, $opt, $name ) = @_;
|
||||
my $txt = q{};
|
||||
my $wsdl = $opt->{ wsdl };
|
||||
my $typelib = $opt->{ wsdl }->first_types()
|
||||
|| die "No typelib";
|
||||
|
||||
# resolve type
|
||||
my $type;
|
||||
if (my $type_name = $self->get_type()) {
|
||||
$type = $typelib->find_type( $wsdl->_expand( $type_name ) )
|
||||
|| croak "no type/element $type_name found for part " . $self->get_name();
|
||||
$txt .= "q{} => " . $type->get_name() . "\n";
|
||||
}
|
||||
elsif ( my $element_name = $self->get_element() ) {
|
||||
$type = $typelib->find_element( $wsdl->_expand( $element_name ) )
|
||||
|| croak "no type/element $element_name found for part " . $self->get_name();
|
||||
}
|
||||
else {
|
||||
warn 'neither type nor element - do not know what to do for part '
|
||||
. $self->get_name();
|
||||
return q{};
|
||||
}
|
||||
$opt->{ path } = [];
|
||||
$txt .= $type->to_typemap( $opt, $self->get_name() );
|
||||
return $txt;
|
||||
}
|
||||
|
||||
1;
|
||||
+1
-34
@@ -5,39 +5,6 @@ use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %binding_of :ATTR(:name<binding> :default<()>);
|
||||
my %location_of :ATTR(:name<location> :default<()>);
|
||||
my %address_of :ATTR(:name<address> :default<()>);
|
||||
|
||||
sub explain {
|
||||
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
$opt->{ wsdl } || die 'required attribute wsdl missing';
|
||||
|
||||
my $binding = $opt->{ wsdl }->find_binding(
|
||||
$opt->{ wsdl }->_expand( $self->get_binding() )
|
||||
) or die 'binding ' . $self->get_binding() . ' not found !';
|
||||
|
||||
|
||||
my $txt = "=head2 Service information:\n\n"
|
||||
. " Port name: " . $self->get_name() . "\n"
|
||||
. " Binding: " . $self->get_binding() ."\n"
|
||||
. " Location: " . $self->get_location() ."\n"
|
||||
. $binding->explain($opt);
|
||||
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
|
||||
# skip non-SOAP ports (could be http, email or whatever...)
|
||||
return q{} if not $location_of{ ident $self };
|
||||
|
||||
my $binding = $opt->{ wsdl }->find_binding(
|
||||
$opt->{wsdl}->_expand( $binding_of{ ident $self } )
|
||||
) or die 'binding ' . $binding_of{ ident $self } .' not found!';
|
||||
|
||||
return $binding->to_typemap($opt);
|
||||
}
|
||||
1;
|
||||
@@ -1,281 +0,0 @@
|
||||
#!/usr/bin/perl
|
||||
package SOAP::WSDL::SAX::MessageHandler;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Scalar::Util qw(blessed);
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
|
||||
my %characters_of :ATTR(:default<()>);
|
||||
my %class_resolver_of :ATTR(:default<()> :name<class_resolver>);
|
||||
my %current_of :ATTR(:default<()>);
|
||||
my %ignore_of :ATTR(:default<()>);
|
||||
my %list_of :ATTR(:default<()>);
|
||||
my %namespace_of :ATTR(:default<()>);
|
||||
my %path_of :ATTR(:default<()>);
|
||||
my %data_of :ATTR(:default<()>);
|
||||
|
||||
{
|
||||
# we have to implement our own new - we need a blessed Hash ref as $self
|
||||
# for being able to inherit from XML::SAX::Base...
|
||||
no warnings qw(redefine);
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = {}; # $class->SUPER::new(@_);
|
||||
my $args = shift || {};
|
||||
|
||||
die "arguments to new must be single hash ref"
|
||||
if @_ or ! ref $args eq 'HASH';
|
||||
|
||||
# nasty, but for those who want to use XML::SAX::Base or similar
|
||||
# as parser factory
|
||||
if ($args->{base}) {
|
||||
# yup, naughty string eval
|
||||
eval "use base qw($args->{base})"; ## no critic qw(ProhibitStringyEval)
|
||||
}
|
||||
else {
|
||||
# create all those SAX methods...
|
||||
# ...we ignore em all...
|
||||
no strict qw(refs);
|
||||
foreach my $method ( qw(
|
||||
processing_instruction
|
||||
ignorable_whitespace
|
||||
set_document_locator
|
||||
start_prefix_mapping
|
||||
end_prefix_mapping
|
||||
skipped_entity
|
||||
start_cdata
|
||||
end_cdata
|
||||
comment
|
||||
entity_reference
|
||||
notation_decl
|
||||
unparsed_entity_decl
|
||||
element_decl
|
||||
attlist_decl
|
||||
doctype_decl
|
||||
xml_decl
|
||||
entity_decl
|
||||
attribute_decl
|
||||
internal_entity_decl
|
||||
external_entity_decl
|
||||
resolve_entity
|
||||
start_dtd
|
||||
end_dtd
|
||||
start_entity
|
||||
end_entity
|
||||
warning
|
||||
) ) {
|
||||
*{ "$method" } = sub {};
|
||||
}
|
||||
}
|
||||
|
||||
$class_resolver_of{ ident $self } = $args->{ class_resolver }
|
||||
if $args->{ class_resolver };
|
||||
|
||||
return bless $self, $class;
|
||||
}
|
||||
}
|
||||
|
||||
sub class_resolver {
|
||||
my $self = shift;
|
||||
$class_resolver_of{ ident $self } = shift;
|
||||
}
|
||||
|
||||
sub start_document {
|
||||
my $ident = ident $_[0];
|
||||
$list_of{ $ident } = [];
|
||||
$current_of{ $ident } = '__STOP__'; # use as marker
|
||||
$namespace_of{ $ident } = {};
|
||||
$ignore_of{ $ident } = [ qw(Envelope Body) ]; # SOAP elements
|
||||
$path_of{ $ident } = [];
|
||||
$data_of{ $ident } = undef;
|
||||
}
|
||||
|
||||
sub start_element {
|
||||
# use $_[n] for performance
|
||||
my ($ident, $element) = (ident $_[0], $_[1]);
|
||||
|
||||
# ignore top level elements
|
||||
if (@{ $ignore_of{ $ident } }
|
||||
&& $element->{ LocalName } eq $ignore_of{ $ident }->[0]) {
|
||||
shift @{ $ignore_of{ $ident } };
|
||||
return;
|
||||
}
|
||||
|
||||
# empty characters
|
||||
$characters_of{ $ident } = q{};
|
||||
|
||||
push @{ $path_of{ $ident } }, $element->{ LocalName }; # step down...
|
||||
push @{ $list_of{ $ident } }, $current_of{ $ident }; # remember current
|
||||
|
||||
# resolve class of this element
|
||||
my $class = $class_resolver_of{ $ident }->get_class( $path_of{ $ident } )
|
||||
or die "Cannot resolve class for "
|
||||
. join('/', @{ $path_of{ $ident } })
|
||||
. " via "
|
||||
. $class_resolver_of{ $ident };
|
||||
|
||||
# Check whether we have a primitive - we implement them as classes
|
||||
# TODO replace with UNIVERSAL->isa()
|
||||
# match is a bit faster if the string does not match, but WAY slower
|
||||
# if $class matches...
|
||||
# if (not $class=~m{^SOAP::WSDL::XSD::Typelib::Builtin}xms) {
|
||||
if (index $class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
|
||||
|
||||
# check wheter there is a CODE reference for $class::new.
|
||||
# If not, require it - all classes required here MUST
|
||||
# define new()
|
||||
# This is the same as $class->can('new'), but it's way faster
|
||||
no strict qw(refs);
|
||||
*{ "$class\::new" }{ CODE }
|
||||
or eval "require $class" ## no critic qw(ProhibitStringyEval)
|
||||
or die $@;
|
||||
}
|
||||
# create object
|
||||
# set current object
|
||||
$current_of{ $ident } = $class->new({
|
||||
map { $_->{ Name } => $_->{ Value } }
|
||||
values %{ $element->{ Attributes } }
|
||||
});
|
||||
|
||||
# remember top level element
|
||||
defined $data_of{ $ident }
|
||||
or ($data_of{ $ident } = $current_of{ $ident });
|
||||
}
|
||||
|
||||
sub characters {
|
||||
$characters_of{ ident $_[0] } .= $_[1]->{ Data };
|
||||
}
|
||||
|
||||
sub end_element {
|
||||
# $_[n] used for performance
|
||||
my ($ident, $element) = (ident $_[0], $_[1]);
|
||||
|
||||
# This one easily handles ignores for us, too...
|
||||
return if not ref $list_of{ $ident }->[-1];
|
||||
|
||||
if ( $current_of{ $ident }
|
||||
->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType') ) {
|
||||
$current_of{ $ident }->set_value( $characters_of{ $ident } );
|
||||
}
|
||||
|
||||
# set appropriate attribute in last element
|
||||
# multiple values must be implemented in base class
|
||||
my $method = "add_$element->{ LocalName }";
|
||||
|
||||
$list_of{ $ident }->[-1]->$method( $current_of{ $ident } );
|
||||
|
||||
# step up in path
|
||||
pop @{ $path_of{ $ident } };
|
||||
|
||||
# step up in object hierarchy...
|
||||
$current_of{ $ident } = pop @{ $list_of{ $ident } };
|
||||
}
|
||||
|
||||
sub end_document {
|
||||
my $self = shift;
|
||||
my $ident = ident $self;
|
||||
|
||||
# destroy all remains except data_of
|
||||
$list_of{ $ident } = ();
|
||||
$namespace_of{ $ident } = ();
|
||||
$ignore_of{ $ident } = ();
|
||||
$path_of{ $ident } = ();
|
||||
$characters_of{ $ident } = ();
|
||||
}
|
||||
|
||||
sub get_data {
|
||||
my $self = shift;
|
||||
return $data_of{ ident $self };
|
||||
}
|
||||
|
||||
sub fatal_error {
|
||||
my $self = shift;
|
||||
die "Fatal error parsing document: " , @_;
|
||||
}
|
||||
|
||||
sub error {
|
||||
my $self = shift;
|
||||
die "Error parsing document: " , @_;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::SAX::MessageHandler - Convert SOAP messages to custom object trees
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# this is the direct variant, recommended for performance
|
||||
use SOAP::WSDL::SAX::MessageHandler;
|
||||
use XML::LibXML;
|
||||
|
||||
my $filter = SOAP::WSDL::SAX::MessageHandler->new( {
|
||||
class_resolver => FakeResolver->new()
|
||||
), "Object creation");
|
||||
my $parser = XML::LibXML->new();
|
||||
$parser->set_handler( $filter );
|
||||
|
||||
$parser->parse_string( $soap_message );
|
||||
|
||||
my $object_tree = $filter->get_data();
|
||||
|
||||
|
||||
# This is the XML::ParserFactory variant - for those who want other
|
||||
# parsers than XML::Simple....
|
||||
use SOAP::WSDL::SAX::MessageHandler;
|
||||
use XML::SAX::ParserFactory;
|
||||
|
||||
my $filter = SOAP::WSDL::SAX::MessageHandler->new( {
|
||||
class_resolver => FakeResolver->new(),
|
||||
base => 'XML::SAX::Base',
|
||||
), "Object creation");
|
||||
my $parser = XML::SAX::ParserFactor->parser(
|
||||
Handler => $handler
|
||||
);
|
||||
$parser->parse_string( $soap_message );
|
||||
|
||||
my $object_tree = $filter->get_data();
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SAX handler for parsing SOAP messages.
|
||||
|
||||
See L<SOAP::WSDL::Parser> for details.
|
||||
|
||||
=head1 Bugs and Limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * Ignores all namespaces
|
||||
|
||||
=item * Does not handle mixed content
|
||||
|
||||
=item * The SOAP header is ignored
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Replace the whitespace by @ for E-Mail Address.
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
This module may be used under the same terms as perl itself.
|
||||
|
||||
=head1 Repository information
|
||||
|
||||
$ID: $
|
||||
|
||||
$LastChangedDate: $
|
||||
$LastChangedRevision: $
|
||||
$LastChangedBy: $
|
||||
|
||||
$HeadURL: $
|
||||
|
||||
@@ -1,165 +0,0 @@
|
||||
package SOAP::WSDL::SAX::WSDLHandler;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Class::Std::Storable;
|
||||
# use base qw(XML::SAX::Base);
|
||||
use SOAP::WSDL::TypeLookup;
|
||||
|
||||
my %tree_of :ATTR(:name<tree> :default<{}>);
|
||||
my %order_of :ATTR(:name<order> :default<[]>);
|
||||
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
|
||||
my %current_of :ATTR(:name<current> :default<()>);
|
||||
|
||||
{
|
||||
# we have to implement our own new - we need a blessed Hash ref as $self
|
||||
# for being able to inherit from XML::SAX::Base...
|
||||
no warnings qw(redefine);
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = {}; # $class->SUPER::new(@_);
|
||||
my $args = shift || {};
|
||||
|
||||
die "arguments to new must be single hash ref"
|
||||
if @_ or ! ref $args eq 'HASH';
|
||||
|
||||
# nasty, but for those who want to use XML::SAX::Base or similar
|
||||
# as parser factory
|
||||
if ($args->{base}) {
|
||||
# yup, naughty string eval
|
||||
eval "use base qw($args->{base})"; ## no critic qw(ProhibitStringyEval)
|
||||
}
|
||||
else {
|
||||
# create all those SAX methods...
|
||||
# ...we ignore em all...
|
||||
no strict qw(refs);
|
||||
foreach my $method ( qw(
|
||||
characters
|
||||
processing_instruction
|
||||
ignorable_whitespace
|
||||
set_document_locator
|
||||
start_prefix_mapping
|
||||
end_prefix_mapping
|
||||
skipped_entity
|
||||
start_cdata
|
||||
end_cdata
|
||||
comment
|
||||
entity_reference
|
||||
notation_decl
|
||||
unparsed_entity_decl
|
||||
element_decl
|
||||
attlist_decl
|
||||
doctype_decl
|
||||
xml_decl
|
||||
entity_decl
|
||||
attribute_decl
|
||||
internal_entity_decl
|
||||
external_entity_decl
|
||||
resolve_entity
|
||||
start_dtd
|
||||
end_dtd
|
||||
start_entity
|
||||
end_entity
|
||||
warning
|
||||
error
|
||||
) ) {
|
||||
*{ "$method" } = sub {};
|
||||
}
|
||||
}
|
||||
|
||||
return bless $self, $class;
|
||||
}
|
||||
};
|
||||
|
||||
sub start_document {
|
||||
my $ident = ident $_[0];
|
||||
$tree_of{ $ident } = {};
|
||||
$order_of{ $ident } = [];
|
||||
$targetNamespace_of{ $ident } = undef;
|
||||
$current_of{ $ident } = undef;
|
||||
}
|
||||
|
||||
sub start_element {
|
||||
my ($self, $element) = @_;
|
||||
my $ident = ident $self;
|
||||
|
||||
my $action = SOAP::WSDL::TypeLookup->lookup(
|
||||
$element->{ NamespaceURI },
|
||||
$element->{ LocalName }
|
||||
);
|
||||
|
||||
return if not $action;
|
||||
|
||||
if ($action->{ type } eq 'CLASS') {
|
||||
eval "require $action->{ class }";
|
||||
croak $@, $tree_of{ $ident } if ($@);
|
||||
|
||||
my $class = $action->{ class };
|
||||
my $obj = $class->new({ parent => $current_of{ $ident } })->init(
|
||||
values %{ $element->{ Attributes } }
|
||||
);
|
||||
|
||||
# set element in parent
|
||||
if ($current_of{ $ident }) {
|
||||
# inherit namespace, but don't override
|
||||
$obj->set_targetNamespace(
|
||||
$current_of{ $ident }->get_targetNamespace() )
|
||||
if not $obj->get_targetNamespace();
|
||||
|
||||
# push on name list
|
||||
my $method = "push_$element->{ LocalName }";
|
||||
no strict qw(refs);
|
||||
$current_of{ $ident }->$method( $obj );
|
||||
|
||||
# remember element for stepping back
|
||||
push @{ $order_of{ $ident } }, $current_of{ $ident };
|
||||
}
|
||||
else {
|
||||
$tree_of{ $ident } = $obj;
|
||||
}
|
||||
# set new element (step down)
|
||||
$current_of{ $ident } = $obj;
|
||||
}
|
||||
elsif ($action->{ type } eq 'PARENT') {
|
||||
$current_of{ $ident }->init( values %{ $element->{ Attributes } } );
|
||||
}
|
||||
elsif ($action->{ type } eq 'METHOD') {
|
||||
my $method = $action->{ method } || $element->{ LocalName };
|
||||
|
||||
no strict qw(refs);
|
||||
# call method with
|
||||
# - default value ($action->{ value } if defined,
|
||||
# dereferencing lists
|
||||
# - the values of the elements Attributes hash
|
||||
$current_of{ $ident }->$method( defined $action->{ value }
|
||||
? ref $action->{ value }
|
||||
? @{ $action->{ value } }
|
||||
: ($action->{ value })
|
||||
: values %{ $element->{ Attributes } } );
|
||||
}
|
||||
}
|
||||
|
||||
sub end_element {
|
||||
my ($self, $element) = @_;
|
||||
my $ident = ident $self;
|
||||
|
||||
my $action = SOAP::WSDL::TypeLookup->lookup(
|
||||
$element->{ NamespaceURI },
|
||||
$element->{ LocalName }
|
||||
) || {};
|
||||
|
||||
if ($action->{ type } && $action->{ type } eq 'CLASS' )
|
||||
{
|
||||
$current_of{ $ident } = pop @{ $order_of{ $ident } };
|
||||
}
|
||||
}
|
||||
|
||||
sub fatal_error {
|
||||
die @_;
|
||||
}
|
||||
|
||||
sub get_data {
|
||||
my $self = shift;
|
||||
return $tree_of{ ident $self };
|
||||
}
|
||||
1;
|
||||
@@ -0,0 +1,9 @@
|
||||
package SOAP::WSDL::SOAP::Address;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
|
||||
my %location :ATTR(:name<location> :default<()>);
|
||||
1;
|
||||
@@ -0,0 +1,11 @@
|
||||
package SOAP::WSDL::SOAP::Body;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %use_of :ATTR(:name<use> :default<q{}>);
|
||||
my %namespace_of :ATTR(:name<namespace> :default<q{}>);
|
||||
my %encodingStyle_of :ATTR(:name<encodingStyle> :default<q{}>);
|
||||
my %parts_of :ATTR(:name<parts> :default<q{}>);
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,12 @@
|
||||
package SOAP::WSDL::SOAP::Header;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %use_of :ATTR(:name<use> :default<q{}>);
|
||||
my %namespace_of :ATTR(:name<namespace> :default<q{}>);
|
||||
my %encodingStyle_of :ATTR(:name<encodingStyle> :default<q{}>);
|
||||
my %message_of :ATTR(:name<message> :default<()>);
|
||||
my %part_of :ATTR(:name<part> :default<q{}>);
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,6 @@
|
||||
package SOAP::WSDL::SOAP::HeaderFault;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(SOAP::WSDL::Header);
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,12 @@
|
||||
package SOAP::WSDL::SOAP::Operation;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
our $VERSION='2.00_17';
|
||||
|
||||
my %style_of :ATTR(:name<style> :default<()>);
|
||||
my %soapAction_of :ATTR(:name<soapAction> :default<()>);
|
||||
|
||||
1;
|
||||
Loaded 100 of 256 files, more files were not shown because too many files have changed in this diff.
Show more
Reference in new issue
Block a user