Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
3d11524449 | ||
|
|
21efa286af | ||
|
|
008d06b72a | ||
|
|
c6a48ba84b | ||
|
|
30be0da3dc | ||
|
|
2347a88353 | ||
|
|
9e85f63aa0 | ||
|
|
7ba2f93e44 | ||
|
|
099c83b6bc | ||
|
|
f63138fc87 | ||
|
|
fd0854e34a | ||
|
|
c2da74b5ae | ||
|
|
7ba1959888 | ||
|
|
a554e87f49 | ||
|
|
312f3d6bbd |
@@ -1,40 +1,50 @@
|
|||||||
use Module::Build;
|
use Module::Build;
|
||||||
Module::Build->new(
|
|
||||||
dist_abstract => 'SOAP with WSDL support',
|
$build = Module::Build->new(
|
||||||
dist_name => 'SOAP-WSDL',
|
create_makefile_pl => 'passthrough',
|
||||||
dist_version => '2.00_07',
|
dist_abstract => 'SOAP with WSDL support',
|
||||||
module_name => 'SOAP::WSDL',
|
dist_name => 'SOAP-WSDL',
|
||||||
license => 'artistic',
|
dist_version => '2.00_19',
|
||||||
requires => {
|
module_name => 'SOAP::WSDL',
|
||||||
'Class::Std' => q/v0.0.8/,
|
license => 'artistic',
|
||||||
'Class::Std::Storable' => 0,
|
requires => {
|
||||||
'SOAP::Lite' => 0,
|
'Class::Std' => q/v0.0.8/,
|
||||||
'List::Util' => 0,
|
'Class::Std::Storable' => 0,
|
||||||
'File::Basename' => 0,
|
'Data::Dumper' => 0,
|
||||||
'File::Path' => 0,
|
'Date::Parse' => 0,
|
||||||
'XML::XPath' => 0,
|
'Date::Format' => 0,
|
||||||
'XML::LibXML' => 0,
|
'File::Basename' => 0,
|
||||||
'XML::SAX::Base' => 0,
|
'File::Path' => 0,
|
||||||
'XML::SAX::ParserFactory' => 0,
|
'Getopt::Long' => 0,
|
||||||
'XML::Parser::Expat' => 0,
|
'List::Util' => 0,
|
||||||
|
'LWP::UserAgent' => 0,
|
||||||
|
'Template' => 0,
|
||||||
|
'Term::ReadKey' => 0,
|
||||||
|
'XML::Parser::Expat' => 0,
|
||||||
},
|
},
|
||||||
buildrequires => {
|
buildrequires => {
|
||||||
'Benchmark' => 0,
|
'Class::Std' => q/v0.0.8/,
|
||||||
'Cwd' => 0,
|
'Class::Std::Storable' => 0,
|
||||||
'Test::More' => 0,
|
'Cwd' => 0,
|
||||||
'SOAP::Lite' => 0,
|
'Date::Parse' => 0,
|
||||||
'Class::Std' => 0.0.8,
|
'Date::Format' => 0,
|
||||||
'Class::Std::Storable' => 0,
|
'Getopt::Long' => 0,
|
||||||
'List::Util' => 0,
|
'List::Util' => 0,
|
||||||
'File::Basename' => 0,
|
'LWP::UserAgent' => 0,
|
||||||
'File::Path' => 0,
|
'File::Basename' => 0,
|
||||||
'XML::Simple' => 0,
|
'File::Path' => 0,
|
||||||
'XML::LibXML' => 0,
|
'File::Spec' => 0,
|
||||||
'XML::Parser::Expat' => 0,
|
'Storable' => 0,
|
||||||
'XML::SAX::Base' => 0,
|
'Test::More' => 0,
|
||||||
'XML::SAX::ParserFactory' => 0,
|
'Template' => 0,
|
||||||
'Pod::Simple::Text' => 0,
|
'XML::Parser::Expat' => 0,
|
||||||
'XML::SAX::ParserFactory' => 0,
|
|
||||||
},
|
},
|
||||||
recursive_test_files => 1,
|
recursive_test_files => 1,
|
||||||
)->create_build_script;
|
meta_add => {
|
||||||
|
no_index => {
|
||||||
|
namespace => 'SOAP::WSDL::Generator::Template::XSD',
|
||||||
|
},
|
||||||
|
}
|
||||||
|
);
|
||||||
|
$build->add_build_element('tt');
|
||||||
|
$build->create_build_script;
|
||||||
|
|||||||
@@ -1 +1,371 @@
|
|||||||
See perldoc SOAP::WSDL
|
Release notes for SOAP::WSDL 2.00_19
|
||||||
|
-------
|
||||||
|
|
||||||
|
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_19
|
||||||
|
----
|
||||||
|
The following features were added (the numbers in square brackets are the
|
||||||
|
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
|
||||||
|
|
||||||
|
* [ 1810395 ] Implement complexType complexContent extension
|
||||||
|
|
||||||
|
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):
|
||||||
|
|
||||||
|
* [ 1813144 ] Typemap not used in interface class
|
||||||
|
* [ 1810058 ] .tt's pod indexed on CPAN
|
||||||
|
|
||||||
|
The following uncategorized improvements have been made:
|
||||||
|
|
||||||
|
* Documentation improvements
|
||||||
|
|
||||||
|
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
|
bin/wsdl2perl.pl
|
||||||
Build.PL
|
Build.PL
|
||||||
CHANGES
|
CHANGES
|
||||||
@@ -20,7 +26,9 @@ example/lib/MyInterfaces/FullerData_x0020_Fortune_x0020_Cookie.pm
|
|||||||
example/lib/MyInterfaces/GlobalWeather.pm
|
example/lib/MyInterfaces/GlobalWeather.pm
|
||||||
example/lib/MyTypemaps/FullerData_x0020_Fortune_x0020_Cookie.pm
|
example/lib/MyTypemaps/FullerData_x0020_Fortune_x0020_Cookie.pm
|
||||||
example/lib/MyTypemaps/GlobalWeather.pm
|
example/lib/MyTypemaps/GlobalWeather.pm
|
||||||
|
example/visitor/visitor.pl
|
||||||
example/weather.pl
|
example/weather.pl
|
||||||
|
example/weather_wsdl.pl
|
||||||
example/wsdl/FortuneCookie.xml
|
example/wsdl/FortuneCookie.xml
|
||||||
example/wsdl/genericbarcode.xml
|
example/wsdl/genericbarcode.xml
|
||||||
example/wsdl/globalweather.xml
|
example/wsdl/globalweather.xml
|
||||||
@@ -31,28 +39,85 @@ lib/SOAP/WSDL/Binding.pm
|
|||||||
lib/SOAP/WSDL/Client.pm
|
lib/SOAP/WSDL/Client.pm
|
||||||
lib/SOAP/WSDL/Client/Base.pm
|
lib/SOAP/WSDL/Client/Base.pm
|
||||||
lib/SOAP/WSDL/Definitions.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/MessageParser.pm
|
||||||
lib/SOAP/WSDL/Expat/MessageStreamParser.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/extension.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/complexType/variety.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.pod
|
||||||
lib/SOAP/WSDL/Manual/Glossary.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/Message.pm
|
||||||
lib/SOAP/WSDL/Operation.pm
|
lib/SOAP/WSDL/Operation.pm
|
||||||
lib/SOAP/WSDL/OpMessage.pm
|
lib/SOAP/WSDL/OpMessage.pm
|
||||||
lib/SOAP/WSDL/Parser.pod
|
|
||||||
lib/SOAP/WSDL/Part.pm
|
lib/SOAP/WSDL/Part.pm
|
||||||
lib/SOAP/WSDL/Port.pm
|
lib/SOAP/WSDL/Port.pm
|
||||||
lib/SOAP/WSDL/PortType.pm
|
lib/SOAP/WSDL/PortType.pm
|
||||||
lib/SOAP/WSDL/SAX/MessageHandler.pm
|
lib/SOAP/WSDL/Serializer/SOAP11.pm
|
||||||
lib/SOAP/WSDL/SAX/WSDLHandler.pm
|
|
||||||
lib/SOAP/WSDL/Service.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/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/TypeLookup.pm
|
||||||
lib/SOAP/WSDL/Types.pm
|
lib/SOAP/WSDL/Types.pm
|
||||||
|
lib/SOAP/WSDL/XSD/Builtin.pm
|
||||||
lib/SOAP/WSDL/XSD/ComplexType.pm
|
lib/SOAP/WSDL/XSD/ComplexType.pm
|
||||||
lib/SOAP/WSDL/XSD/Element.pm
|
lib/SOAP/WSDL/XSD/Element.pm
|
||||||
lib/SOAP/WSDL/XSD/Primitive.pm
|
|
||||||
lib/SOAP/WSDL/XSD/Schema.pm
|
lib/SOAP/WSDL/XSD/Schema.pm
|
||||||
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
||||||
lib/SOAP/WSDL/XSD/SimpleType.pm
|
lib/SOAP/WSDL/XSD/SimpleType.pm
|
||||||
@@ -107,14 +172,16 @@ lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
|
|||||||
lib/SOAP/WSDL/XSD/Typelib/Element.pm
|
lib/SOAP/WSDL/XSD/Typelib/Element.pm
|
||||||
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||||
LICENSE
|
LICENSE
|
||||||
|
MAINFEST
|
||||||
|
Makefile.PL
|
||||||
MANIFEST
|
MANIFEST
|
||||||
META.yml
|
META.yml
|
||||||
README
|
README
|
||||||
t/001_use.t
|
t/001_use.t
|
||||||
t/002_sax.t
|
t/002_parse_wsdl.t
|
||||||
t/003_sax_serializer.t
|
t/003_wsdl_based_serializer.t
|
||||||
t/004_sax_wsdl.t
|
t/004_parse_wsdl.t
|
||||||
t/005_sax_contributed_wsdl.t
|
t/005_parse_contributed.t
|
||||||
t/006_client.t
|
t/006_client.t
|
||||||
t/007_envelope.t
|
t/007_envelope.t
|
||||||
t/008_client_wsdl_complexType.t
|
t/008_client_wsdl_complexType.t
|
||||||
@@ -122,10 +189,9 @@ t/009_data_classes.t
|
|||||||
t/011_simpleType.t
|
t/011_simpleType.t
|
||||||
t/012_element.t
|
t/012_element.t
|
||||||
t/013_complexType.t
|
t/013_complexType.t
|
||||||
t/014_sax_typelib.t
|
|
||||||
t/015_to_typemap.t
|
|
||||||
t/016_client_object.t
|
t/016_client_object.t
|
||||||
t/017_generator.t
|
t/017_generator.t
|
||||||
|
t/018_compat_2_00_15-generator.t
|
||||||
t/020_storable.t
|
t/020_storable.t
|
||||||
t/098_pod.t
|
t/098_pod.t
|
||||||
t/acceptance/results/03_complexType-all.xml
|
t/acceptance/results/03_complexType-all.xml
|
||||||
@@ -140,6 +206,7 @@ t/acceptance/wsdl/006_sax_client.wsdl
|
|||||||
t/acceptance/wsdl/008_complexType.wsdl
|
t/acceptance/wsdl/008_complexType.wsdl
|
||||||
t/acceptance/wsdl/02_port.wsdl
|
t/acceptance/wsdl/02_port.wsdl
|
||||||
t/acceptance/wsdl/03_complexType-all.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/03_complexType-sequence.wsdl
|
||||||
t/acceptance/wsdl/04_element-simpleType.wsdl
|
t/acceptance/wsdl/04_element-simpleType.wsdl
|
||||||
t/acceptance/wsdl/04_element.wsdl
|
t/acceptance/wsdl/04_element.wsdl
|
||||||
@@ -152,11 +219,21 @@ t/acceptance/wsdl/contributed/Axis.wsdl
|
|||||||
t/acceptance/wsdl/contributed/ETest.wsdl
|
t/acceptance/wsdl/contributed/ETest.wsdl
|
||||||
t/acceptance/wsdl/contributed/OITest.wsdl
|
t/acceptance/wsdl/contributed/OITest.wsdl
|
||||||
t/acceptance/wsdl/contributed/tools.wsdl
|
t/acceptance/wsdl/contributed/tools.wsdl
|
||||||
|
t/acceptance/wsdl/elementAtomicComplexType.xml
|
||||||
t/acceptance/wsdl/email_account.wsdl
|
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/01_expat.t
|
||||||
|
t/Expat/03_wsdl.t
|
||||||
t/lib/MyComplexType.pm
|
t/lib/MyComplexType.pm
|
||||||
t/lib/MyElement.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/MySimpleType.pm
|
||||||
|
t/lib/MyTypemaps/GlobalWeather.pm
|
||||||
t/lib/Test/SOAPMessage.pm
|
t/lib/Test/SOAPMessage.pm
|
||||||
t/lib/Typelib/Base.pm
|
t/lib/Typelib/Base.pm
|
||||||
t/lib/Typelib/TEnqueueMessage.pm
|
t/lib/Typelib/TEnqueueMessage.pm
|
||||||
@@ -166,6 +243,7 @@ t/SOAP/WSDL/02_port.t
|
|||||||
t/SOAP/WSDL/03_complexType-all.t
|
t/SOAP/WSDL/03_complexType-all.t
|
||||||
t/SOAP/WSDL/03_complexType-choice.t
|
t/SOAP/WSDL/03_complexType-choice.t
|
||||||
t/SOAP/WSDL/03_complexType-complexContent.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-group.t
|
||||||
t/SOAP/WSDL/03_complexType-sequence.t
|
t/SOAP/WSDL/03_complexType-sequence.t
|
||||||
t/SOAP/WSDL/03_complexType-simpleContent.t
|
t/SOAP/WSDL/03_complexType-simpleContent.t
|
||||||
@@ -175,8 +253,64 @@ t/SOAP/WSDL/04_element.t
|
|||||||
t/SOAP/WSDL/05_simpleType-list.t
|
t/SOAP/WSDL/05_simpleType-list.t
|
||||||
t/SOAP/WSDL/05_simpleType-restriction.t
|
t/SOAP/WSDL/05_simpleType-restriction.t
|
||||||
t/SOAP/WSDL/05_simpleType-union.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/11_helloworld.NET.t
|
||||||
t/SOAP/WSDL/12_binding.pl
|
t/SOAP/WSDL/12_binding.t
|
||||||
t/SOAP/WSDL/XSD/Typelib/Builtin/001_string.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
|
TODO
|
||||||
|
|||||||
@@ -1,45 +1,83 @@
|
|||||||
---
|
---
|
||||||
name: SOAP-WSDL
|
name: SOAP-WSDL
|
||||||
version: 2.00_07
|
version: 2.00_19
|
||||||
author:
|
author: []
|
||||||
abstract: SOAP with WSDL support
|
abstract: SOAP with WSDL support
|
||||||
license: artistic
|
license: artistic
|
||||||
|
resources:
|
||||||
|
license: http://opensource.org/licenses/artistic-license.php
|
||||||
requires:
|
requires:
|
||||||
Class::Std: v0.0.8
|
Class::Std: v0.0.8
|
||||||
Class::Std::Storable: 0
|
Class::Std::Storable: 0
|
||||||
|
Data::Dumper: 0
|
||||||
|
Date::Format: 0
|
||||||
|
Date::Parse: 0
|
||||||
File::Basename: 0
|
File::Basename: 0
|
||||||
File::Path: 0
|
File::Path: 0
|
||||||
|
Getopt::Long: 0
|
||||||
|
LWP::UserAgent: 0
|
||||||
List::Util: 0
|
List::Util: 0
|
||||||
SOAP::Lite: 0
|
Template: 0
|
||||||
XML::LibXML: 0
|
Term::ReadKey: 0
|
||||||
XML::Parser::Expat: 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:
|
provides:
|
||||||
SOAP::WSDL:
|
SOAP::WSDL:
|
||||||
file: lib/SOAP/WSDL.pm
|
file: lib/SOAP/WSDL.pm
|
||||||
version: 2.00_05
|
version: 2.00_17
|
||||||
SOAP::WSDL::Base:
|
SOAP::WSDL::Base:
|
||||||
file: lib/SOAP/WSDL/Base.pm
|
file: lib/SOAP/WSDL/Base.pm
|
||||||
|
version: 2.00_17
|
||||||
SOAP::WSDL::Binding:
|
SOAP::WSDL::Binding:
|
||||||
file: lib/SOAP/WSDL/Binding.pm
|
file: lib/SOAP/WSDL/Binding.pm
|
||||||
SOAP::WSDL::Client:
|
SOAP::WSDL::Client:
|
||||||
file: lib/SOAP/WSDL/Client.pm
|
file: lib/SOAP/WSDL/Client.pm
|
||||||
|
version: 2.00_17
|
||||||
SOAP::WSDL::Client::Base:
|
SOAP::WSDL::Client::Base:
|
||||||
file: lib/SOAP/WSDL/Client/Base.pm
|
file: lib/SOAP/WSDL/Client/Base.pm
|
||||||
|
version: 2.00_17
|
||||||
SOAP::WSDL::Definitions:
|
SOAP::WSDL::Definitions:
|
||||||
file: lib/SOAP/WSDL/Definitions.pm
|
file: lib/SOAP/WSDL/Definitions.pm
|
||||||
SOAP::WSDL::Envelope:
|
version: 2.00_17
|
||||||
file: lib/SOAP/WSDL/Envelope.pm
|
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:
|
SOAP::WSDL::Expat::MessageParser:
|
||||||
file: lib/SOAP/WSDL/Expat/MessageParser.pm
|
file: lib/SOAP/WSDL/Expat/MessageParser.pm
|
||||||
SOAP::WSDL::Expat::MessageStreamParser:
|
SOAP::WSDL::Expat::MessageStreamParser:
|
||||||
file: lib/SOAP/WSDL/Expat/MessageStreamParser.pm
|
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:
|
SOAP::WSDL::Message:
|
||||||
file: lib/SOAP/WSDL/Message.pm
|
file: lib/SOAP/WSDL/Message.pm
|
||||||
SOAP::WSDL::OpMessage:
|
SOAP::WSDL::OpMessage:
|
||||||
@@ -52,32 +90,55 @@ provides:
|
|||||||
file: lib/SOAP/WSDL/Port.pm
|
file: lib/SOAP/WSDL/Port.pm
|
||||||
SOAP::WSDL::PortType:
|
SOAP::WSDL::PortType:
|
||||||
file: lib/SOAP/WSDL/PortType.pm
|
file: lib/SOAP/WSDL/PortType.pm
|
||||||
SOAP::WSDL::SAX::MessageHandler:
|
SOAP::WSDL::SOAP::Address:
|
||||||
file: lib/SOAP/WSDL/SAX/MessageHandler.pm
|
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:
|
SOAP::WSDL::SOAP::Typelib::Fault11:
|
||||||
file: lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
|
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:
|
SOAP::WSDL::Service:
|
||||||
file: lib/SOAP/WSDL/Service.pm
|
file: lib/SOAP/WSDL/Service.pm
|
||||||
SOAP::WSDL::SoapOperation:
|
SOAP::WSDL::Transport::HTTP:
|
||||||
file: lib/SOAP/WSDL/SoapOperation.pm
|
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:
|
SOAP::WSDL::TypeLookup:
|
||||||
file: lib/SOAP/WSDL/TypeLookup.pm
|
file: lib/SOAP/WSDL/TypeLookup.pm
|
||||||
SOAP::WSDL::Types:
|
SOAP::WSDL::Types:
|
||||||
file: lib/SOAP/WSDL/Types.pm
|
file: lib/SOAP/WSDL/Types.pm
|
||||||
|
SOAP::WSDL::XSD::Builtin:
|
||||||
|
file: lib/SOAP/WSDL/XSD/Builtin.pm
|
||||||
SOAP::WSDL::XSD::ComplexType:
|
SOAP::WSDL::XSD::ComplexType:
|
||||||
file: lib/SOAP/WSDL/XSD/ComplexType.pm
|
file: lib/SOAP/WSDL/XSD/ComplexType.pm
|
||||||
|
version: 2.00_17
|
||||||
SOAP::WSDL::XSD::Element:
|
SOAP::WSDL::XSD::Element:
|
||||||
file: lib/SOAP/WSDL/XSD/Element.pm
|
file: lib/SOAP/WSDL/XSD/Element.pm
|
||||||
SOAP::WSDL::XSD::Primitive:
|
version: 2.00_17
|
||||||
file: lib/SOAP/WSDL/XSD/Primitive.pm
|
|
||||||
SOAP::WSDL::XSD::Schema:
|
SOAP::WSDL::XSD::Schema:
|
||||||
file: lib/SOAP/WSDL/XSD/Schema.pm
|
file: lib/SOAP/WSDL/XSD/Schema.pm
|
||||||
SOAP::WSDL::XSD::Schema::Builtin:
|
SOAP::WSDL::XSD::Schema::Builtin:
|
||||||
file: lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
file: lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
||||||
SOAP::WSDL::XSD::SimpleType:
|
SOAP::WSDL::XSD::SimpleType:
|
||||||
file: lib/SOAP/WSDL/XSD/SimpleType.pm
|
file: lib/SOAP/WSDL/XSD/SimpleType.pm
|
||||||
|
version: 2.00_17
|
||||||
SOAP::WSDL::XSD::Typelib::Builtin:
|
SOAP::WSDL::XSD::Typelib::Builtin:
|
||||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
|
||||||
|
version: 2.00_17
|
||||||
SOAP::WSDL::XSD::Typelib::Builtin::ENTITY:
|
SOAP::WSDL::XSD::Typelib::Builtin::ENTITY:
|
||||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
|
||||||
SOAP::WSDL::XSD::Typelib::Builtin::ID:
|
SOAP::WSDL::XSD::Typelib::Builtin::ID:
|
||||||
@@ -108,6 +169,7 @@ provides:
|
|||||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
|
||||||
SOAP::WSDL::XSD::Typelib::Builtin::boolean:
|
SOAP::WSDL::XSD::Typelib::Builtin::boolean:
|
||||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
|
||||||
|
version: 2.00_17
|
||||||
SOAP::WSDL::XSD::Typelib::Builtin::byte:
|
SOAP::WSDL::XSD::Typelib::Builtin::byte:
|
||||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
|
||||||
SOAP::WSDL::XSD::Typelib::Builtin::date:
|
SOAP::WSDL::XSD::Typelib::Builtin::date:
|
||||||
@@ -160,6 +222,7 @@ provides:
|
|||||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
|
||||||
SOAP::WSDL::XSD::Typelib::Builtin::time:
|
SOAP::WSDL::XSD::Typelib::Builtin::time:
|
||||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
|
||||||
|
version: 2.00_18
|
||||||
SOAP::WSDL::XSD::Typelib::Builtin::token:
|
SOAP::WSDL::XSD::Typelib::Builtin::token:
|
||||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
|
||||||
SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte:
|
SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte:
|
||||||
@@ -172,11 +235,16 @@ provides:
|
|||||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
|
||||||
SOAP::WSDL::XSD::Typelib::ComplexType:
|
SOAP::WSDL::XSD::Typelib::ComplexType:
|
||||||
file: lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
|
||||||
|
version: 2.00_16
|
||||||
SOAP::WSDL::XSD::Typelib::Element:
|
SOAP::WSDL::XSD::Typelib::Element:
|
||||||
file: lib/SOAP/WSDL/XSD/Typelib/Element.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/Element.pm
|
||||||
SOAP::WSDL::XSD::Typelib::SimpleType:
|
SOAP::WSDL::XSD::Typelib::SimpleType:
|
||||||
file: lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||||
SOAP::WSDL::XSD::Typelib::SimpleType::restriction:
|
SOAP::WSDL::XSD::Typelib::SimpleType::restriction:
|
||||||
file: lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
file: lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||||
resources:
|
generated_by: Module::Build version 0.2808
|
||||||
license: http://opensource.org/licenses/artistic-license.php
|
meta-spec:
|
||||||
|
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
||||||
|
version: 1.2
|
||||||
|
no_index:
|
||||||
|
namespace: SOAP::WSDL::Generator::Template::XSD
|
||||||
|
|||||||
+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.
|
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,26 @@
|
|||||||
- remove benchmarks from tests. Create benchmark/ directory and store benchmarks in.
|
TODO list for SOAP::WSDL
|
||||||
- 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.
|
|
||||||
|
|
||||||
|
2.00 Pre-releases
|
||||||
|
--------
|
||||||
|
|
||||||
|
* 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
|
#!/usr/bin/perl -w
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use Fcntl;
|
|
||||||
use IO::File;
|
|
||||||
use Pod::Usage;
|
use Pod::Usage;
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
use LWP::Simple qw(get);
|
use LWP::UserAgent;
|
||||||
use SOAP::WSDL::SAX::WSDLHandler;
|
use SOAP::WSDL::Expat::WSDLParser;
|
||||||
use XML::LibXML;
|
use SOAP::WSDL::Factory::Generator;
|
||||||
|
use Term::ReadKey;
|
||||||
|
|
||||||
my %opt = (
|
my %opt = (
|
||||||
url => '',
|
url => '',
|
||||||
prefix => undef,
|
prefix => undef,
|
||||||
type_prefix => 'MyTypes::',
|
type_prefix => 'MyTypes',
|
||||||
element_prefix => 'MyElements::',
|
element_prefix => 'MyElements',
|
||||||
typemap_prefix => 'MyTypemaps::',
|
typemap_prefix => 'MyTypemaps',
|
||||||
interface_prefix => 'MyInterfaces::',
|
interface_prefix => 'MyInterfaces',
|
||||||
base_path => 'lib/',
|
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,
|
GetOptions(\%opt,
|
||||||
qw(
|
qw(
|
||||||
url|u=s
|
|
||||||
prefix|p=s
|
prefix|p=s
|
||||||
type_prefix|t=s
|
type_prefix|t=s
|
||||||
element_prefix|e=s
|
element_prefix|e=s
|
||||||
typemap_prefix|m=s
|
typemap_prefix|m=s
|
||||||
|
interface_prefix|i=s
|
||||||
base_path|b=s
|
base_path|b=s
|
||||||
typemap_include|mi=s
|
typemap_include|mi=s
|
||||||
help|h
|
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 => 2 ) if ($opt{help});
|
||||||
pod2usage( -exit => 1 , verbose => 1 ) if not ($url);
|
pod2usage( -exit => 1 , verbose => 1 ) if not ($url);
|
||||||
|
|
||||||
my $handler = SOAP::WSDL::SAX::WSDLHandler->new();
|
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
|
||||||
my $parser = XML::LibXML->new();
|
|
||||||
|
|
||||||
my $xml = get($url) or die "Could not load WSDL schema $url\n";
|
local $ENV{HTTP_PROXY} = $opt{proxy} if $opt{proxy};
|
||||||
|
local $ENV{HTTPS_PROXY} = $opt{proxy} if $opt{proxy};
|
||||||
|
|
||||||
$parser->set_handler( $handler );
|
my $lwp = LWP::UserAgent->new(
|
||||||
$parser->parse_string( $xml );
|
$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}) {
|
if ($opt{typemap_include}) {
|
||||||
my $fh = IO::File->new($opt{typemap_include} , O_RDONLY)
|
die "$opt{typemap_include} not found " if not -f $opt{typemap_include};
|
||||||
or die "cannot open typemap_include file $opt{typemap_include}\n";
|
%typemap = do $opt{typemap_include};
|
||||||
$opt{custom_types} = join q{}, $fh->getlines();
|
|
||||||
$fh->close();
|
|
||||||
delete $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
|
=pod
|
||||||
|
|
||||||
@@ -73,17 +133,26 @@ wsdl2perl.pl - create perl bindings for SOAP webservices.
|
|||||||
NAME SHORT DESCRITPION
|
NAME SHORT DESCRITPION
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
prefix p Prefix for both type and element classes.
|
prefix p Prefix for both type and element classes.
|
||||||
type_prefix t Prefix for type classes. Should end with '::'
|
type_prefix t Prefix for type classes.
|
||||||
Default: MyTypes::
|
Default: MyTypes
|
||||||
element_prefix e Prefix for element classes. Should end with '::'
|
element_prefix e Prefix for element classes.
|
||||||
Default: MyElements::
|
Default: MyElements
|
||||||
typemap_prefix m Prefix for typemap classes. Should end with '::'
|
typemap_prefix m Prefix for typemap classes.
|
||||||
Default: MyTypemaps::
|
Default: MyTypemaps
|
||||||
interface_prefix i Prefix for interface classes. Should end with '::'
|
interface_prefix i Prefix for interface classes.
|
||||||
Default: MyInterfaces::
|
Default: MyInterfaces
|
||||||
base_path b Path to create classes in.
|
base_path b Path to create classes in.
|
||||||
Default: ./lib
|
Default: .
|
||||||
typemap_include mi File to include in typemap.
|
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
|
help h Show help content
|
||||||
|
|
||||||
=head1 DESCRIPTION
|
=head1 DESCRIPTION
|
||||||
@@ -95,7 +164,7 @@ The following classes are created:
|
|||||||
|
|
||||||
=over
|
=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
|
Interface classes are what you will mainly deal with: They provide a method
|
||||||
for accessing every web service 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.
|
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>,
|
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
|
=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
|
=head1 LICENSE
|
||||||
|
|
||||||
Copyright 2007 Martin Kutter.
|
Copyright 2007 Martin Kutter.
|
||||||
|
|||||||
+30
-16
@@ -11,23 +11,37 @@
|
|||||||
|
|
||||||
use lib 'lib/';
|
use lib 'lib/';
|
||||||
use MyInterfaces::FullerData_x0020_Fortune_x0020_Cookie;
|
use MyInterfaces::FullerData_x0020_Fortune_x0020_Cookie;
|
||||||
use MyElements::GetFortuneCookie;
|
|
||||||
my $cookieService = MyInterfaces::FullerData_x0020_Fortune_x0020_Cookie->new();
|
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";
|
||||||
print $cookie->get_GetFortuneCookieResult()->get_value, "\n";
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
print $cookie;
|
|
||||||
}
|
|
||||||
|
|
||||||
$cookie = $cookieService->GetSpecificCookie({ index => 23 });
|
$cookie = $cookieService->GetSpecificCookie({ index => 23 })
|
||||||
if ($cookie) {
|
or die "$cookie";
|
||||||
print $cookie
|
|
||||||
->get_GetSpecificCookieResult(), "\n";
|
print $cookie->get_GetSpecificCookieResult(), "\n";
|
||||||
}
|
|
||||||
else {
|
print $cookie;
|
||||||
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 Class::Std::Storable;
|
||||||
use SOAP::WSDL::XSD::Typelib::Element;
|
use SOAP::WSDL::XSD::Typelib::Element;
|
||||||
|
|
||||||
|
|
||||||
# atomic complexType
|
# atomic complexType
|
||||||
# <element name="GetCitiesByCountry"><complexType> definition
|
# <element name="GetCitiesByCountry"><complexType> definition
|
||||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||||
@@ -46,9 +47,16 @@ __PACKAGE__->__set_ref('');
|
|||||||
|
|
||||||
__END__
|
__END__
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
=pod
|
=pod
|
||||||
|
|
||||||
=head1 NAME MyElements::GetCitiesByCountry
|
=head1 NAME
|
||||||
|
|
||||||
|
MyElements::GetCitiesByCountry
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ use strict;
|
|||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
use SOAP::WSDL::XSD::Typelib::Element;
|
use SOAP::WSDL::XSD::Typelib::Element;
|
||||||
|
|
||||||
|
|
||||||
# atomic complexType
|
# atomic complexType
|
||||||
# <element name="GetCitiesByCountryResponse"><complexType> definition
|
# <element name="GetCitiesByCountryResponse"><complexType> definition
|
||||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||||
@@ -46,9 +47,16 @@ __PACKAGE__->__set_ref('');
|
|||||||
|
|
||||||
__END__
|
__END__
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
=pod
|
=pod
|
||||||
|
|
||||||
=head1 NAME MyElements::GetCitiesByCountryResponse
|
=head1 NAME
|
||||||
|
|
||||||
|
MyElements::GetCitiesByCountryResponse
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ use strict;
|
|||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
use SOAP::WSDL::XSD::Typelib::Element;
|
use SOAP::WSDL::XSD::Typelib::Element;
|
||||||
|
|
||||||
|
|
||||||
# atomic complexType
|
# atomic complexType
|
||||||
# <element name="GetWeather"><complexType> definition
|
# <element name="GetWeather"><complexType> definition
|
||||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||||
@@ -54,9 +55,16 @@ __PACKAGE__->__set_ref('');
|
|||||||
|
|
||||||
__END__
|
__END__
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
=pod
|
=pod
|
||||||
|
|
||||||
=head1 NAME MyElements::GetWeather
|
=head1 NAME
|
||||||
|
|
||||||
|
MyElements::GetWeather
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ use strict;
|
|||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
use SOAP::WSDL::XSD::Typelib::Element;
|
use SOAP::WSDL::XSD::Typelib::Element;
|
||||||
|
|
||||||
|
|
||||||
# atomic complexType
|
# atomic complexType
|
||||||
# <element name="GetWeatherResponse"><complexType> definition
|
# <element name="GetWeatherResponse"><complexType> definition
|
||||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||||
@@ -46,9 +47,16 @@ __PACKAGE__->__set_ref('');
|
|||||||
|
|
||||||
__END__
|
__END__
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
=pod
|
=pod
|
||||||
|
|
||||||
=head1 NAME MyElements::GetWeatherResponse
|
=head1 NAME
|
||||||
|
|
||||||
|
MyElements::GetWeatherResponse
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ use strict;
|
|||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
use SOAP::WSDL::XSD::Typelib::Element;
|
use SOAP::WSDL::XSD::Typelib::Element;
|
||||||
|
|
||||||
|
|
||||||
#
|
#
|
||||||
# <element name="string" type="s:string"/> definition
|
# <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_name('string');
|
||||||
__PACKAGE__->__set_nillable(true);
|
__PACKAGE__->__set_nillable(true);
|
||||||
@@ -26,9 +27,16 @@ __PACKAGE__->__set_ref('');
|
|||||||
|
|
||||||
__END__
|
__END__
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
=pod
|
=pod
|
||||||
|
|
||||||
=head1 NAME MyElements::string
|
=head1 NAME
|
||||||
|
|
||||||
|
MyElements::string
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
|||||||
@@ -1,4 +1,5 @@
|
|||||||
package MyInterfaces::GlobalWeather;
|
package MyInterfaces::GlobalWeather;
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use MyTypemaps::GlobalWeather;
|
use MyTypemaps::GlobalWeather;
|
||||||
@@ -16,8 +17,18 @@ sub new {
|
|||||||
}
|
}
|
||||||
|
|
||||||
__PACKAGE__->__create_methods(
|
__PACKAGE__->__create_methods(
|
||||||
GetWeather => [ 'MyElements::GetWeather', ],
|
GetWeather => {
|
||||||
GetCitiesByCountry => [ 'MyElements::GetCitiesByCountry', ],
|
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__
|
__END__
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
=pod
|
=pod
|
||||||
|
|
||||||
=head1 NAME
|
=head1 NAME
|
||||||
@@ -38,222 +53,31 @@ http://www.webservicex.net/globalweather.asmx
|
|||||||
my $GetCitiesByCountry = $interface->GetCitiesByCountry();
|
my $GetCitiesByCountry = $interface->GetCitiesByCountry();
|
||||||
|
|
||||||
|
|
||||||
=head1 Service GlobalWeather
|
=head1 METHODS
|
||||||
|
|
||||||
=head2 Service information:
|
=head2 GetWeather
|
||||||
|
|
||||||
Port name: GlobalWeatherSoap
|
Get weather report for all major cities around the world.
|
||||||
Binding: tns:GlobalWeatherSoap
|
|
||||||
Location: http://www.webservicex.net/globalweather.asmx
|
|
||||||
|
|
||||||
=head2 SOAP Operations
|
SYNOPSIS:
|
||||||
|
|
||||||
B<Note:>
|
$service->GetWeather({
|
||||||
|
|
||||||
Input, output and fault messages are stated as perl hash refs.
|
|
||||||
|
|
||||||
These are only for informational purposes - the actual implementation
|
|
||||||
normally uses object trees, not hash refs, though the input messages
|
|
||||||
may be passed to the respective methods as hash refs and will be
|
|
||||||
converted to object trees automatically.
|
|
||||||
|
|
||||||
|
|
||||||
=head3 GetWeather
|
|
||||||
|
|
||||||
B<Input Message:>
|
|
||||||
|
|
||||||
{
|
|
||||||
'GetWeather'=> {
|
|
||||||
'CityName' => $someValue,
|
'CityName' => $someValue,
|
||||||
'CountryName' => $someValue,
|
'CountryName' => $someValue,
|
||||||
},
|
});
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
B<Output Message:>
|
=head2 GetCitiesByCountry
|
||||||
|
|
||||||
{
|
Get all major cities by country name(full / part).
|
||||||
'GetWeather'=> {
|
|
||||||
'CityName' => $someValue,
|
SYNOPSIS:
|
||||||
|
|
||||||
|
$service->GetCitiesByCountry({
|
||||||
'CountryName' => $someValue,
|
'CountryName' => $someValue,
|
||||||
},
|
});
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
B<Fault:>
|
|
||||||
|
|
||||||
|
=pod
|
||||||
|
|
||||||
|
|
||||||
=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
|
|
||||||
|
|
||||||
|
|||||||
@@ -3,6 +3,14 @@ use strict;
|
|||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
my %typemap = (
|
my %typemap = (
|
||||||
|
# SOAP 1.1 fault typemap
|
||||||
|
'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11',
|
||||||
|
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||||
|
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::TOKEN',
|
||||||
|
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||||
|
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||||
|
|
||||||
|
# generated typemap
|
||||||
'GetWeather' => 'MyElements::GetWeather',
|
'GetWeather' => 'MyElements::GetWeather',
|
||||||
# atomic complex type (sequence)
|
# atomic complex type (sequence)
|
||||||
'GetWeather/CityName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
'GetWeather/CityName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||||
@@ -24,12 +32,9 @@ my %typemap = (
|
|||||||
'GetCitiesByCountryResponse/GetCitiesByCountryResult' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
'GetCitiesByCountryResponse/GetCitiesByCountryResult' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||||
|
|
||||||
# end atomic complex type (sequence)
|
# end atomic complex type (sequence)
|
||||||
Fault => 'SOAP::WSDL::SOAP::Typelib::Fault11',
|
|
||||||
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
|
||||||
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
|
||||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
|
||||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
|
||||||
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
|
||||||
|
|
||||||
);
|
);
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
# 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.
|
# Use this script at your own risk.
|
||||||
|
#
|
||||||
|
# This script demonstrates the use of a interface generated by wsdl2perl.pl
|
||||||
|
|
||||||
use lib 'lib/';
|
use lib 'lib/';
|
||||||
use MyInterfaces::GlobalWeather;
|
use MyInterfaces::GlobalWeather;
|
||||||
my $webservice = MyInterfaces::GlobalWeather->new();
|
my $weather = MyInterfaces::GlobalWeather->new({ 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' });
|
print $result->get_GetWeatherResult()->get_value() , "\n";
|
||||||
|
|
||||||
if ($result) {
|
|
||||||
print $result->get_GetWeatherResult()->get_value(), "\n";
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
print $result;
|
|
||||||
}
|
|
||||||
|
|||||||
@@ -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;
|
package SOAP::WSDL;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use vars qw/$AUTOLOAD/;
|
use vars qw($AUTOLOAD);
|
||||||
|
use Carp;
|
||||||
use Scalar::Util qw(blessed);
|
use Scalar::Util qw(blessed);
|
||||||
use SOAP::WSDL::Envelope;
|
use SOAP::WSDL::Client;
|
||||||
use SOAP::WSDL::SAX::WSDLHandler;
|
use SOAP::WSDL::Expat::WSDLParser;
|
||||||
use base qw(SOAP::Lite);
|
use Class::Std;
|
||||||
use Data::Dumper;
|
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
|
||||||
|
use LWP::UserAgent;
|
||||||
|
|
||||||
our $VERSION='2.00_05';
|
our $VERSION='2.00_17';
|
||||||
|
|
||||||
BEGIN {
|
my %no_dispatch_of :ATTR(:name<no_dispatch>);
|
||||||
eval {
|
my %wsdl_of :ATTR(:name<wsdl>);
|
||||||
use XML::LibXML;
|
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 {
|
sub wsdlinit {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
my $ident = ident $self;
|
||||||
my %opt = @_;
|
my %opt = @_;
|
||||||
|
|
||||||
my $wsdl_xml = SOAP::Schema->new( schema_url => $self->wsdl() )->access(
|
my $lwp = LWP::UserAgent->new(
|
||||||
$self->wsdl()
|
$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 = SOAP::WSDL::Expat::WSDLParser->new();
|
||||||
my $parser = eval { XML::LibXML->new() };
|
$parser->parse_string( $response->content() );
|
||||||
if ($parser) {
|
|
||||||
$filter = SOAP::WSDL::SAX::WSDLHandler->new();
|
|
||||||
$parser->set_handler( $filter );
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$filter = SOAP::WSDL::SAX::WSDLHandler->new( base => 'XML::SAX::Base' );
|
|
||||||
$parser = XML::SAX::ParserFactory->parser( Handler => $filter );
|
|
||||||
}
|
|
||||||
|
|
||||||
$parser->parse_string( $wsdl_xml );
|
my $wsdl_definitions = $parser->get_data();
|
||||||
|
|
||||||
my $wsdl_definitions = $filter->get_data()
|
|
||||||
or die "unable to parse WSDL";
|
|
||||||
|
|
||||||
|
# sanity checks
|
||||||
my $types = $wsdl_definitions->first_types()
|
my $types = $wsdl_definitions->first_types()
|
||||||
or die "unable to extract schema from WSDL";
|
or die "unable to extract schema from WSDL";
|
||||||
|
|
||||||
my $ns = $wsdl_definitions->get_xmlns()
|
my $ns = $wsdl_definitions->get_xmlns()
|
||||||
or die "unable to extract XML Namespaces" . $wsdl_definitions->to_string;
|
or die "unable to extract XML Namespaces" . $wsdl_definitions->to_string;
|
||||||
( %{ $ns } ) or die "unable to extract XML Namespaces";
|
( %{ $ns } ) or die "unable to extract XML Namespaces";
|
||||||
|
|
||||||
# setup lookup variables
|
# setup lookup variables
|
||||||
$self->{ _WSDL }->{ wsdl_definitions } = $wsdl_definitions;
|
$definitions_of{ $ident } = $wsdl_definitions;
|
||||||
$self->{ _WSDL }->{ serialize_options } = {
|
$serialize_options_of{ $ident } = {
|
||||||
autotype => 0,
|
autotype => 0,
|
||||||
readable => $self->readable(),
|
|
||||||
typelib => $types,
|
typelib => $types,
|
||||||
namespace => $ns,
|
namespace => $ns,
|
||||||
};
|
};
|
||||||
$self->{ _WSDL }->{ explain_options } = {
|
|
||||||
readable => $self->readable(),
|
|
||||||
wsdl => $wsdl_definitions,
|
|
||||||
namespace => $ns,
|
|
||||||
typelib => $types,
|
|
||||||
};
|
|
||||||
|
|
||||||
$self->servicename($opt{servicename}) if $opt{servicename};
|
$servicename_of{ $ident } = $opt{servicename} if $opt{servicename};
|
||||||
$self->portname($opt{portname}) if $opt{portname};
|
$portname_of{ $ident } = $opt{portname} if $opt{portname};
|
||||||
return $self;
|
return $self;
|
||||||
} ## end sub wsdlinit
|
} ## end sub wsdlinit
|
||||||
|
|
||||||
sub _wsdl_get_service {
|
sub _wsdl_get_service :PRIVATE {
|
||||||
my $self = shift;
|
my $ident = ident shift;
|
||||||
my $service;
|
my $wsdl = $definitions_of{ $ident };
|
||||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
return $service_of{ $ident } = $servicename_of{ $ident }
|
||||||
my $ns = $wsdl->get_targetNamespace();
|
? $wsdl->find_service( $wsdl->get_targetNamespace() , $servicename_of{ $ident } )
|
||||||
if ( $self->{ _WSDL }->{ servicename } )
|
: $service_of{ $ident } = $wsdl->get_service()->[ 0 ];
|
||||||
{
|
|
||||||
$service =
|
|
||||||
$wsdl->find_service( $ns, $self->{ _WSDL }->{ servicename } );
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
$service = $wsdl->get_service()->[ 0 ];
|
|
||||||
warn "no servicename specified - using " . $service->get_name();
|
|
||||||
}
|
|
||||||
return $self->{ _WSDL }->{ service } = $service;
|
|
||||||
} ## end sub _wsdl_get_service
|
} ## end sub _wsdl_get_service
|
||||||
|
|
||||||
sub _wsdl_get_port {
|
sub _wsdl_get_port :PRIVATE {
|
||||||
my $self = shift;
|
my $ident = ident shift;
|
||||||
my $service = $self->{ _WSDL }->{ service }
|
my $wsdl = $definitions_of{ $ident };
|
||||||
|| $self->_wsdl_get_service();
|
|
||||||
my $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 };
|
|
||||||
my $ns = $wsdl->get_targetNamespace();
|
my $ns = $wsdl->get_targetNamespace();
|
||||||
my $port = $self->{ _WSDL }->{ port }
|
return $port_of{ $ident } = $portname_of{ $ident }
|
||||||
|| $self->_wsdl_get_port();
|
? $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();
|
sub _wsdl_get_binding :PRIVATE {
|
||||||
|
my $self = shift;
|
||||||
# TODO lookup $ns instead of just using
|
my $ident = ident $self;
|
||||||
# the top element's targetns...
|
my $wsdl = $definitions_of{ $ident };
|
||||||
my $binding = $wsdl->find_binding( $ns, $localname )
|
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();
|
or die "no binding found for ", $port->get_binding();
|
||||||
return $self->{ _WSDL }->{ binding } = $binding;
|
return $binding_of{ $ident };
|
||||||
} ## end sub _wsdl_get_binding
|
}
|
||||||
|
|
||||||
sub _wsdl_get_portType {
|
sub _wsdl_get_portType :PRIVATE {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
my $ident = ident $self;
|
||||||
my $binding = $self->{ _WSDL }->{ binding }
|
my $wsdl = $definitions_of{ $ident };
|
||||||
|| $self->_wsdl_get_binding();
|
my $binding = $binding_of{ $ident } || $self->_wsdl_get_binding();
|
||||||
my $ns = $wsdl->get_targetNamespace();
|
$porttype_of{ $ident } = $wsdl->find_portType( $binding->expand( $binding->get_type() ) )
|
||||||
my ( $prefix, $localname ) = split /:/, $binding->get_type();
|
or die "cannot find portType for " . $binding->get_type();
|
||||||
my $portType = $wsdl->find_portType( $ns, $localname );
|
return $porttype_of{ $ident };
|
||||||
$self->{ _WSDL }->{ portType } = $portType;
|
}
|
||||||
return $portType;
|
|
||||||
} ## end sub _wsdl_get_portType
|
|
||||||
|
|
||||||
|
sub _wsdl_init_methods :PRIVATE {
|
||||||
sub _wsdl_init_methods {
|
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
my $ident = ident $self;
|
||||||
|
my $wsdl = $definitions_of{ $ident };
|
||||||
my $ns = $wsdl->get_targetNamespace();
|
my $ns = $wsdl->get_targetNamespace();
|
||||||
|
|
||||||
# get bindings, portType, message, part(s)
|
# get bindings, portType, message, part(s) - use private methods for clear separation...
|
||||||
# - use cached values where possible for speed,
|
$self->_wsdl_get_service if not ($service_of{ $ident });
|
||||||
# private methods if not for clear separation...
|
my $binding = $binding_of{ $ident } || $self->_wsdl_get_binding()
|
||||||
my $binding = $self->{ _WSDL }->{ binding }
|
|
||||||
|| $self->_wsdl_get_binding()
|
|
||||||
|| die "Can't find binding";
|
|| die "Can't find binding";
|
||||||
my $portType = $self->{ _WSDL }->{ portType }
|
my $portType = $porttype_of{ $ident } || $self->_wsdl_get_portType();
|
||||||
|| $self->_wsdl_get_portType()
|
|
||||||
|| die "Can't find portType";
|
|
||||||
|
|
||||||
my $methodHashRef = {};
|
$method_info_of{ $ident } = {};
|
||||||
|
|
||||||
foreach my $binding_operation (@{ $binding->get_operation() })
|
foreach my $binding_operation (@{ $binding->get_operation() })
|
||||||
{
|
{
|
||||||
@@ -200,212 +209,108 @@ sub _wsdl_init_methods {
|
|||||||
my $message = $wsdl->find_message( $ns, $localname )
|
my $message = $wsdl->find_message( $ns, $localname )
|
||||||
or die "Message {$ns}$localname not found in WSDL definition";
|
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.
|
# rpc / encoded methods may have a namespace specified.
|
||||||
# look it up and set it...
|
# look it up and set it...
|
||||||
$method->{ namespace } = $binding_operation
|
$method->{ namespace } = $binding_operation
|
||||||
? do {
|
? do {
|
||||||
my $input = $binding_operation->first_input();
|
my $input = $binding_operation->first_input();
|
||||||
$input ? $input->get_namespace() : undef;
|
$input ? $input->first_body()->get_namespace() : undef;
|
||||||
}
|
}
|
||||||
: undef;
|
: undef;
|
||||||
|
|
||||||
$methodHashRef->{ $binding_operation->get_name() } = $method;
|
$method_info_of{ $ident }->{ $binding_operation->get_name() } = $method;
|
||||||
}
|
}
|
||||||
|
|
||||||
$self->{ _WSDL }->{ methodInfo } = $methodHashRef;
|
return $method_info_of{ $ident };
|
||||||
|
|
||||||
return $methodHashRef;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub call {
|
sub call {
|
||||||
my $self = shift;
|
my ($self, $method, @data_from) = @_;
|
||||||
my $method = shift;
|
my $ident = ident $self;
|
||||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
|
||||||
|
|
||||||
my $content = q{};
|
my ($data, $header) = ref $data_from[0]
|
||||||
my $envelope;
|
? ($data_from[0], $data_from[1] )
|
||||||
my $methodInfo;
|
: (@data_from>1)
|
||||||
|
? ( { @data_from }, undef )
|
||||||
|
: ( $data_from[0], undef );
|
||||||
|
|
||||||
if (blessed $data
|
$self->wsdlinit() if not ($definitions_of{ $ident });
|
||||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
$self->_wsdl_init_methods() if not ($method_info_of{ $ident });
|
||||||
{
|
|
||||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
|
||||||
|
|
||||||
# TODO replace by something derived from binding - this is just a
|
my $client = $client_of{ $ident };
|
||||||
# workaround...
|
|
||||||
$methodInfo->{ soap_action }
|
|
||||||
= join '/', $data->get_xmlns(), $method;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
my $methodLookup = $self->{ _WSDL }->{ methodInfo }
|
|
||||||
|| $self->_wsdl_init_methods();
|
|
||||||
|
|
||||||
$methodInfo = $methodLookup->{ $method };
|
# pass-through keep_alive if we need it...
|
||||||
my $partListRef = $methodInfo->{ parts };
|
$client->set_proxy( $proxy_of{ $ident }
|
||||||
|
|| $port_of{ $ident }->first_address()->get_location(),
|
||||||
# set serializer options
|
$keep_alive_of{ $ident } ? (keep_alive => 1) : (),
|
||||||
# TODO allow custom options here
|
|
||||||
my $opt = $self->{ _WSDL }->{ serialize_options };
|
|
||||||
|
|
||||||
# set response target namespace
|
|
||||||
# TODO make rpc-encoded encoding recognise this namespace
|
|
||||||
# $opt->{ targetNamespace } = $soap_binding_operation ?
|
|
||||||
# $operation->input()->namespace() : undef;
|
|
||||||
|
|
||||||
# serialize content
|
|
||||||
# TODO create surrounding element for rpc-encoded messages
|
|
||||||
foreach my $part ( @{ $partListRef } ) {
|
|
||||||
$content .= $part->serialize( $method, $data, $opt );
|
|
||||||
}
|
|
||||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $content , $opt );
|
|
||||||
};
|
|
||||||
|
|
||||||
|
|
||||||
if ( $self->no_dispatch() ) {
|
|
||||||
return $envelope;
|
|
||||||
} ## end if ( $self->no_dispatch...
|
|
||||||
|
|
||||||
# get response via transport layer
|
|
||||||
# TODO remove dependency from SOAP::Lite and use a
|
|
||||||
# SAX-based filter using XML::LibXML to get the
|
|
||||||
# result.
|
|
||||||
# Filter should have the following methods:
|
|
||||||
# - result: returns the result of the call (like SOAP::Lite, but as
|
|
||||||
# perl data structure)
|
|
||||||
# - header: returns the content of the SOAP header
|
|
||||||
# - fault: returns the result of the call if a SOAP fault is sent back
|
|
||||||
# by the server. Retuns undef (nothing) if the call has been
|
|
||||||
# processed without errors.
|
|
||||||
my $response = $self->transport->send_receive(
|
|
||||||
context => $self, # this is provided for context
|
|
||||||
endpoint => $self->endpoint(),
|
|
||||||
action => $methodInfo->{ soap_action }, # SOAPAction from binding
|
|
||||||
envelope => $envelope, # use custom content
|
|
||||||
);
|
);
|
||||||
|
|
||||||
return $response if ($self->outputxml() );
|
$client->set_no_dispatch( $no_dispatch_of{ $ident } );
|
||||||
|
$client->set_outputxml( $outputxml_of{ $ident } ? 1 : 0 );
|
||||||
|
|
||||||
if ($self->outputtree()) {
|
# only load ::Deserializer::SOM if we really need to deserialize to SOM.
|
||||||
|
# maybe we should introduce something like $output{ $ident } with a fixed
|
||||||
my ($parser, $handler); # replace by globals - singleton is faster
|
# set of values - m{^(TREE|HASH|XML|SOM)$}xms ?
|
||||||
if (not $parser) {
|
if ( ( ! $outputtree_of{ $ident } )
|
||||||
require SOAP::WSDL::SOAP::Typelib::Fault11;
|
&& ( ! $outputhash_of{ $ident } )
|
||||||
require SOAP::WSDL::SAX::MessageHandler;
|
&& ( ! $outputxml_of{ $ident } )
|
||||||
require XML::LibXML;
|
&& ( ! $no_dispatch_of{ $ident } ) ) {
|
||||||
$handler = SOAP::WSDL::SAX::MessageHandler->new(
|
require SOAP::WSDL::Deserializer::SOM;
|
||||||
{ class_resolver => $self->class_resolver() },
|
$client->set_deserializer( SOAP::WSDL::Deserializer::SOM->new() );
|
||||||
);
|
|
||||||
$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 }
|
|
||||||
};
|
};
|
||||||
} ## end sub _load_method
|
|
||||||
|
|
||||||
&_load_method( 'no_dispatch' );
|
my $method_info = $method_info_of{ $ident }->{ $method };
|
||||||
&_load_method( 'wsdl' );
|
|
||||||
|
|
||||||
sub servicename {
|
# TODO serialize both header and body, not only header
|
||||||
my $self = shift;
|
my (@response) = (blessed $data)
|
||||||
return $self->{ _WSDL }->{ servicename } if ( not @_ );
|
? $client->call( {
|
||||||
$self->{ _WSDL }->{ servicename } = shift;
|
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();
|
return unless @response; # nothing to do for one-ways
|
||||||
|
return wantarray ? @response : $response[0];
|
||||||
$self->{ _WSDL }->{ service } =
|
}
|
||||||
$self->{ _WSDL }->{ wsdl_definitions }
|
|
||||||
->find_service( $ns, $self->{ _WSDL }->{ servicename } )
|
|
||||||
or die "No such service: " . $self->{ _WSDL }->{ servicename };
|
|
||||||
return $self;
|
|
||||||
} ## end sub servicename
|
|
||||||
|
|
||||||
sub portname {
|
|
||||||
my $self = shift;
|
|
||||||
return $self->{ _WSDL }->{ portname } if ( not @_ );
|
|
||||||
$self->{ _WSDL }->{ portname } = shift;
|
|
||||||
|
|
||||||
my $ns = $self->{ _WSDL }->{ wsdl_definitions }->get_targetNamespace();
|
|
||||||
|
|
||||||
$self->{ _WSDL }->{ port } =
|
|
||||||
$self->{ _WSDL }->{ service }
|
|
||||||
->find_port( $ns, $self->{ _WSDL }->{ portname } )
|
|
||||||
or die "No such port: " . $self->{ _WSDL }->{ portname };
|
|
||||||
return $self;
|
|
||||||
} ## end sub portname
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
@@ -417,12 +322,19 @@ __END__
|
|||||||
|
|
||||||
SOAP::WSDL - SOAP with WSDL support
|
SOAP::WSDL - SOAP with WSDL support
|
||||||
|
|
||||||
|
=head1 Overview
|
||||||
|
|
||||||
|
For creating Perl classes instrumenting a web service with a WSDL definition,
|
||||||
|
read L<SOAP::WSDL::Manual>.
|
||||||
|
|
||||||
|
For using an interpreting (thus slow and somewhat troublesome) WSDL based
|
||||||
|
SOAP client, which mimics L<SOAP::Lite|SOAP::Lite>'s API, read on.
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
my $soap = SOAP::WSDL->new(
|
my $soap = SOAP::WSDL->new(
|
||||||
wsdl => 'file://bla.wsdl',
|
wsdl => 'file://bla.wsdl',
|
||||||
readable => 1,
|
);
|
||||||
)->wsdlinit();
|
|
||||||
|
|
||||||
my $result = $soap->call('MyMethod', %data);
|
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.
|
The WSDL is parsed and stored in memory.
|
||||||
|
|
||||||
Your data is serialized according to the rules in the WSDL and sent via
|
Your data is serialized according to the rules in the WSDL.
|
||||||
SOAP::Lite's transport mechanism.
|
|
||||||
|
The only transport mechanisms currently supported are http and https.
|
||||||
|
|
||||||
=head1 METHODS
|
=head1 METHODS
|
||||||
|
|
||||||
|
=head2 new
|
||||||
|
|
||||||
|
Constructor. All parameters passed are passed to the corresponding methods.
|
||||||
|
|
||||||
|
=head2 call
|
||||||
|
|
||||||
|
Performs a SOAP call. The result is either an object tree (with outputtree),
|
||||||
|
a hash reference (with outputhash), plain XML (with outputxml) or a SOAP::SOM
|
||||||
|
object (with neither of the above set).
|
||||||
|
|
||||||
|
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
|
=head2 wsdlinit
|
||||||
|
|
||||||
Reads the WSDL file and initializes SOAP::WSDL for working with it.
|
Reads the WSDL file and initializes SOAP::WSDL for working with it.
|
||||||
|
|
||||||
Must be called after the wsdl URL has been set, and before calling one of
|
Is called automatically from call() if not called directly before.
|
||||||
|
|
||||||
servicename
|
servicename
|
||||||
portname
|
portname
|
||||||
@@ -455,14 +404,6 @@ wsdlinit:
|
|||||||
portname => 'MyPort'
|
portname => 'MyPort'
|
||||||
);
|
);
|
||||||
|
|
||||||
=head2 call
|
|
||||||
|
|
||||||
Performs a SOAP call. The result is either an object tree (with outputtree),
|
|
||||||
a hash reference (with outputhash), plain XML (with outputxml) or a SOAP::SOM
|
|
||||||
object (with neither of the above set).
|
|
||||||
|
|
||||||
my $result = $soap->call('method', %data);
|
|
||||||
|
|
||||||
=head1 CONFIGURATION METHODS
|
=head1 CONFIGURATION METHODS
|
||||||
|
|
||||||
=head2 outputtree
|
=head2 outputtree
|
||||||
@@ -471,7 +412,7 @@ When outputtree is set, SOAP::WSDL will return an object tree instead of a
|
|||||||
SOAP::SOM object.
|
SOAP::SOM object.
|
||||||
|
|
||||||
You have to specify a class_resolver for this to work. See
|
You have to specify a class_resolver for this to work. See
|
||||||
<class_resolver|class_resolver>
|
L<class_resolver|class_resolver>
|
||||||
|
|
||||||
=head2 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
|
name of the class name for deserializing a XML node at the current XPath
|
||||||
location.
|
location.
|
||||||
|
|
||||||
Class resolvers are typically generated by using the to_typemap method on a
|
Class resolvers are typically generated by using the generate_typemap method
|
||||||
SOAP::WSDL::Definitions objects.
|
of a SOAP::WSDL::Generator subclass.
|
||||||
|
|
||||||
Example:
|
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
|
Sets the service to operate on. If no service is set via servicename, the
|
||||||
first service found is used.
|
first service found is used.
|
||||||
|
|
||||||
Must be called after calling wsdlinit().
|
|
||||||
|
|
||||||
Returns the soap object, so you can chain calls like
|
Returns the soap object, so you can chain calls like
|
||||||
|
|
||||||
$soap->servicename->('Name')->portname('Port');
|
$soap->servicename->('Name')->portname('Port');
|
||||||
@@ -528,8 +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
|
Sets the port to operate on. If no port is set via portname, the
|
||||||
first port found is used.
|
first port found is used.
|
||||||
|
|
||||||
Must be called after calling wsdlinit().
|
|
||||||
|
|
||||||
Returns the soap object, so you can chain calls like
|
Returns the soap object, so you can chain calls like
|
||||||
|
|
||||||
$soap->portname('Port')->call('MyMethod', %data);
|
$soap->portname('Port')->call('MyMethod', %data);
|
||||||
@@ -539,12 +476,16 @@ Returns the soap object, so you can chain calls like
|
|||||||
When set, call() returns the plain request XML instead of dispatching the
|
When set, call() returns the plain request XML instead of dispatching the
|
||||||
SOAP call to the SOAP service. Handy for testing/debugging.
|
SOAP call to the SOAP service. Handy for testing/debugging.
|
||||||
|
|
||||||
=head2 _wsdl_init_methods
|
=head1 ACCESS TO SOAP::WSDL's internals
|
||||||
|
|
||||||
Creates a lookup table containing the information required for all methods
|
=head2 get_client / set_client
|
||||||
specified for the service/port selected.
|
|
||||||
|
|
||||||
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
|
=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
|
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
|
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.
|
it's content.
|
||||||
|
|
||||||
The object tree has two main functions: It knows how to serialize data passed
|
The object tree has two main functions: It knows how to serialize data passed
|
||||||
as hash ref, and how to render the WSDL elements found into perl classes.
|
as hash ref, and how to render the WSDL elements found into perl classes.
|
||||||
|
|
||||||
Yup your're right, there's a builting code generation facility.
|
Yup your're right, there's a builting code generation facility. Read
|
||||||
|
L<SOAP::WSDL::Manual> for using it.
|
||||||
|
|
||||||
=item * no_dispatch
|
=item * no_dispatch
|
||||||
|
|
||||||
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.
|
envelope, not only the body's content.
|
||||||
|
|
||||||
=item * outputxml
|
=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.
|
envelope, not only the body's content.
|
||||||
|
|
||||||
=item * servicename/portname
|
=item * servicename/portname
|
||||||
@@ -582,44 +524,112 @@ You may pass the servicename and portname as attributes to wsdlinit, though.
|
|||||||
|
|
||||||
=head1 Differences to SOAP::Lite
|
=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
|
=head2 Auto-Dispatching
|
||||||
|
|
||||||
SOAP::WSDL does B<does not> support auto-dispatching.
|
SOAP::WSDL does B<does not> support auto-dispatching.
|
||||||
|
|
||||||
This is on purpose: You may easily create interface classes by using
|
This is on purpose: You may easily create interface classes by using
|
||||||
SOAP::WSDL and implementing something like
|
SOAP::WSDL::Client and implementing something like
|
||||||
|
|
||||||
sub mySoapMethod {
|
sub mySoapMethod {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
$soap_wsdl_client->call( mySoapMethod, @_);
|
$soap_wsdl_client->call( mySoapMethod, @_);
|
||||||
}
|
}
|
||||||
|
|
||||||
You may even do this in a class factory - SOAP::WSDL provides the methods
|
You may even do this in a class factory - see L<wsdl2perl.pl> for creating
|
||||||
for generating such interfaces.
|
such interfaces.
|
||||||
|
|
||||||
SOAP::Lite's autodispatching mechanism is - though convenient - a constant
|
=head2 Debugging / Tracing
|
||||||
source of errors: Every typo in a method name gets caught by AUTOLOAD and
|
|
||||||
may lead to unpredictable results.
|
While SOAP::Lite features a global tracing facility, SOAP::WSDL
|
||||||
|
allows to switch tracing on/of on a per-object base.
|
||||||
|
|
||||||
|
This has to be done in the SOAP client used by SOAP::WSDL - see
|
||||||
|
L<get_client|get_client> for an example and L<SOAP::WSDL::Client> for
|
||||||
|
details.
|
||||||
|
|
||||||
=head1 Bugs and Limitations
|
=head1 Bugs and Limitations
|
||||||
|
|
||||||
=over
|
=over
|
||||||
|
|
||||||
=item * readable
|
=item * 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
|
group
|
||||||
union
|
union
|
||||||
simpleContent
|
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
|
If you have list elements with multiple occurences allowed, SOAP::WSDL
|
||||||
has no means of finding out which variant you meant.
|
has no means of finding out which variant you meant.
|
||||||
@@ -629,11 +639,11 @@ Passing in item => [1,2,3] could serialize to
|
|||||||
<item>1 2</item><item>3</item>
|
<item>1 2</item><item>3</item>
|
||||||
<item>1</item><item>2 3</item>
|
<item>1</item><item>2 3</item>
|
||||||
|
|
||||||
Ambiguos data can be avoided by passing an object tree as data.
|
Ambiguos data can be avoided by providing data as objects.
|
||||||
|
|
||||||
=item * XML Schema facets
|
=item * XML Schema facets
|
||||||
|
|
||||||
Almost all XML schema facets are not yet implemented. The only facets
|
Almost no XML schema facets are implemented yet. The only facets
|
||||||
currently implemented are:
|
currently implemented are:
|
||||||
|
|
||||||
fixed
|
fixed
|
||||||
@@ -652,6 +662,62 @@ The following facets have no influence yet:
|
|||||||
|
|
||||||
=back
|
=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
|
=head1 LICENSE
|
||||||
|
|
||||||
Copyright 2004-2007 Martin Kutter.
|
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>
|
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
|
=cut
|
||||||
|
|
||||||
|
|||||||
+35
-74
@@ -1,12 +1,15 @@
|
|||||||
package SOAP::WSDL::Base;
|
package SOAP::WSDL::Base;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use Carp;
|
|
||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
use List::Util qw(first);
|
use List::Util qw(first);
|
||||||
|
use Carp qw(confess);
|
||||||
|
|
||||||
|
our $VERSION='2.00_17';
|
||||||
|
|
||||||
my %id_of :ATTR(:name<id> :default<()>);
|
my %id_of :ATTR(:name<id> :default<()>);
|
||||||
my %name_of :ATTR(:name<name> :default<()>);
|
my %name_of :ATTR(:name<name> :default<()>);
|
||||||
|
my %documentation_of :ATTR(:name<documentation> :default<()>);
|
||||||
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
|
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
|
||||||
my %xmlns_of :ATTR(:name<xmlns> :default<{}>);
|
my %xmlns_of :ATTR(:name<xmlns> :default<{}>);
|
||||||
my %parent_of :ATTR(:name<parent> :default<()>);
|
my %parent_of :ATTR(:name<parent> :default<()>);
|
||||||
@@ -22,6 +25,16 @@ sub STORABLE_freeze_post :CUMULATIVE {};
|
|||||||
sub STORABLE_thaw_pre :CUMULATIVE {};
|
sub STORABLE_thaw_pre :CUMULATIVE {};
|
||||||
sub STORABLE_thaw_post :CUMULATIVE { return $_[0] };
|
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.
|
# unfortunately, AUTOMETHOD is SLOW.
|
||||||
# Re-implement in derived package wherever speed is an issue...
|
# Re-implement in derived package wherever speed is an issue...
|
||||||
#
|
#
|
||||||
@@ -38,8 +51,6 @@ sub AUTOMETHOD {
|
|||||||
## And we would have to check getters, too.
|
## And we would have to check getters, too.
|
||||||
## Maybe do it the Conway way via the Symbol table...
|
## Maybe do it the Conway way via the Symbol table...
|
||||||
## ... can is way slow...
|
## ... can is way slow...
|
||||||
# croak "no set accessor found for push_$subname"
|
|
||||||
# if not ($self->can( $setter ));
|
|
||||||
return sub {
|
return sub {
|
||||||
no strict qw(refs);
|
no strict qw(refs);
|
||||||
my $old_value = $self->$getter();
|
my $old_value = $self->$getter();
|
||||||
@@ -53,6 +64,7 @@ sub AUTOMETHOD {
|
|||||||
|
|
||||||
# we're called as $obj->find_something($ns, $key)
|
# we're called as $obj->find_something($ns, $key)
|
||||||
elsif ($subname =~s {^find_}{get_}xms) {
|
elsif ($subname =~s {^find_}{get_}xms) {
|
||||||
|
@values = @{ $values[0] } if ref $values[0] eq 'ARRAY';
|
||||||
return sub {
|
return sub {
|
||||||
return first {
|
return first {
|
||||||
$_->get_targetNamespace() eq $values[0] &&
|
$_->get_targetNamespace() eq $values[0] &&
|
||||||
@@ -69,7 +81,7 @@ sub AUTOMETHOD {
|
|||||||
return $result_ref->[0];
|
return $result_ref->[0];
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
croak "$subname not found in class " . (ref $self || $self);
|
confess "$subname not found in class " . (ref $self || $self) ;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub init {
|
sub init {
|
||||||
@@ -77,12 +89,15 @@ sub init {
|
|||||||
my @args = @_;
|
my @args = @_;
|
||||||
foreach my $value (@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) {
|
if ($value->{ Name } =~m{^xmlns\:}xms) {
|
||||||
die $xmlns_of{ ident $self }
|
die $xmlns_of{ ident $self }
|
||||||
if ref $xmlns_of{ ident $self } ne 'HASH';
|
if ref $xmlns_of{ ident $self } ne 'HASH';
|
||||||
|
|
||||||
|
# add namespaces
|
||||||
$xmlns_of{ ident $self }->{ $value->{ Value } } =
|
$xmlns_of{ ident $self }->{ $value->{ Value } } =
|
||||||
$value->{ LocalName };
|
$value->{ LocalName };
|
||||||
|
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
elsif ($value->{ Name } =~m{^xmlns$}xms) {
|
elsif ($value->{ Name } =~m{^xmlns$}xms) {
|
||||||
@@ -90,80 +105,26 @@ sub init {
|
|||||||
# TODO handle xmlns correctly - maybe via setting a prefix ?
|
# TODO handle xmlns correctly - maybe via setting a prefix ?
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
my $name = $value->{ LocalName };
|
|
||||||
my $method = "set_$name";
|
my $name = $value->{ LocalName };
|
||||||
$self->$method( $value->{ Value } ) if ( $method );
|
my $method = "set_$name";
|
||||||
|
$self->$method( $value->{ Value } );
|
||||||
}
|
}
|
||||||
return $self;
|
return $self;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub add_namespace {
|
sub expand {
|
||||||
my ($self, $uri, $prefix ) = @_;
|
my ($self, , $qname) = @_;
|
||||||
return unless $uri;
|
my ($prefix, $localname) = split /:/, $qname;
|
||||||
$self->{ namespace } ||= {};
|
my %ns_map = reverse %{ $self->get_xmlns() };
|
||||||
$self->{ namespace }->{ $uri } = $prefix;
|
return ($ns_map{ $prefix }, $localname) if ($ns_map{ $prefix });
|
||||||
}
|
|
||||||
|
|
||||||
sub to_typemap {
|
if (my $parent = $self->get_parent()) {
|
||||||
warn "to_typemap";
|
return $parent->expand($qname);
|
||||||
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 .= '::';
|
|
||||||
}
|
}
|
||||||
|
confess "unbound prefix $prefix found for $prefix:$localname";
|
||||||
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();
|
|
||||||
}
|
}
|
||||||
|
sub _expand;
|
||||||
|
*_expand = \&expand;
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|||||||
@@ -10,106 +10,4 @@ my %type_of :ATTR(:name<type> :default<()>);
|
|||||||
my %transport_of :ATTR(:name<transport> :default<()>);
|
my %transport_of :ATTR(:name<transport> :default<()>);
|
||||||
my %style_of :ATTR(:name<style> :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;
|
1;
|
||||||
|
|||||||
+260
-91
@@ -2,26 +2,81 @@ package SOAP::WSDL::Client;
|
|||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use Carp;
|
use Carp;
|
||||||
use Scalar::Util qw(blessed);
|
|
||||||
use SOAP::WSDL::Envelope;
|
|
||||||
use SOAP::Lite;
|
|
||||||
use Class::Std::Storable;
|
|
||||||
use SOAP::WSDL::Expat::MessageParser;
|
|
||||||
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
|
||||||
|
|
||||||
# Package globals for speed...
|
use Class::Std::Storable;
|
||||||
my $PARSER;
|
use Scalar::Util qw(blessed);
|
||||||
my $MESSAGE_HANDLER;
|
|
||||||
|
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 %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
|
||||||
my %no_dispatch_of :ATTR(:name<no_dispatch> :default<()>);
|
my %no_dispatch_of :ATTR(:name<no_dispatch> :default<()>);
|
||||||
my %outputxml_of :ATTR(:name<outputxml> :default<()>);
|
my %outputxml_of :ATTR(:name<outputxml> :default<()>);
|
||||||
my %proxy_of :ATTR(:name<proxy> :default<()>);
|
my %transport_of :ATTR(:name<transport> :default<()>);
|
||||||
|
my %endpoint_of :ATTR(:name<endpoint> :default<()>);
|
||||||
|
|
||||||
# TODO remove when preparing 2.01
|
my %soap_version_of :ATTR(:get<soap_version> :init_attr<soap_version> :default<'1.1'>);
|
||||||
sub outputtree { warn 'outputtree is deprecated and'
|
|
||||||
. 'will be removed before reaching v2.01 !' }
|
|
||||||
|
|
||||||
|
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: {
|
SUBFACTORY: {
|
||||||
no strict qw(refs);
|
no strict qw(refs);
|
||||||
for (qw(class_resolver no_dispatch outputxml proxy)) {
|
for (qw(class_resolver no_dispatch outputxml proxy)) {
|
||||||
@@ -37,103 +92,187 @@ SUBFACTORY: {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
BEGIN {
|
|
||||||
$PARSER = SOAP::WSDL::Expat::MessageParser->new();
|
|
||||||
}
|
|
||||||
|
|
||||||
sub call {
|
sub call {
|
||||||
my $self = shift;
|
my ($self, $method, @data_from) = @_;
|
||||||
my $method = shift;
|
my $ident = ident $self;
|
||||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
|
||||||
my $content = q{};
|
|
||||||
my ($envelope, $soap_action);
|
|
||||||
|
|
||||||
if (blessed $data
|
# the only valid idiom for calling a method with both a header and a body
|
||||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
# is
|
||||||
{
|
# ->call($method, $body_ref, $header_ref);
|
||||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
#
|
||||||
# TODO replace by something derived from binding - this is just a
|
# These other idioms all assume an empty header:
|
||||||
# workaround...
|
# ->call($method, %body_of); # %body_of is a hash
|
||||||
$soap_action = join '/', $data->get_xmlns(), $method;
|
# ->call($method, $body); # $body is a scalar
|
||||||
}
|
my ($data, $header) = ref $data_from[0]
|
||||||
else {
|
? ($data_from[0], $data_from[1] )
|
||||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
: (@data_from>1)
|
||||||
# $soap_action = $self->on_action( $method );
|
? ( { @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();
|
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
|
# get response via transport layer.
|
||||||
# TODO remove dependency from SOAP::Lite and use a
|
# Normally, SOAP::Lite's transport layer is used, though users
|
||||||
# SAX-based filter using XML::LibXML to get the
|
# may provide their own.
|
||||||
# result.
|
my $transport = $self->get_transport();
|
||||||
# Filter should have the following methods:
|
my $response = $transport->send_receive(
|
||||||
# - result: returns the result of the call (like SOAP::Lite, but as
|
endpoint => $self->get_endpoint(),
|
||||||
# perl data structure)
|
content_type => $content_type_of{ $ident },
|
||||||
# - header: returns the content of the SOAP header
|
envelope => $envelope,
|
||||||
# - fault: returns the result of the call if a SOAP fault is sent back
|
action => $soap_action,
|
||||||
# by the server. Retuns undef (nothing) if the call has been
|
# on_receive_chunk => sub {} # optional, may be used for parsing large responses as they arrive.
|
||||||
# processed without errors.
|
);
|
||||||
my $soap = SOAP::Lite->new()->proxy( $self->get_proxy() );
|
|
||||||
my $response = $soap->transport->send_receive(
|
|
||||||
context => $self, # this is provided for context
|
|
||||||
endpoint => $soap->endpoint(),
|
|
||||||
action => $soap_action, # SOAPAction, should be from binding
|
|
||||||
envelope => $envelope, # use custom content
|
|
||||||
);
|
|
||||||
|
|
||||||
# warn 'Received ' . length($response) . ' bytes of content';
|
return $response if ($outputxml_of{ $ident } );
|
||||||
return $response if ($self->outputxml() );
|
|
||||||
|
|
||||||
$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)
|
# if we had no success (Transport layer error status code)
|
||||||
# or if transport layer failed
|
# or if transport layer failed
|
||||||
if (! $soap->transport->is_success() ) {
|
if ( ! $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();
|
|
||||||
}
|
|
||||||
};
|
|
||||||
|
|
||||||
|
|
||||||
require SOAP::WSDL::SOAP::Typelib::Fault11;
|
|
||||||
# generate & return fault if we cannot serialize response
|
# generate & return fault if we cannot serialize response
|
||||||
# or have none...
|
# or have none...
|
||||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
return $deserializer_of{ $ident }->generate_fault({
|
||||||
faultcode => 'soap:Server',
|
code => 'soap:Server',
|
||||||
faultactor => 'urn:localhost',
|
role => 'urn:localhost',
|
||||||
faultstring => 'Error sending / receiving message: '
|
message => 'Error sending / receiving message: '
|
||||||
. $soap->transport->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
|
} ## end sub call
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
=pod
|
=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
|
=head2 Features different from SOAP::Lite
|
||||||
|
|
||||||
SOAP::WSDL does not aim to be a complete replacement for SOAP::Lite - the
|
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
|
so SOAP::Lite users can switch without looking up every method call in the
|
||||||
documentation.
|
documentation.
|
||||||
|
|
||||||
A few things are quite differentl from SOAP::Lite, though:
|
A few things are quite different from SOAP::Lite, though:
|
||||||
|
|
||||||
=head3 SOAP request data
|
=head3 SOAP request data
|
||||||
|
|
||||||
@@ -197,9 +336,39 @@ SOAP::WSDL::Client and implementing something like
|
|||||||
$soap_wsdl_client->call( mySoapMethod, @_);
|
$soap_wsdl_client->call( mySoapMethod, @_);
|
||||||
}
|
}
|
||||||
|
|
||||||
You may even do this in a class factory - SOAP::WSDL provides the methods
|
You may even do this in a class factory - see L<wsdl2perl.pl> for creating
|
||||||
for generating such interfaces.
|
such interfaces.
|
||||||
|
|
||||||
|
=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
|
=cut
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -2,42 +2,79 @@ package SOAP::WSDL::Client::Base;
|
|||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use base 'SOAP::WSDL::Client';
|
use base 'SOAP::WSDL::Client';
|
||||||
|
use Scalar::Util qw(blessed);
|
||||||
|
|
||||||
sub __create_new {
|
our $VERSION = '2.00_17';
|
||||||
my ($package, %args_of) = @_;
|
|
||||||
|
|
||||||
no strict qw(refs);
|
sub call {
|
||||||
|
my ($self, $method, $body, $header) = @_;
|
||||||
*{ "$package\::new" } = sub {
|
if (not blessed $body) {
|
||||||
my $class = shift;
|
my $class = $method->{ body }->{ parts }->[0];
|
||||||
my $self = $class->SUPER::new({
|
eval "require $class" || die $@;
|
||||||
proxy => $args_of{ proxy },
|
$body = $class->new($body);
|
||||||
class_resolver => $args_of{ class_resolver }
|
}
|
||||||
});
|
|
||||||
bless $self, $class;
|
|
||||||
return $self;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
# 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 {
|
sub __create_methods {
|
||||||
my ($package, %parts_of) = @_;
|
my ($package, %info_of) = @_;
|
||||||
|
|
||||||
no strict qw(refs);
|
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 {
|
*{ "$package\::$method" } = sub {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my @param = map {
|
my @param = map {
|
||||||
my $data = shift || {};
|
my $data = shift || {};
|
||||||
eval "require $_";
|
eval "require $_";
|
||||||
$_->new( $data );
|
$_->new( $data );
|
||||||
} @{ $parts_of{ $method } };
|
} @parts;
|
||||||
|
|
||||||
$self->call( $method, @param );
|
return $self->SUPER::call( {
|
||||||
|
operation => $method,
|
||||||
|
soap_action => $soap_action,
|
||||||
|
}, @param );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
@@ -48,13 +85,40 @@ __END__
|
|||||||
|
|
||||||
=head1 NAME
|
=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
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
package MySoapClient;
|
package MySoapInterface;
|
||||||
use SOAP::WSDL::Client::Base;
|
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) );
|
__PACKAGE__->__create_methods( qw(one two three) );
|
||||||
1;
|
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
|
=cut
|
||||||
+14
-347
@@ -1,4 +1,5 @@
|
|||||||
package SOAP::WSDL::Definitions;
|
package SOAP::WSDL::Definitions;
|
||||||
|
use utf8;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use Carp;
|
use Carp;
|
||||||
@@ -8,6 +9,8 @@ use List::Util qw(first);
|
|||||||
use Class::Std::Storable;
|
use Class::Std::Storable;
|
||||||
use base qw(SOAP::WSDL::Base);
|
use base qw(SOAP::WSDL::Base);
|
||||||
|
|
||||||
|
our $VERSION='2.00_17';
|
||||||
|
|
||||||
my %types_of :ATTR(:name<types> :default<[]>);
|
my %types_of :ATTR(:name<types> :default<[]>);
|
||||||
my %message_of :ATTR(:name<message> :default<()>);
|
my %message_of :ATTR(:name<message> :default<()>);
|
||||||
my %portType_of :ATTR(:name<portType> :default<()>);
|
my %portType_of :ATTR(:name<portType> :default<()>);
|
||||||
@@ -31,224 +34,24 @@ BLOCK: {
|
|||||||
foreach my $method(keys %attributes_of ) {
|
foreach my $method(keys %attributes_of ) {
|
||||||
|
|
||||||
*{ "find_$method" } = sub {
|
*{ "find_$method" } = sub {
|
||||||
my ($self, @args) = @_;
|
my ($self, @args_from) = @_;
|
||||||
|
@args_from = @{ $args_from[0] } if ref $args_from[0] eq 'ARRAY';
|
||||||
return first {
|
return first {
|
||||||
$_->get_targetNamespace() eq $args[0]
|
$_->get_targetNamespace() eq $args_from[0]
|
||||||
&& $_->get_name() eq $args[1]
|
&& $_->get_name() eq $args_from[1]
|
||||||
}
|
}
|
||||||
@{ $attributes_of{ $method }->{ ident $self } };
|
@{ $attributes_of{ $method }->{ ident $self } };
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
sub explain {
|
#sub listify {
|
||||||
my $self = shift;
|
# my $data = shift;
|
||||||
my $opt = shift;
|
# return if not defined $data;
|
||||||
$opt->{ wsdl } ||= $self;
|
# return [ $data ] if not ref $data;
|
||||||
$opt->{ namespace } ||= $self->get_xmlns() || {};
|
# return [ $data ] if not ref $data eq 'ARRAY';
|
||||||
my $txt = '';
|
# return $data;
|
||||||
|
#}
|
||||||
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;
|
|
||||||
}
|
|
||||||
|
|
||||||
1;
|
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
|
Accessors/Mutators for accessing / setting the E<gt>typesE<lt> child
|
||||||
element(s).
|
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
|
=head1 LICENSE
|
||||||
|
|
||||||
Copyright 2004-2007 Martin Kutter.
|
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 strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||||
use XML::Parser::Expat;
|
use base qw(SOAP::WSDL::Expat::Base);
|
||||||
|
|
||||||
=pod
|
|
||||||
|
|
||||||
=head2 new
|
|
||||||
|
|
||||||
=over
|
|
||||||
|
|
||||||
=item SYNOPSIS
|
|
||||||
|
|
||||||
my $obj = ->new();
|
|
||||||
|
|
||||||
=item DESCRIPTION
|
|
||||||
|
|
||||||
Constructor.
|
|
||||||
|
|
||||||
=back
|
|
||||||
|
|
||||||
=cut
|
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my $class = shift;
|
my ($class, $args) = @_;
|
||||||
my $args = shift;
|
|
||||||
my $self = {
|
my $self = {
|
||||||
class_resolver => $args->{ class_resolver }
|
class_resolver => $args->{ class_resolver },
|
||||||
|
strict => exists $args->{ strict } ? $args->{ strict } : 1,
|
||||||
};
|
};
|
||||||
bless $self, $class;
|
bless $self, $class;
|
||||||
return $self;
|
return $self;
|
||||||
@@ -35,115 +17,167 @@ sub new {
|
|||||||
|
|
||||||
sub class_resolver {
|
sub class_resolver {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
$self->{ class_resolver } = shift;
|
$self->{ class_resolver } = shift if @_;
|
||||||
|
return $self->{ class_resolver };
|
||||||
}
|
}
|
||||||
|
|
||||||
sub parse {
|
sub _initialize {
|
||||||
my $self = shift;
|
my ($self, $parser) = @_;
|
||||||
my $xml = shift;
|
$self->{ parser } = $parser;
|
||||||
$self->{ data } = undef;
|
|
||||||
|
delete $self->{ data }; # remove potential old results
|
||||||
|
delete $self->{ header };
|
||||||
|
|
||||||
my $characters;
|
my $characters;
|
||||||
my $current = '__STOP__';
|
#my @characters_from = ();
|
||||||
my $ignore = [ 'Envelope', 'Body' ];
|
my $current = undef;
|
||||||
my $list = [];
|
my $list = []; # node list
|
||||||
my $namespace = {};
|
my $path = []; # current path
|
||||||
my $path = [];
|
my $skip = 0; # skip elements
|
||||||
my $parser = XML::Parser::Expat->new();
|
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);
|
no strict qw(refs);
|
||||||
$parser->setHandlers(
|
$parser->setHandlers(
|
||||||
Start => sub {
|
Start => sub {
|
||||||
my ($parser, $element, %attrs) = @_;
|
# my ($parser, $element, %_attrs) = @_;
|
||||||
my ($prefix, $localname) = split m{:}xms , $element;
|
# $depth = $parser->depth();
|
||||||
# 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...
|
# call methods without using their parameter stack
|
||||||
push @{ $list }, $current; # remember current
|
# 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
|
# resolve class of this element
|
||||||
my $class = $self->{ class_resolver }->get_class( $path )
|
$_class = $self->{ class_resolver }->get_class( $path )
|
||||||
or die "Cannot resolve class for "
|
or die "Cannot resolve class for "
|
||||||
. join('/', @{ $path }) . " via $self->{ class_resolver }";
|
. join('/', @{ $path }) . " via " . $self->{ class_resolver };
|
||||||
|
|
||||||
# Check whether we have a primitive - we implement them as classes
|
if ($_class eq '__SKIP__') {
|
||||||
# TODO replace with UNIVERSAL->isa()
|
$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
|
# match is a bit faster if the string does not match, but WAY slower
|
||||||
# if $class matches...
|
# if $class matches...
|
||||||
# if (not $class=~m{^SOAP::WSDL::XSD::Typelib::Builtin}xms) {
|
if (index $_class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
|
||||||
|
# check wheter there is a non-empty ARRAY reference for $_class::ISA
|
||||||
if (index $class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
|
# or a "new" method
|
||||||
|
|
||||||
# check wheter there is a CODE reference for $class::new.
|
|
||||||
# If not, require it - all classes required here MUST
|
# If not, require it - all classes required here MUST
|
||||||
# define new()
|
# define new()
|
||||||
# This is the same as $class->can('new'), but it's way faster
|
# This is not exactly the same as $class->can('new'), but it's way faster
|
||||||
*{ "$class\::new" }{ CODE }
|
defined *{ "$_class\::new" }{ CODE }
|
||||||
or eval "require $class" ## no critic qw(ProhibitStringyEval)
|
or scalar @{ *{ "$_class\::ISA" }{ ARRAY } }
|
||||||
or die $@;
|
or eval "require $_class" ## no critic qw(ProhibitStringyEval)
|
||||||
|
or die $@;
|
||||||
}
|
}
|
||||||
# create object
|
|
||||||
# set current object
|
$current = $_class->new({ @_[2..$#_] }); # set new current object
|
||||||
$current = $class->new({ %attrs });
|
|
||||||
|
|
||||||
# remember top level element
|
# remember top level element
|
||||||
defined $self->{ data }
|
exists $self->{ data }
|
||||||
or ($self->{ data } = $current);
|
or ($self->{ data } = $current);
|
||||||
|
$depth++;
|
||||||
|
return;
|
||||||
},
|
},
|
||||||
Char => sub {
|
|
||||||
$characters .= $_[1];
|
|
||||||
},
|
|
||||||
End => sub {
|
|
||||||
my $element = $_[1];
|
|
||||||
|
|
||||||
my ($prefix, $localname) = split m{:}xms , $element;
|
Char => $char_handler,
|
||||||
# for non-prefixed elements
|
|
||||||
if (not $localname) {
|
End => sub {
|
||||||
$localname = $element;
|
pop @{ $path }; # step up in path
|
||||||
$prefix = q{};
|
|
||||||
|
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...
|
# This one easily handles ignores for us, too...
|
||||||
return if not ref $list->[-1];
|
return if not ref $list->[-1];
|
||||||
|
|
||||||
if ( $current
|
# set characters in current if we are a simple type
|
||||||
->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType') ) {
|
# we may have characters in complexTypes with simpleContent,
|
||||||
$current->set_value( $characters );
|
# 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
|
# set appropriate attribute in last element
|
||||||
# multiple values must be implemented in base class
|
# multiple values must be implemented in base class
|
||||||
my $method = "add_$localname";
|
#$_method = "add_$_localname";
|
||||||
|
$_method = "add_$_[1]";
|
||||||
|
$list->[-1]->$_method( $current );
|
||||||
|
|
||||||
$list->[-1]->$method( $current );
|
$current = pop @$list; # step up in object hierarchy...
|
||||||
|
return;
|
||||||
# step up in path
|
|
||||||
pop @{ $path };
|
|
||||||
|
|
||||||
# step up in object hierarchy...
|
|
||||||
$current = pop @{ $list };
|
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
|
return $parser;
|
||||||
$parser->parse( $xml );
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_data {
|
|
||||||
my $self = shift;
|
|
||||||
return $self->{ data };
|
|
||||||
}
|
|
||||||
|
|
||||||
|
sub get_header {
|
||||||
|
return $_[0]->{ header };
|
||||||
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
@@ -165,7 +199,14 @@ SOAP::WSDL::Expat::MessageParser - Convert SOAP messages to custom object trees
|
|||||||
|
|
||||||
Real fast expat based SOAP message parser.
|
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
|
=head1 Bugs and Limitations
|
||||||
|
|
||||||
@@ -193,9 +234,9 @@ This module may be used under the same terms as perl itself.
|
|||||||
|
|
||||||
$ID: $
|
$ID: $
|
||||||
|
|
||||||
$LastChangedDate: $
|
$LastChangedDate: 2007-10-07 19:27:58 +0200 (Son, 07 Okt 2007) $
|
||||||
$LastChangedRevision: $
|
$LastChangedRevision: 313 $
|
||||||
$LastChangedBy: $
|
$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;
|
package SOAP::WSDL::Expat::MessageStreamParser;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
|
||||||
use XML::Parser::Expat;
|
use XML::Parser::Expat;
|
||||||
|
use SOAP::WSDL::Expat::MessageParser;
|
||||||
|
use base qw(SOAP::WSDL::Expat::MessageParser);
|
||||||
|
|
||||||
=pod
|
sub parse_start {
|
||||||
|
|
||||||
=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 {
|
|
||||||
my $self = shift;
|
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 {
|
sub parse_done {
|
||||||
my $self = shift;
|
$_[0]->{ parser }->parse_done();
|
||||||
my $xml = shift;
|
$_[0]->{ parser }->release();
|
||||||
$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 get_data {
|
|
||||||
my $self = shift;
|
|
||||||
return $self->{ data };
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
=pod
|
=pod
|
||||||
@@ -170,19 +48,11 @@ SOAP::WSDL::Expat::MessageStreamParser - Convert SOAP messages to custom object
|
|||||||
|
|
||||||
ExpatNB based parser for parsing huge documents.
|
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
|
=head1 Bugs and Limitations
|
||||||
|
|
||||||
=over
|
See SOAP::WSDL::Expat::MessageParser
|
||||||
|
|
||||||
=item * Ignores all namespaces
|
|
||||||
|
|
||||||
=item * Does not handle mixed content
|
|
||||||
|
|
||||||
=item * The SOAP header is ignored
|
|
||||||
|
|
||||||
=back
|
|
||||||
|
|
||||||
=head1 AUTHOR
|
=head1 AUTHOR
|
||||||
|
|
||||||
@@ -198,9 +68,9 @@ This module may be used under the same terms as perl itself.
|
|||||||
|
|
||||||
$ID: $
|
$ID: $
|
||||||
|
|
||||||
$LastChangedDate: $
|
$LastChangedDate: 2007-10-07 19:27:58 +0200 (Son, 07 Okt 2007) $
|
||||||
$LastChangedRevision: $
|
$LastChangedRevision: 313 $
|
||||||
$LastChangedBy: $
|
$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,73 @@
|
|||||||
|
package [% interface_prefix %]::[% service.get_name %]::[% port.get_name %];
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Class::Std::Storable;
|
||||||
|
use base qw(SOAP::WSDL::Client::Base);
|
||||||
|
|
||||||
|
# only load if it hasn't been loaded before
|
||||||
|
require [% typemap_prefix %]::[% service.get_name %]
|
||||||
|
if not [% typemap_prefix %]::[% service.get_name %]->can('get_class');
|
||||||
|
|
||||||
|
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,47 @@
|
|||||||
|
use Class::Std::Storable;
|
||||||
|
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');
|
||||||
|
INCLUDE complexType/extension.tt(complexType = complexType);
|
||||||
|
ELSE;
|
||||||
|
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
|
||||||
|
END;
|
||||||
|
%]
|
||||||
@@ -0,0 +1,7 @@
|
|||||||
|
[% IF (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;
|
||||||
|
INCLUDE complexType/variety.tt(complexType = complexType);
|
||||||
|
END %]
|
||||||
@@ -0,0 +1,24 @@
|
|||||||
|
[%
|
||||||
|
|
||||||
|
base_name=complexType.expand( complexType.get_base);
|
||||||
|
base_type = definitions.first_types.find_type( base_name );
|
||||||
|
|
||||||
|
element_from = complexType.get_element;
|
||||||
|
|
||||||
|
#
|
||||||
|
# Sanity check: All original elements must be noted first
|
||||||
|
#
|
||||||
|
FOREACH element = base_type.get_element;
|
||||||
|
IF element_from.${ loop.index }.get_name != element.get_name;
|
||||||
|
THROW WSDL "${element.get_name} not found at position ${ loop.index } in extension type ${ complexType.get_name }";
|
||||||
|
END;
|
||||||
|
END;
|
||||||
|
|
||||||
|
|
||||||
|
-%]
|
||||||
|
use base qw([% type_prefix %]::[% base_name.1.replace('\.', '::') %]);
|
||||||
|
[%
|
||||||
|
|
||||||
|
INCLUDE complexType/variety.tt(complexType = complexType);
|
||||||
|
|
||||||
|
%]
|
||||||
@@ -0,0 +1,8 @@
|
|||||||
|
[% IF (base=complexType.get_base);
|
||||||
|
base_name=complexType.expand(base);
|
||||||
|
-%]
|
||||||
|
use base qw([% type_prefix %]::[% base_name.1.replace('\.', '::') %]);
|
||||||
|
[%
|
||||||
|
ELSE;
|
||||||
|
THROW NOT_IMPLEMENTED, "restriction without base not supported";
|
||||||
|
END %]
|
||||||
@@ -0,0 +1,13 @@
|
|||||||
|
[%
|
||||||
|
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);
|
||||||
|
ELSE;
|
||||||
|
THROW NOT_IMPLEMENTED, "Unknown variety ${ complexType.get_variety }";
|
||||||
|
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
|
=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
|
=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
|
=item * Look what has been generated
|
||||||
|
|
||||||
Check the results of the generator. There should be one
|
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
|
=item * Write script
|
||||||
|
|
||||||
use MyInterface::SERVICE_NAME;
|
use MyInterface::SERVICE_NAME::PORT_NAME;
|
||||||
my $service = MyInterface::SERVICE_NAME->new();
|
my $service = MyInterface::SERVICE_NAME::PORT_NAME->new();
|
||||||
|
|
||||||
my $result = $service->SERVICE_METHOD();
|
my $result = $service->SERVICE_METHOD();
|
||||||
die $result if not $result;
|
die $result if not $result;
|
||||||
|
|
||||||
print $result;
|
print $result;
|
||||||
|
|
||||||
C<perldoc MyInterface::SERVICE_NAME> should give you some overview about
|
C<perldoc MyInterface::SERVICE_NAME::PORT_NAME> should give you some overview
|
||||||
the service's interface structure.
|
about the service's interface structure.
|
||||||
|
|
||||||
The results of all calls to your service object's methods (except new)
|
The results of all calls to your service object's methods (except new) are
|
||||||
are objects based on SOAP::WSDL's XML schema implementation.
|
objects based on SOAP::WSDL's XML schema implementation.
|
||||||
|
|
||||||
These objects are false in boolean context, and serialize to XML when
|
|
||||||
printed.
|
|
||||||
|
|
||||||
To access the object's properties use get_NAME / set_NAME getter/setter
|
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
|
=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
|
To find out which class a particular XML node should be, SOAP::WSDL uses
|
||||||
typemaps. For every Web service, there's also a typemap created.
|
typemaps. For every Web service, there's also a typemap created.
|
||||||
|
|
||||||
|
=head2 Interface class creation
|
||||||
|
|
||||||
|
To create interface classes, follow the steps above from
|
||||||
|
L<Quick walk-through for the unpatient|Quick walk-through for the unpatient>.
|
||||||
|
|
||||||
|
If this works fine for you, skip the next paragraphs. If not, read on.
|
||||||
|
|
||||||
|
The steps to instrument a web service with SOAP::WSDL perl bindings
|
||||||
|
(in detail) are as follows:
|
||||||
|
|
||||||
|
=over
|
||||||
|
|
||||||
|
=item * Gather web service information
|
||||||
|
|
||||||
|
You'll need to know at least a URL pointing to the web service's WSDL
|
||||||
|
definition.
|
||||||
|
|
||||||
|
If you already know more - like which methods the service provides, or how
|
||||||
|
the XML messages look like, that's fine. All these things will help you
|
||||||
|
later.
|
||||||
|
|
||||||
|
=item * Create WSDL bindings
|
||||||
|
|
||||||
|
perl wsdl2perl.pl -b base_dir URL
|
||||||
|
|
||||||
|
This will generate the perl bindings in the directory specified by base_dir.
|
||||||
|
|
||||||
|
For more options, see L<wsdl2perl.pl> - you may want to specify class
|
||||||
|
prefixes for XML type and element classes, type maps and interface classes,
|
||||||
|
and you may even want to add custom typemap elements.
|
||||||
|
|
||||||
|
=item * Check the result
|
||||||
|
|
||||||
|
There should be a bunch of classes for types (in the MyTypes:: namespace by
|
||||||
|
default), elements (in MyElements::), and at least one typemap (in
|
||||||
|
MyTypemaps::) and one 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
|
=head1 SEE ALSO
|
||||||
|
|
||||||
L<SOAP::WSDL::Manual::Glossary> The meaning of all these words
|
L<SOAP::WSDL::Manual::Glossary> The meaning of all these words
|
||||||
|
|||||||
@@ -7,13 +7,16 @@ SOAP::WSDL::Manual::Glossary - Those acronyms and stuff
|
|||||||
=head2 web service
|
=head2 web service
|
||||||
|
|
||||||
Web services are RPC (Remote Procedure Call) interfaces accessible via
|
Web services are RPC (Remote Procedure Call) interfaces accessible via
|
||||||
the internet, typically via HTTP(S).
|
some internet protocol, typically via HTTP(S).
|
||||||
|
|
||||||
=head2 SOAP
|
=head2 SOAP
|
||||||
|
|
||||||
SOAP (the Simple Object Access Protocol) is a specification for
|
SOAP is an acronym for Simple Object Access Protocol.
|
||||||
defining RPC interfaces, including (but not neccessarily limited to)
|
SOAP is a W3C recommendation. The latest version of the SOAP
|
||||||
web services.
|
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
|
While one of the constituting aspects of a web service is its
|
||||||
reachability via some internet protocol, you might as well define
|
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
|
Despite it's name, SOAP has nothing more to do with objects than
|
||||||
cars have with pets - SOAP messages may, but not neccessarily do
|
cars have with pets - SOAP messages may, but not neccessarily do
|
||||||
carry object, very much like your car may, but does not need to
|
carry objects, very much like your car may, but does not need to
|
||||||
carry your pet.
|
carry your pet.
|
||||||
|
|
||||||
=head2 WSDL
|
=head2 WSDL
|
||||||
|
|
||||||
WSDL (Web Service Definition Language) is a XML-based markup language
|
WSDL is an acronym for Web Services Description Language.
|
||||||
for defining web service interfaces.
|
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
|
=head2 WS-I
|
||||||
|
|
||||||
WS-I (Web Service Interoperability) is a industry consortium dedicated
|
WS-I (Web Services Interoperability Organization) is an open industry
|
||||||
to finding interoperability rules for web services.
|
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
|
=head1 LICENSE
|
||||||
|
|
||||||
|
|||||||
@@ -2,12 +2,12 @@
|
|||||||
|
|
||||||
=head1 NAME
|
=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 ?
|
=head1 Which XML message does SOAP::WSDL parse ?
|
||||||
|
|
||||||
Naturally, there are two kinds of XMLdocuments (or messages) SOAP::WSDL
|
Naturally, there are two kinds of XML documents (or messages) SOAP::WSDL has
|
||||||
has to parse:
|
to parse:
|
||||||
|
|
||||||
=over
|
=over
|
||||||
|
|
||||||
@@ -19,38 +19,60 @@ has to parse:
|
|||||||
|
|
||||||
=head1 Parser implementations
|
=head1 Parser implementations
|
||||||
|
|
||||||
There are different parser implementations available for SOAP messages -
|
There are different parser implementations available for SOAP messages and
|
||||||
currently there's only one for WSDL definitions.
|
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
|
=head2 WSDL definitions parser
|
||||||
|
|
||||||
=over
|
=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
|
A parser for WSDL definitions based on L<XML::Parser::Expat|XML::Parser::Expat>.
|
||||||
works with.
|
|
||||||
|
|
||||||
It's built as a native handler for XML::LibXML, but will also work with
|
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
|
||||||
XML::SAX::ParserFactory.
|
my $wsdl = $parser->parse_file( $filename );
|
||||||
|
|
||||||
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();
|
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
@@ -90,6 +112,29 @@ A class resolver package might look like this:
|
|||||||
};
|
};
|
||||||
1;
|
1;
|
||||||
|
|
||||||
|
=head3 Skipping unwanted items
|
||||||
|
|
||||||
|
Sometimes there's unneccessary information transported in SOAP messages.
|
||||||
|
|
||||||
|
To skip XML nodes (including all child nodes), just edit the type map for
|
||||||
|
the message and set the type map entry to '__SKIP__'.
|
||||||
|
|
||||||
|
In the example above, EnqueueMessage/StuffIDontNeed and all child elements
|
||||||
|
are skipped.
|
||||||
|
|
||||||
|
my %class_list = (
|
||||||
|
'EnqueueMessage' => 'Typelib::TEnqueueMessage',
|
||||||
|
'EnqueueMessage/MMessage' => 'Typelib::TMessage',
|
||||||
|
'EnqueueMessage/MMessage/MRecipientURI' => 'SOAP::WSDL::XSD::Builtin::anyURI',
|
||||||
|
'EnqueueMessage/MMessage/MMessageContent' => 'SOAP::WSDL::XSD::Builtin::string',
|
||||||
|
'EnqueueMessage/StuffIDontNeed' => '__SKIP__',
|
||||||
|
'EnqueueMessage/StuffIDontNeed/Foo' => 'SOAP::WSDL::XSD::Builtin::string',
|
||||||
|
'EnqueueMessage/StuffIDontNeed/Bar' => 'SOAP::WSDL::XSD::Builtin::string',
|
||||||
|
);
|
||||||
|
|
||||||
|
Note that only SOAP::WSDL::Expat::MessageParser implements skipping elements
|
||||||
|
at the time of writing.
|
||||||
|
|
||||||
=head3 Creating type lib classes
|
=head3 Creating type lib classes
|
||||||
|
|
||||||
Every element must have a correspondent one in the type library.
|
Every element must have a correspondent one in the type library.
|
||||||
@@ -109,18 +154,6 @@ L<SOAP::WSDL::XSD::Typelib::ComplexType> and L<SOAP::WSDL::XSD::Typelib::SimpleT
|
|||||||
|
|
||||||
=over
|
=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
|
=item * SOAP::WSDL::Expat::MessageParser
|
||||||
|
|
||||||
A L<XML::Parser::Expat|XML::Parser::Expat> based parser. This is the fastest
|
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,
|
A XML::Parser::ExpatNB based parser. Useful for parsing huge HTTP responses,
|
||||||
as you don't need to keep everything in memory.
|
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
|
=back
|
||||||
|
|
||||||
@@ -175,4 +209,56 @@ to a response size of around 500k:
|
|||||||
|
|
||||||
Response size: 344330 bytes
|
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
|
=cut
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,333 @@
|
|||||||
|
=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
|
||||||
|
|
||||||
|
Note that complexType classes with complexContent content model don't exhibit
|
||||||
|
their type via the xsi:type attribute yet, so they currently cannot be used
|
||||||
|
as a replacement for their base type.
|
||||||
|
|
||||||
|
SOAP::WSDL's XSD deserializer backend does not recognize the xsi:type=""
|
||||||
|
attribute either yet.
|
||||||
|
|
||||||
|
=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
|
||||||
|
|
||||||
|
=item * extension variety
|
||||||
|
|
||||||
|
ComplexType classes with extension variety inherit from the XSD base
|
||||||
|
complexType class and from their base type.
|
||||||
|
|
||||||
|
Extension classes are checked for (re-)defining all elements of their parent
|
||||||
|
class.
|
||||||
|
|
||||||
|
Note that a derived type's elements (=properties) overrides the getter /
|
||||||
|
setter methods for all inherited elements. All object data is stored in the
|
||||||
|
derived type's class, not in the defining class (See L<Class::Std> for a
|
||||||
|
discussion on inside out object data storage).
|
||||||
|
|
||||||
|
No additional processing or content checking is performed yet.
|
||||||
|
|
||||||
|
complexType complexType
|
||||||
|
base class base type class
|
||||||
|
^ ^
|
||||||
|
| |
|
||||||
|
-----------------
|
||||||
|
|
|
||||||
|
complexType
|
||||||
|
extension
|
||||||
|
|
||||||
|
=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.
|
||||||
|
|
||||||
|
=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
|
||||||
|
|
||||||
|
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 Class::Std::Storable;
|
||||||
use base qw(SOAP::WSDL::Base);
|
use base qw(SOAP::WSDL::Base);
|
||||||
|
|
||||||
my %body_of :ATTR(:name<body> :default<()>);
|
my %body_of :ATTR(:name<body> :default<[]>);
|
||||||
my %message_of :ATTR(:name<message> :default<()>);
|
my %header_of :ATTR(:name<header> :default<[]>);
|
||||||
my %use_of :ATTR(:name<use> :default<()>);
|
my %headerfault_of :ATTR(:name<headerfault> :default<[]>);
|
||||||
my %namespace :ATTR(:name<namespace> :default<()>);
|
my %message_of :ATTR(:name<message> :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;
|
|
||||||
}
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|||||||
@@ -5,14 +5,12 @@ use Class::Std::Storable;
|
|||||||
use base qw/SOAP::WSDL::Base/;
|
use base qw/SOAP::WSDL::Base/;
|
||||||
|
|
||||||
my %operation_of :ATTR(:name<operation> :default<()>);
|
my %operation_of :ATTR(:name<operation> :default<()>);
|
||||||
my %input_of :ATTR(:name<input> :default<()>);
|
my %input_of :ATTR(:name<input> :default<[]>);
|
||||||
my %output_of :ATTR(:name<output> :default<()>);
|
my %output_of :ATTR(:name<output> :default<[]>);
|
||||||
my %fault_of :ATTR(:name<fault> :default<()>);
|
my %fault_of :ATTR(:name<fault> :default<[]>);
|
||||||
my %type_of :ATTR(:name<type> :default<()>);
|
my %type_of :ATTR(:name<type> :default<()>);
|
||||||
my %style_of :ATTR(:name<style> :default<()>);
|
my %style_of :ATTR(:name<style> :default<()>);
|
||||||
my %transport_of :ATTR(:name<transport> :default<()>);
|
my %transport_of :ATTR(:name<transport> :default<()>);
|
||||||
my %parameterOrder_of :ATTR(:name<parameterOrder> :default<()>);
|
my %parameterOrder_of :ATTR(:name<parameterOrder> :default<()>);
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -41,49 +41,4 @@ sub serialize
|
|||||||
die "Neither type nor element - don't know what to do";
|
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;
|
||||||
|
|||||||
+1
-34
@@ -5,39 +5,6 @@ use Class::Std::Storable;
|
|||||||
use base qw(SOAP::WSDL::Base);
|
use base qw(SOAP::WSDL::Base);
|
||||||
|
|
||||||
my %binding_of :ATTR(:name<binding> :default<()>);
|
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;
|
||||||
|
|||||||
@@ -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;
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user