Compare commits
9 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
5c42b1d8f6 | ||
|
|
21b5330a8d | ||
|
|
7716d4349a | ||
|
|
6fe52c4370 | ||
|
|
bfbf5e27e0 | ||
|
|
903b3e95e4 | ||
|
|
a31389246e | ||
|
|
95465c33d9 | ||
|
|
1d8092299a |
33
Build.PL
Normal file
33
Build.PL
Normal file
@@ -0,0 +1,33 @@
|
||||
use Module::Build;
|
||||
Module::Build->new(
|
||||
dist_abstract => 'SOAP with WSDL support',
|
||||
dist_name => 'SOAP-WSDL',
|
||||
dist_version => '2.00_04',
|
||||
module_name => 'SOAP::WSDL',
|
||||
license => 'artistic',
|
||||
requires => {
|
||||
'Class::Std' => q/v0.0.8/,
|
||||
'Class::Std::Storable' => 0,
|
||||
'SOAP::Lite' => 0,
|
||||
'XML::XPath' => 0,
|
||||
'XML::LibXML' => 0,
|
||||
'XML::SAX::Base' => 0,
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
},
|
||||
buildrequires => {
|
||||
'Benchmark' => 0,
|
||||
'Cwd' => 0,
|
||||
'Test::More' => 0,
|
||||
'SOAP::Lite' => 0,
|
||||
'Class::Std' => 0.0.8,
|
||||
'Class::Std::Storable' => 0,
|
||||
'XML::XPath' => 0,
|
||||
'XML::Simple' => 0,
|
||||
'XML::LibXML' => 0,
|
||||
'XML::SAX::Base' => 0,
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
'Pod::Simple::Text' => 0,
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
|
||||
},
|
||||
)->create_build_script;
|
||||
110
CHANGES
110
CHANGES
@@ -1,53 +1,57 @@
|
||||
$Log: CHANGES,v $
|
||||
Revision 1.18 2004/07/16 07:43:05 lsc
|
||||
fixed test scripts for windows
|
||||
|
||||
Revision 1.17 2004/07/05 08:19:49 lsc
|
||||
- added wsdl_checkoccurs
|
||||
|
||||
Revision 1.16 2004/07/04 09:01:14 lsc
|
||||
- change <definitions> element lookup from find('/definitions') and find('wsdl:definitions') to find('/*[1]') to process arbitrary default (wsdl) namespaces correctly
|
||||
- fixed test output in test 06
|
||||
|
||||
Revision 1.15 2004/07/02 12:28:31 lsc
|
||||
- documentation update
|
||||
- cosmetics
|
||||
|
||||
Revision 1.14 2004/07/02 10:53:36 lsc
|
||||
- API change:
|
||||
- call now behaves (almost) like SOAP::Lite::call
|
||||
- call() takes a list (hash) as second argument
|
||||
- call does no longer support the "dispatch" option
|
||||
- dispatching calls can be suppressed by passing
|
||||
"no_dispatch => 1" to new()
|
||||
- dispatching calls can be suppressed by calling
|
||||
$soap->no_dispatch(1);
|
||||
and re-enabled by calling
|
||||
$soap->no_dispatch(0);
|
||||
- Updated test skripts to reflect API change.
|
||||
|
||||
Revision 1.13 2004/06/30 12:08:40 lsc
|
||||
- added IServiceInstance (ecmed) to acceptance tests
|
||||
- refined documentation
|
||||
|
||||
Revision 1.12 2004/06/26 14:13:29 lsc
|
||||
- refined file caching
|
||||
- added descriptive output to test scripts
|
||||
|
||||
Revision 1.11 2004/06/26 07:55:40 lsc
|
||||
- fixed "freeze" caching bug
|
||||
- improved test scripts to test file system caching (and show the difference)
|
||||
|
||||
Revision 1.10 2004/06/26 06:30:33 lsc
|
||||
- added filesystem caching using Cache::FileCache
|
||||
|
||||
Revision 1.9 2004/06/24 12:27:23 lsc
|
||||
Cleanup
|
||||
|
||||
Revision 1.8 2004/06/11 19:49:15 lsc
|
||||
- moved .t files to more self-describing names
|
||||
- changed WSDL.pm to accept AXIS wsdl files
|
||||
- implemented XPath query result caching on all absolute queries
|
||||
|
||||
Revision 1.7 2004/06/07 13:01:16 lsc
|
||||
added changelog to pod
|
||||
$Log: CHANGES,v $
|
||||
|
||||
Revision 1.19 2004/07/27 13:00:03 lsc
|
||||
- added missing test file
|
||||
|
||||
Revision 1.18 2004/07/16 07:43:05 lsc
|
||||
fixed test scripts for windows
|
||||
|
||||
Revision 1.17 2004/07/05 08:19:49 lsc
|
||||
- added wsdl_checkoccurs
|
||||
|
||||
Revision 1.16 2004/07/04 09:01:14 lsc
|
||||
- change <definitions> element lookup from find('/definitions') and find('wsdl:definitions') to find('/*[1]') to process arbitrary default (wsdl) namespaces correctly
|
||||
- fixed test output in test 06
|
||||
|
||||
Revision 1.15 2004/07/02 12:28:31 lsc
|
||||
- documentation update
|
||||
- cosmetics
|
||||
|
||||
Revision 1.14 2004/07/02 10:53:36 lsc
|
||||
- API change:
|
||||
- call now behaves (almost) like SOAP::Lite::call
|
||||
- call() takes a list (hash) as second argument
|
||||
- call does no longer support the "dispatch" option
|
||||
- dispatching calls can be suppressed by passing
|
||||
"no_dispatch => 1" to new()
|
||||
- dispatching calls can be suppressed by calling
|
||||
$soap->no_dispatch(1);
|
||||
and re-enabled by calling
|
||||
$soap->no_dispatch(0);
|
||||
- Updated test skripts to reflect API change.
|
||||
|
||||
Revision 1.13 2004/06/30 12:08:40 lsc
|
||||
- added IServiceInstance (ecmed) to acceptance tests
|
||||
- refined documentation
|
||||
|
||||
Revision 1.12 2004/06/26 14:13:29 lsc
|
||||
- refined file caching
|
||||
- added descriptive output to test scripts
|
||||
|
||||
Revision 1.11 2004/06/26 07:55:40 lsc
|
||||
- fixed "freeze" caching bug
|
||||
- improved test scripts to test file system caching (and show the difference)
|
||||
|
||||
Revision 1.10 2004/06/26 06:30:33 lsc
|
||||
- added filesystem caching using Cache::FileCache
|
||||
|
||||
Revision 1.9 2004/06/24 12:27:23 lsc
|
||||
Cleanup
|
||||
|
||||
Revision 1.8 2004/06/11 19:49:15 lsc
|
||||
- moved .t files to more self-describing names
|
||||
- changed WSDL.pm to accept AXIS wsdl files
|
||||
- implemented XPath query result caching on all absolute queries
|
||||
|
||||
Revision 1.7 2004/06/07 13:01:16 lsc
|
||||
added changelog to pod
|
||||
|
||||
26
HACKING
Normal file
26
HACKING
Normal file
@@ -0,0 +1,26 @@
|
||||
Development of SOAP::WSDL takes place on sourceforge.net.
|
||||
|
||||
There's a svn repository available at
|
||||
https://svn.sourceforge.net/svnroot/soap-wsdl
|
||||
|
||||
Engagement in the further development of this module is highly encouraged -
|
||||
many people have already contributed, and many more probably will.
|
||||
|
||||
I'm sometimes a bit slow in answering e-mails or merging in changes -
|
||||
so if you feel your changes are urgent, please set up a sourceforge account
|
||||
and ask me for commit permissions on the repository - I will happily accept
|
||||
you as co-author.
|
||||
|
||||
The (my) current roadmap for SOAP::WSDL is:
|
||||
|
||||
1.2*: Bugfixes and support for more XSD variants
|
||||
|
||||
1.3: Bindings support
|
||||
|
||||
Development of the 1.* tree has stopped - I won't get past 1.2x anymore...
|
||||
|
||||
2.*: WSDL -> Perl Class factory with offline WSDL processing
|
||||
|
||||
May 2007,
|
||||
|
||||
Martin Kutter
|
||||
7
LICENSE
Normal file
7
LICENSE
Normal file
@@ -0,0 +1,7 @@
|
||||
SOAP::WSDL is dual licensed under the same terms as
|
||||
Perl itself.
|
||||
|
||||
This means at your choice, either the Perl Artistic License, or
|
||||
the GNU GPL version 1 or higher.
|
||||
|
||||
|
||||
160
MANIFEST
160
MANIFEST
@@ -1,9 +1,151 @@
|
||||
t/1_performance.t
|
||||
t/2_helloworld.NET.t
|
||||
t/acceptance/helloworld.asmx.xml
|
||||
t/acceptance/helloworld.xml
|
||||
WSDL.pm
|
||||
MANIFEST
|
||||
README
|
||||
CHANGES
|
||||
Makefile.PL
|
||||
Build.PL
|
||||
CHANGES
|
||||
HACKING
|
||||
lib/SOAP/WSDL.pm
|
||||
lib/SOAP/WSDL/Base.pm
|
||||
lib/SOAP/WSDL/Binding.pm
|
||||
lib/SOAP/WSDL/Client.pm
|
||||
lib/SOAP/WSDL/Client/Base.pm
|
||||
lib/SOAP/WSDL/Definitions.pm
|
||||
lib/SOAP/WSDL/Envelope.pm
|
||||
lib/SOAP/WSDL/Message.pm
|
||||
lib/SOAP/WSDL/Operation.pm
|
||||
lib/SOAP/WSDL/OpMessage.pm
|
||||
lib/SOAP/WSDL/Part.pm
|
||||
lib/SOAP/WSDL/Port.pm
|
||||
lib/SOAP/WSDL/PortType.pm
|
||||
lib/SOAP/WSDL/SAX/MessageHandler.pm
|
||||
lib/SOAP/WSDL/SAX/WSDLHandler.pm
|
||||
lib/SOAP/WSDL/Service.pm
|
||||
lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
|
||||
lib/SOAP/WSDL/SoapOperation.pm
|
||||
lib/SOAP/WSDL/TypeLookup.pm
|
||||
lib/SOAP/WSDL/Types.pm
|
||||
lib/SOAP/WSDL/XSD/ComplexType.pm
|
||||
lib/SOAP/WSDL/XSD/Element.pm
|
||||
lib/SOAP/WSDL/XSD/Primitive.pm
|
||||
lib/SOAP/WSDL/XSD/Schema.pm
|
||||
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
||||
lib/SOAP/WSDL/XSD/SimpleType.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/Element.pm
|
||||
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||
LICENSE
|
||||
MANIFEST
|
||||
META.yml
|
||||
README
|
||||
t/001_use.t
|
||||
t/002_sax.t
|
||||
t/003_sax_serializer.t
|
||||
t/004_sax_wsdl.t
|
||||
t/005_sax_contributed_wsdl.t
|
||||
t/006_client.t
|
||||
t/007_envelope.t
|
||||
t/008_client_wsdl_complexType.t
|
||||
t/009_data_classes.t
|
||||
t/011_simpleType.t
|
||||
t/012_element.t
|
||||
t/013_complexType.t
|
||||
t/014_sax_typelib.t
|
||||
t/015_to_typemap.t
|
||||
t/016_client_object.t
|
||||
t/020_storable.t
|
||||
t/098_pod.t
|
||||
t/acceptance/results/03_complexType-all.xml
|
||||
t/acceptance/results/03_complexType-sequence.xml
|
||||
t/acceptance/results/04_element-simpleType.xml
|
||||
t/acceptance/results/04_element.xml
|
||||
t/acceptance/results/05_simpleType-list.xml
|
||||
t/acceptance/results/05_simpleType-restriction.xml
|
||||
t/acceptance/results/05_simpleType-union.xml
|
||||
t/acceptance/results/11_helloworld.xml
|
||||
t/acceptance/wsdl/006_sax_client.wsdl
|
||||
t/acceptance/wsdl/008_complexType.wsdl
|
||||
t/acceptance/wsdl/02_port.wsdl
|
||||
t/acceptance/wsdl/03_complexType-all.wsdl
|
||||
t/acceptance/wsdl/03_complexType-sequence.wsdl
|
||||
t/acceptance/wsdl/04_element-simpleType.wsdl
|
||||
t/acceptance/wsdl/04_element.wsdl
|
||||
t/acceptance/wsdl/05_simpleType-list.wsdl
|
||||
t/acceptance/wsdl/05_simpleType-restriction.wsdl
|
||||
t/acceptance/wsdl/05_simpleType-union.wsdl
|
||||
t/acceptance/wsdl/10_helloworld.asmx.xml
|
||||
t/acceptance/wsdl/11_helloworld.wsdl
|
||||
t/acceptance/wsdl/contributed/Axis.wsdl
|
||||
t/acceptance/wsdl/contributed/ETest.wsdl
|
||||
t/acceptance/wsdl/contributed/OITest.wsdl
|
||||
t/acceptance/wsdl/contributed/tools.wsdl
|
||||
t/acceptance/wsdl/email_account.wsdl
|
||||
t/attic/01_use.t
|
||||
t/attic/02_port.t
|
||||
t/attic/03_complexType-all.t
|
||||
t/attic/03_complexType-choice.t
|
||||
t/attic/03_complexType-complexContent.t
|
||||
t/attic/03_complexType-group.t
|
||||
t/attic/03_complexType-sequence.t
|
||||
t/attic/03_complexType-simpleContent.t
|
||||
t/attic/04_element-complexType.t
|
||||
t/attic/04_element-simpleType.t
|
||||
t/attic/04_element.t
|
||||
t/attic/05_simpleType-list.t
|
||||
t/attic/05_simpleType-restriction.t
|
||||
t/attic/05_simpleType-union.t
|
||||
t/attic/10_performance.t
|
||||
t/attic/11_helloworld.NET.t
|
||||
t/attic/12_binding.pl
|
||||
t/attic/97_pod.t
|
||||
t/attic/98_pod_coverage.t
|
||||
t/lib/MyComplexType.pm
|
||||
t/lib/MyElement.pm
|
||||
t/lib/MySimpleType.pm
|
||||
t/lib/Test/SOAPMessage.pm
|
||||
t/lib/Typelib/Base.pm
|
||||
t/lib/Typelib/TEnqueueMessage.pm
|
||||
t/lib/Typelib/TMessage.pm
|
||||
|
||||
177
META.yml
Normal file
177
META.yml
Normal file
@@ -0,0 +1,177 @@
|
||||
---
|
||||
name: SOAP-WSDL
|
||||
version: 2.00_04
|
||||
author:
|
||||
abstract: SOAP with WSDL support
|
||||
license: artistic
|
||||
requires:
|
||||
Class::Std: v0.0.8
|
||||
Class::Std::Storable: 0
|
||||
SOAP::Lite: 0
|
||||
XML::LibXML: 0
|
||||
XML::SAX::Base: 0
|
||||
XML::SAX::ParserFactory: 0
|
||||
XML::XPath: 0
|
||||
generated_by: Module::Build version 0.2808
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
||||
version: 1.2
|
||||
provides:
|
||||
SOAP::WSDL:
|
||||
file: lib/SOAP/WSDL.pm
|
||||
version: 2.00_04
|
||||
SOAP::WSDL::Base:
|
||||
file: lib/SOAP/WSDL/Base.pm
|
||||
SOAP::WSDL::Binding:
|
||||
file: lib/SOAP/WSDL/Binding.pm
|
||||
SOAP::WSDL::Client:
|
||||
file: lib/SOAP/WSDL/Client.pm
|
||||
SOAP::WSDL::Client::Base:
|
||||
file: lib/SOAP/WSDL/Client/Base.pm
|
||||
version: 0.1
|
||||
SOAP::WSDL::Definitions:
|
||||
file: lib/SOAP/WSDL/Definitions.pm
|
||||
SOAP::WSDL::Envelope:
|
||||
file: lib/SOAP/WSDL/Envelope.pm
|
||||
SOAP::WSDL::Message:
|
||||
file: lib/SOAP/WSDL/Message.pm
|
||||
SOAP::WSDL::OpMessage:
|
||||
file: lib/SOAP/WSDL/OpMessage.pm
|
||||
SOAP::WSDL::Operation:
|
||||
file: lib/SOAP/WSDL/Operation.pm
|
||||
SOAP::WSDL::Part:
|
||||
file: lib/SOAP/WSDL/Part.pm
|
||||
SOAP::WSDL::Port:
|
||||
file: lib/SOAP/WSDL/Port.pm
|
||||
SOAP::WSDL::PortType:
|
||||
file: lib/SOAP/WSDL/PortType.pm
|
||||
SOAP::WSDL::SAX::MessageHandler:
|
||||
file: lib/SOAP/WSDL/SAX/MessageHandler.pm
|
||||
SOAP::WSDL::SAX::WSDLHandler:
|
||||
file: lib/SOAP/WSDL/SAX/WSDLHandler.pm
|
||||
SOAP::WSDL::SOAP::Typelib::Fault11:
|
||||
file: lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
|
||||
SOAP::WSDL::Service:
|
||||
file: lib/SOAP/WSDL/Service.pm
|
||||
SOAP::WSDL::SoapOperation:
|
||||
file: lib/SOAP/WSDL/SoapOperation.pm
|
||||
SOAP::WSDL::TypeLookup:
|
||||
file: lib/SOAP/WSDL/TypeLookup.pm
|
||||
SOAP::WSDL::Types:
|
||||
file: lib/SOAP/WSDL/Types.pm
|
||||
SOAP::WSDL::XSD::ComplexType:
|
||||
file: lib/SOAP/WSDL/XSD/ComplexType.pm
|
||||
SOAP::WSDL::XSD::Element:
|
||||
file: lib/SOAP/WSDL/XSD/Element.pm
|
||||
SOAP::WSDL::XSD::Primitive:
|
||||
file: lib/SOAP/WSDL/XSD/Primitive.pm
|
||||
SOAP::WSDL::XSD::Schema:
|
||||
file: lib/SOAP/WSDL/XSD/Schema.pm
|
||||
SOAP::WSDL::XSD::Schema::Builtin:
|
||||
file: lib/SOAP/WSDL/XSD/Schema/Builtin.pm
|
||||
SOAP::WSDL::XSD::SimpleType:
|
||||
file: lib/SOAP/WSDL/XSD/SimpleType.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::ENTITY:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::ID:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::IDREF:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::IDREFS:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::NCName:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::NMTOKENS:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::NOTATION:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::Name:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::QName:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::anyType:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::anyURI:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::base64Binary:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::boolean:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::byte:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::date:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::dateTime:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::decimal:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::double:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::duration:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::float:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::gDay:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::gMonth:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::gYear:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::hexBinary:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::int:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::integer:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::language:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::long:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::negativeInteger:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::normalizedString:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::short:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::string:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::time:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::token:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
|
||||
SOAP::WSDL::XSD::Typelib::Element:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/Element.pm
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType::restriction:
|
||||
file: lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
|
||||
resources:
|
||||
license: http://opensource.org/licenses/artistic-license.php
|
||||
10
Makefile.PL
10
Makefile.PL
@@ -1,10 +0,0 @@
|
||||
#!/usr/bin/perl -w
|
||||
use ExtUtils::MakeMaker;
|
||||
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
# the contents of the Makefile that is written.
|
||||
WriteMakefile(
|
||||
'NAME' => 'SOAP::WSDL',
|
||||
'VERSION_FROM' => 'WSDL.pm', # finds $VERSION
|
||||
'PREREQ_PM' => { 'XML::XPath' => 0,
|
||||
'SOAP::Lite' => 0 }
|
||||
);
|
||||
31
README
31
README
@@ -1,29 +1,4 @@
|
||||
SOAP::WSDL - a WSDL-driven message preprocessor for SOAP::Lite.
|
||||
This is a developer release - everything may (and most things will) change.
|
||||
|
||||
DESCRIPTION
|
||||
|
||||
See "perldoc SOAP::WSDL" (or "perldoc WSDL.pm") for details.
|
||||
|
||||
|
||||
PREREQUISITES
|
||||
|
||||
SOAP::WSDL requires the following perl modules:
|
||||
|
||||
- SOAP::Lite
|
||||
- XML::XPath
|
||||
|
||||
|
||||
INSTALLING
|
||||
|
||||
Use the usual mantra:
|
||||
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
|
||||
LICENSE
|
||||
|
||||
This library is free software, you can distribute it under the same
|
||||
terms as perl itself.
|
||||
You should not expect the SOAP::WSDL to survive - it will probably be replaced
|
||||
by SOAP::WSDL::Client.
|
||||
575
lib/SOAP/WSDL.pm
Normal file
575
lib/SOAP/WSDL.pm
Normal file
@@ -0,0 +1,575 @@
|
||||
package SOAP::WSDL;
|
||||
use strict;
|
||||
use warnings;
|
||||
use vars qw/$AUTOLOAD/;
|
||||
use Scalar::Util qw(blessed);
|
||||
use SOAP::WSDL::Envelope;
|
||||
use SOAP::WSDL::SAX::WSDLHandler;
|
||||
use base qw(SOAP::Lite);
|
||||
use Data::Dumper;
|
||||
|
||||
our $VERSION='2.00_04';
|
||||
|
||||
BEGIN {
|
||||
eval {
|
||||
use XML::LibXML;
|
||||
};
|
||||
if ($@) {
|
||||
use XML::SAX::ParserFactory;
|
||||
}
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
|
||||
die "$method not found";
|
||||
}
|
||||
|
||||
sub outputtree {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ outputtree } if not @_;
|
||||
return $self->{ _WSDL }->{ outputtree } = shift;
|
||||
}
|
||||
|
||||
sub class_resolver {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ class_resolver } if not @_;
|
||||
return $self->{ _WSDL }->{ class_resolver } = shift;
|
||||
}
|
||||
|
||||
sub wsdlinit {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
|
||||
my $wsdl_xml = SOAP::Schema->new( schema_url => $self->wsdl() )->access(
|
||||
$self->wsdl()
|
||||
);
|
||||
|
||||
my $filter;
|
||||
my $parser = eval { XML::LibXML->new() };
|
||||
if ($parser) {
|
||||
$filter = SOAP::WSDL::SAX::WSDLHandler->new();
|
||||
$parser->set_handler( $filter );
|
||||
}
|
||||
else {
|
||||
$filter = SOAP::WSDL::SAX::WSDLHandler->new( base => 'XML::SAX::Base' );
|
||||
$parser = XML::SAX::ParserFactory->parser( Handler => $filter );
|
||||
}
|
||||
|
||||
$parser->parse_string( $wsdl_xml );
|
||||
|
||||
my $wsdl_definitions = $filter->get_data()
|
||||
or die "unable to parse WSDL";
|
||||
|
||||
my $types = $wsdl_definitions->first_types()
|
||||
or die "unable to extract schema from WSDL";
|
||||
|
||||
my $ns = $wsdl_definitions->get_xmlns()
|
||||
or die "unable to extract XML Namespaces" . $wsdl_definitions->to_string;
|
||||
( %{ $ns } ) or die "unable to extract XML Namespaces";
|
||||
|
||||
# setup lookup variables
|
||||
$self->{ _WSDL }->{ wsdl_definitions } = $wsdl_definitions;
|
||||
$self->{ _WSDL }->{ serialize_options } = {
|
||||
autotype => 0,
|
||||
readable => $self->readable(),
|
||||
typelib => $types,
|
||||
namespace => $ns,
|
||||
};
|
||||
$self->{ _WSDL }->{ explain_options } = {
|
||||
readable => $self->readable(),
|
||||
wsdl => $wsdl_definitions,
|
||||
namespace => $ns,
|
||||
typelib => $types,
|
||||
};
|
||||
|
||||
$self->servicename($opt{servicename}) if $opt{servicename};
|
||||
$self->portname($opt{portname}) if $opt{portname};
|
||||
return $self;
|
||||
} ## end sub wsdlinit
|
||||
|
||||
sub _wsdl_get_service {
|
||||
my $self = shift;
|
||||
my $service;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
if ( $self->{ _WSDL }->{ servicename } )
|
||||
{
|
||||
$service =
|
||||
$wsdl->find_service( $ns, $self->{ _WSDL }->{ servicename } );
|
||||
}
|
||||
else
|
||||
{
|
||||
$service = $wsdl->get_service()->[ 0 ];
|
||||
warn "no servicename specified - using " . $service->get_name();
|
||||
}
|
||||
return $self->{ _WSDL }->{ service } = $service;
|
||||
} ## end sub _wsdl_get_service
|
||||
|
||||
sub _wsdl_get_port {
|
||||
my $self = shift;
|
||||
my $service = $self->{ _WSDL }->{ service }
|
||||
|| $self->_wsdl_get_service();
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
my $port;
|
||||
if ( $self->{ _WSDL }->{ portname } )
|
||||
{
|
||||
$port = $service->get_port( $ns, $self->{ _WSDL }->{ portname } );
|
||||
}
|
||||
else
|
||||
{
|
||||
$port = $service->get_port()->[ 0 ];
|
||||
}
|
||||
$self->{ _WSDL }->{ port } = $port;
|
||||
|
||||
# preload portType
|
||||
$self->_wsdl_get_portType();
|
||||
|
||||
# Auto-set proxy - required before issuing call()
|
||||
$self->proxy( $port->get_location() );
|
||||
|
||||
return $port;
|
||||
} ## end sub _wsdl_get_port
|
||||
|
||||
sub _wsdl_get_binding {
|
||||
my $self = shift;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
my $port = $self->{ _WSDL }->{ port }
|
||||
|| $self->_wsdl_get_port();
|
||||
|
||||
my ( $prefix, $localname ) = split /:/, $port->get_binding();
|
||||
|
||||
# TODO lookup $ns instead of just using
|
||||
# the top element's targetns...
|
||||
my $binding = $wsdl->find_binding( $ns, $localname )
|
||||
or die "no binding found for ", $port->get_binding();
|
||||
return $self->{ _WSDL }->{ binding } = $binding;
|
||||
} ## end sub _wsdl_get_binding
|
||||
|
||||
sub _wsdl_get_portType {
|
||||
my $self = shift;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $binding = $self->{ _WSDL }->{ binding }
|
||||
|| $self->_wsdl_get_binding();
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
my ( $prefix, $localname ) = split /:/, $binding->get_type();
|
||||
my $portType = $wsdl->find_portType( $ns, $localname );
|
||||
$self->{ _WSDL }->{ portType } = $portType;
|
||||
return $portType;
|
||||
} ## end sub _wsdl_get_portType
|
||||
|
||||
|
||||
sub _wsdl_init_methods {
|
||||
my $self = shift;
|
||||
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
|
||||
my $ns = $wsdl->get_targetNamespace();
|
||||
|
||||
# get bindings, portType, message, part(s)
|
||||
# - use cached values where possible for speed,
|
||||
# private methods if not for clear separation...
|
||||
my $binding = $self->{ _WSDL }->{ binding }
|
||||
|| $self->_wsdl_get_binding()
|
||||
|| die "Can't find binding";
|
||||
my $portType = $self->{ _WSDL }->{ portType }
|
||||
|| $self->_wsdl_get_portType()
|
||||
|| die "Can't find portType";
|
||||
|
||||
my $methodHashRef = {};
|
||||
|
||||
foreach my $binding_operation (@{ $binding->get_operation() })
|
||||
{
|
||||
my $method = {};
|
||||
|
||||
# get SOAP Action
|
||||
# SOAP-Action is a required HTTP Header, so we need to look it up...
|
||||
my $soap_binding_operation = $binding_operation->get_operation()->[0];
|
||||
$method->{ soap_action } = $soap_binding_operation ?
|
||||
$soap_binding_operation->get_soapAction() : $method;
|
||||
|
||||
# get parts
|
||||
# 1. get operation from port
|
||||
my $operation = $portType->find_operation( $ns,
|
||||
$binding_operation->get_name() );
|
||||
|
||||
# 2. get input message name
|
||||
my ( $prefix, $localname ) = split /:/,
|
||||
$operation->first_input()->get_message();
|
||||
|
||||
# 3. get input message
|
||||
my $message = $wsdl->find_message( $ns, $localname )
|
||||
or die "Message {$ns}$localname not found in WSDL definition";
|
||||
|
||||
$method->{ parts } = $message->get_part();
|
||||
|
||||
# rpc / encoded methods may have a namespace specified.
|
||||
# look it up and set it...
|
||||
$method->{ namespace } = $binding_operation
|
||||
? do {
|
||||
my $input = $binding_operation->first_input();
|
||||
$input ? $input->get_namespace() : undef;
|
||||
}
|
||||
: undef;
|
||||
|
||||
$methodHashRef->{ $binding_operation->get_name() } = $method;
|
||||
}
|
||||
|
||||
$self->{ _WSDL }->{ methodInfo } = $methodHashRef;
|
||||
|
||||
return $methodHashRef;
|
||||
}
|
||||
|
||||
sub call {
|
||||
my $self = shift;
|
||||
my $method = shift;
|
||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
||||
|
||||
my $content = q{};
|
||||
my $envelope;
|
||||
my $methodInfo;
|
||||
|
||||
if (blessed $data
|
||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
||||
{
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data , { readable => 1 });
|
||||
|
||||
# TODO replace by something derived from binding - this is just a
|
||||
# workaround...
|
||||
$methodInfo->{ soap_action }
|
||||
= join '/', $data->get_xmlns(), $method;
|
||||
}
|
||||
else {
|
||||
my $methodLookup = $self->{ _WSDL }->{ methodInfo }
|
||||
|| $self->_wsdl_init_methods();
|
||||
|
||||
$methodInfo = $methodLookup->{ $method };
|
||||
my $partListRef = $methodInfo->{ parts };
|
||||
|
||||
# set serializer options
|
||||
# TODO allow custom options here
|
||||
my $opt = $self->{ _WSDL }->{ serialize_options };
|
||||
|
||||
# set response target namespace
|
||||
# TODO make rpc-encoded encoding recognise this namespace
|
||||
# $opt->{ targetNamespace } = $soap_binding_operation ?
|
||||
# $operation->input()->namespace() : undef;
|
||||
|
||||
# serialize content
|
||||
# TODO create surrounding element for rpc-encoded messages
|
||||
foreach my $part ( @{ $partListRef } ) {
|
||||
$content .= $part->serialize( $method, $data, $opt );
|
||||
}
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $content , $opt );
|
||||
};
|
||||
|
||||
|
||||
if ( $self->no_dispatch() )
|
||||
{
|
||||
return $envelope;
|
||||
} ## end if ( $self->no_dispatch...
|
||||
|
||||
# get response via transport layer
|
||||
# TODO remove dependency from SOAP::Lite and use a
|
||||
# SAX-based filter using XML::LibXML to get the
|
||||
# result.
|
||||
# Filter should have the following methods:
|
||||
# - result: returns the result of the call (like SOAP::Lite, but as
|
||||
# perl data structure)
|
||||
# - header: returns the content of the SOAP header
|
||||
# - fault: returns the result of the call if a SOAP fault is sent back
|
||||
# by the server. Retuns undef (nothing) if the call has been
|
||||
# processed without errors.
|
||||
my $response = $self->transport->send_receive(
|
||||
context => $self, # this is provided for context
|
||||
endpoint => $self->endpoint(),
|
||||
action => $methodInfo->{ soap_action }, # SOAPAction from binding
|
||||
envelope => $envelope, # use custom content
|
||||
);
|
||||
|
||||
return $response if ($self->outputxml() );
|
||||
|
||||
if ($self->outputtree()) {
|
||||
|
||||
my ($parser, $handler); # replace by globals - singleton is faster
|
||||
if (not $parser) {
|
||||
require SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
require SOAP::WSDL::SAX::MessageHandler;
|
||||
require XML::LibXML;
|
||||
$handler = SOAP::WSDL::SAX::MessageHandler->new(
|
||||
{ class_resolver => $self->class_resolver() },
|
||||
);
|
||||
$parser = XML::LibXML->new();
|
||||
$parser->set_handler( $handler);
|
||||
}
|
||||
|
||||
# if we had no success (Transport layer error status code)
|
||||
# or if transport layer failed
|
||||
if (! $self->transport->is_success() ) {
|
||||
# Try deserializing response - there may be some
|
||||
if ($response) {
|
||||
eval { $parser->parse_string( $response ) };
|
||||
return $handler->get_data if not $@;
|
||||
};
|
||||
|
||||
# generate & return fault if we cannot serialize response
|
||||
# or have none...
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => 'Error sending / receiving message: '
|
||||
. $self->transport->message()
|
||||
});
|
||||
}
|
||||
|
||||
eval { $parser->parse_string( $response ) };
|
||||
|
||||
# return fault if we cannot deserialize response
|
||||
if ($@) {
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => "Error deserializing message: $@. \n"
|
||||
. "Message was: \n$response"
|
||||
});
|
||||
}
|
||||
|
||||
return $handler->get_data();
|
||||
}
|
||||
|
||||
# deserialize and store result
|
||||
my $result = $self->{ '_call' } =
|
||||
eval { $self->deserializer->deserialize( $response ) }
|
||||
if $response;
|
||||
|
||||
if (
|
||||
!$self->transport->is_success || # transport fault
|
||||
$@ || # not deserializible
|
||||
# fault message even if transport OK
|
||||
# or no transport error (for example, fo TCP, POP3, IO implementations)
|
||||
UNIVERSAL::isa( $result => 'SOAP::SOM' ) && $result->fault
|
||||
)
|
||||
{
|
||||
return $self->{ '_call' } = (
|
||||
$self->on_fault->(
|
||||
$self, $@ ? $@ . ( $response || '' ) : $result
|
||||
)
|
||||
|| $result
|
||||
);
|
||||
# ? # trick editors
|
||||
} ## 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' );
|
||||
&_load_method( 'wsdl' );
|
||||
|
||||
sub servicename {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ servicename } if ( not @_ );
|
||||
$self->{ _WSDL }->{ servicename } = shift;
|
||||
|
||||
my $ns = $self->{ _WSDL }->{ wsdl_definitions }->get_targetNamespace();
|
||||
|
||||
$self->{ _WSDL }->{ service } =
|
||||
$self->{ _WSDL }->{ wsdl_definitions }
|
||||
->find_service( $ns, $self->{ _WSDL }->{ servicename } )
|
||||
or die "No such service: " . $self->{ _WSDL }->{ servicename };
|
||||
return $self;
|
||||
} ## end sub servicename
|
||||
|
||||
sub portname {
|
||||
my $self = shift;
|
||||
return $self->{ _WSDL }->{ portname } if ( not @_ );
|
||||
$self->{ _WSDL }->{ portname } = shift;
|
||||
|
||||
my $ns = $self->{ _WSDL }->{ wsdl_definitions }->get_targetNamespace();
|
||||
|
||||
$self->{ _WSDL }->{ port } =
|
||||
$self->{ _WSDL }->{ service }
|
||||
->find_port( $ns, $self->{ _WSDL }->{ portname } )
|
||||
or die "No such port: " . $self->{ _WSDL }->{ portname };
|
||||
return $self;
|
||||
} ## end sub portname
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL - SOAP with WSDL support
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file://bla.wsdl',
|
||||
readable => 1,
|
||||
)->wsdlinit();
|
||||
|
||||
my $result = $soap->call('MyMethod', %data);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL provides easy access to Web Services with WSDL descriptions.
|
||||
|
||||
The WSDL is parsed and stored in memory.
|
||||
|
||||
Your data is serialized according to the rules in the WSDL and sent via
|
||||
SOAP::Lite's transport mechanism.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 servicename
|
||||
|
||||
$soap->servicname('Name');
|
||||
|
||||
Sets the service to operate on. If no service is set via servicename, the
|
||||
first service found is used.
|
||||
|
||||
Returns the soap object, so you can chain calls like
|
||||
|
||||
$soap->servicename->('Name')->portname('Port');
|
||||
|
||||
=head2 _wsdl_init_methods
|
||||
|
||||
=over
|
||||
|
||||
=item DESCRIPTION
|
||||
|
||||
Creates a lookup table containing the information required for all methods
|
||||
specified for the service/port selected.
|
||||
|
||||
The lookup table is used by L<call|call>.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 Differences to previous versions
|
||||
|
||||
=over
|
||||
|
||||
=item * WSDL handling
|
||||
|
||||
SOAP::WSDL 2 is a complete rewrite. While SOAP::WSDL 1.x attempted to
|
||||
process the WSDL file on the fly by using XPath queries, SOAP:WSDL 2 uses a
|
||||
SAX filter for parsing the WSDL and building up a object tree representing
|
||||
it's content.
|
||||
|
||||
The object tree has two main functions: It knows how to serialize data passed
|
||||
as hash ref, and how to render the WSDL elements found into perl classes.
|
||||
|
||||
Yup your're right, there's a builting code generation facility.
|
||||
|
||||
=item * outputxml
|
||||
|
||||
call() with outputtxml set to true now returns the complete SOAP
|
||||
envelope, not only the body's content.
|
||||
|
||||
=back
|
||||
|
||||
=head1 Differences to SOAP::Lite
|
||||
|
||||
=head2 Auto-Dispatching
|
||||
|
||||
SOAP::WSDL does B<does not> support auto-dispatching.
|
||||
|
||||
This is on purpose: You may easily create interface classes by using
|
||||
SOAP::WSDL and implementing something like
|
||||
|
||||
sub mySoapMethod {
|
||||
my $self = shift;
|
||||
$soap_wsdl_client->call( mySoapMethod, @_);
|
||||
}
|
||||
|
||||
You may even do this in a class factory - SOAP::WSDL provides the methods
|
||||
for generating such interfaces.
|
||||
|
||||
SOAP::Lite's autodispatching mechanism is - though convenient - a constant
|
||||
source of errors: Every typo in a method name gets caught by AUTOLOAD and
|
||||
may lead to unpredictable results.
|
||||
|
||||
=head1 Bugs and Limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * readable
|
||||
|
||||
readable() must be called before calling wsdlinit. This is a bug.
|
||||
|
||||
=item * Unsupported XML Schema definitions
|
||||
|
||||
The following XML Schema definitions are not supported:
|
||||
|
||||
choice
|
||||
group
|
||||
union
|
||||
simpleContent
|
||||
complexContent
|
||||
|
||||
=item * Serialization of hash refs dos not work for ambiguous values
|
||||
|
||||
If you have list elements with multiple occurences allowed, SOAP::WSDL
|
||||
has no means of finding out which variant you meant.
|
||||
|
||||
Passing in item => [1,2,3] could serialize to
|
||||
|
||||
<item>1 2</item><item>3</item>
|
||||
<item>1</item><item>2 3</item>
|
||||
|
||||
Ambiguos data can be avoided by passing an object tree as data.
|
||||
|
||||
=item * XML Schema facets
|
||||
|
||||
Almost all XML schema facets are not yet implemented. The only facets
|
||||
currently implemented are:
|
||||
|
||||
fixed
|
||||
default
|
||||
|
||||
The following facets have no influence yet:
|
||||
|
||||
minLength
|
||||
maxLength
|
||||
minInclusive
|
||||
maxInclusive
|
||||
minExclusive
|
||||
maxExclusive
|
||||
pattern
|
||||
enumeration
|
||||
|
||||
=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>
|
||||
|
||||
=cut
|
||||
|
||||
105
lib/SOAP/WSDL/Base.pm
Normal file
105
lib/SOAP/WSDL/Base.pm
Normal file
@@ -0,0 +1,105 @@
|
||||
package SOAP::WSDL::Base;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Class::Std::Storable;
|
||||
|
||||
my %id_of :ATTR(:name<id> :default<()>);
|
||||
my %name_of :ATTR(:name<name> :default<()>);
|
||||
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
|
||||
my %xmlns_of :ATTR(:name<xmlns> :default<{}>);
|
||||
|
||||
sub STORABLE_freeze_pre :CUMULATIVE {};
|
||||
sub STORABLE_freeze_post :CUMULATIVE {};
|
||||
sub STORABLE_thaw_pre :CUMULATIVE {};
|
||||
sub STORABLE_thaw_post :CUMULATIVE { return $_[0] };
|
||||
|
||||
# unfortunately, AUTOMETHOD is SLOW.
|
||||
# Re-implement in derived package wherever speed is an issue...
|
||||
#
|
||||
sub AUTOMETHOD {
|
||||
my ($self, $ident, @values) = @_;
|
||||
my $subname = $_; # Requested subroutine name is passed via $_
|
||||
|
||||
# we're called as $self->push_something(@values);
|
||||
if ($subname =~s{^push_}{}xms) {
|
||||
# we're not paranoid - we could be checking get_subname, too
|
||||
my $getter = "get_$subname";
|
||||
my $setter = "set_$subname";
|
||||
croak "no set accessor found for push_$subname"
|
||||
if not ($self->can( $setter ));
|
||||
return sub {
|
||||
no strict qw(refs);
|
||||
my $old_value = $self->$getter();
|
||||
# Listify if not a list ref
|
||||
$old_value = $old_value ? [ $old_value ] : [] if not ref $old_value;
|
||||
|
||||
push @$old_value , @values;
|
||||
$self->$setter( $old_value );
|
||||
};
|
||||
}
|
||||
|
||||
# we're called as $obj->find_something($ns, $key)
|
||||
elsif ($subname =~s {^find_}{get_}xms) {
|
||||
return sub {
|
||||
my @found_at = grep {
|
||||
$_->get_targetNamespace() eq $values[0] &&
|
||||
$_->get_name() eq $values[1]
|
||||
}
|
||||
@{ $self->$subname() };
|
||||
return $found_at[0];
|
||||
}
|
||||
}
|
||||
elsif ($subname =~s {^first_}{get_}xms) {
|
||||
return sub {
|
||||
my $result_ref = $self->$subname();
|
||||
return if not $result_ref;
|
||||
return $result_ref if (not ref $result_ref eq 'ARRAY');
|
||||
return $result_ref->[0];
|
||||
};
|
||||
}
|
||||
croak "$subname not found in class " . (ref $self || $self);
|
||||
}
|
||||
|
||||
#sub to_string :STRINGIFY {
|
||||
# $_[0]->_DUMP();
|
||||
#}
|
||||
|
||||
sub init {
|
||||
my $self = shift;
|
||||
my @args = @_;
|
||||
foreach my $value (@args)
|
||||
{
|
||||
die $value if (not defined ($value->{ Name }));
|
||||
if ($value->{ Name } =~m{^xmlns\:}xms) {
|
||||
die $xmlns_of{ ident $self }
|
||||
if ref $xmlns_of{ ident $self } ne 'HASH';
|
||||
$xmlns_of{ ident $self }->{ $value->{ Value } } =
|
||||
$value->{ LocalName };
|
||||
next;
|
||||
}
|
||||
elsif ($value->{ Name } =~m{^xmlns$}xms) {
|
||||
# just ignore xmlns = for now
|
||||
# TODO handle xmlns correctly - maybe via setting a prefix ?
|
||||
next;
|
||||
}
|
||||
my $name = $value->{ LocalName };
|
||||
my $method = "set_$name";
|
||||
$self->$method( $value->{ Value } ) if ( $method );
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub add_namespace {
|
||||
my ($self, $uri, $prefix ) = @_;
|
||||
return unless $uri;
|
||||
$self->{ namespace } ||= {};
|
||||
$self->{ namespace }->{ $uri } = $prefix;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
warn "to_typemap";
|
||||
return q{};
|
||||
}
|
||||
|
||||
1;
|
||||
131
lib/SOAP/WSDL/Binding.pm
Normal file
131
lib/SOAP/WSDL/Binding.pm
Normal file
@@ -0,0 +1,131 @@
|
||||
package SOAP::WSDL::Binding;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %operation_of :ATTR(:name<operation> :default<()>);
|
||||
my %type_of :ATTR(:name<type> :default<()>);
|
||||
my %transport_of :ATTR(:name<transport> :default<()>);
|
||||
my %style_of :ATTR(:name<style> :default<()>);
|
||||
|
||||
sub explain {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $name = $self->get_name();
|
||||
|
||||
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
|
||||
my ($prefix, $localname) = split /:/ , $self->get_type();
|
||||
my $portType = $opt->{ wsdl }->find_portType(
|
||||
$ns_map{ $prefix }, $localname
|
||||
) or die "portType $prefix:$localname not found !";
|
||||
|
||||
|
||||
my $txt = <<"EOT";
|
||||
|
||||
=head2 Binding name: $name
|
||||
|
||||
=over
|
||||
|
||||
=item * Style $style_of{ ident $self }
|
||||
|
||||
=item * Transport $transport_of{ ident $self }
|
||||
|
||||
=back
|
||||
|
||||
=head3 Operations
|
||||
|
||||
EOT
|
||||
|
||||
foreach my $operation (@{ $self->get_operation() })
|
||||
{
|
||||
my $operation_name = $operation->get_name();
|
||||
my $operation_style = $operation->get_style() || q{};
|
||||
|
||||
my $port_operation = $portType->find_operation( $ns_map{ $prefix },
|
||||
$operation->get_name() )
|
||||
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";
|
||||
|
||||
=over
|
||||
|
||||
=item * $operation_name
|
||||
|
||||
=over 8
|
||||
|
||||
=item * Style: $operation_style
|
||||
|
||||
=item * Input Message:
|
||||
|
||||
$input_message
|
||||
|
||||
=item * Output Message:
|
||||
|
||||
$output_message
|
||||
|
||||
=item * Fault:
|
||||
|
||||
$fault_message
|
||||
|
||||
=back
|
||||
|
||||
=back
|
||||
|
||||
EOT
|
||||
}
|
||||
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
my ($self, $opt) = @_;
|
||||
my $name = $self->get_name();
|
||||
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
my ($prefix, $localname) = split /:/ , $self->get_type();
|
||||
my $portType = $opt->{ wsdl }->find_portType(
|
||||
$ns_map{ $prefix }, $localname
|
||||
) or die "portType $prefix:$localname not found !";
|
||||
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 = $portType->find_operation( $ns_map{ $prefix },
|
||||
$operation->get_name() )
|
||||
or die "operation not found:" . $operation->get_name();
|
||||
|
||||
# TODO rename lexical $input to "message"
|
||||
$txt .= do {
|
||||
my $input = $port_operation->first_input();
|
||||
$input ? $input->to_typemap($opt) : q{};
|
||||
};
|
||||
$txt .= do {
|
||||
my $input = $port_operation->first_output();
|
||||
$input ? $input->to_typemap($opt) : q{};
|
||||
};
|
||||
$txt .= do {
|
||||
my $input = $port_operation->first_fault();
|
||||
$input ? $input->to_typemap($opt) : q{};
|
||||
};
|
||||
}
|
||||
return $txt;
|
||||
}
|
||||
|
||||
1;
|
||||
208
lib/SOAP/WSDL/Client.pm
Normal file
208
lib/SOAP/WSDL/Client.pm
Normal file
@@ -0,0 +1,208 @@
|
||||
package SOAP::WSDL::Client;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Scalar::Util qw(blessed);
|
||||
use SOAP::WSDL::Envelope;
|
||||
use SOAP::Lite;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::SAX::MessageHandler;
|
||||
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
|
||||
# Package globals for speed...
|
||||
my $PARSER;
|
||||
my $MESSAGE_HANDLER;
|
||||
|
||||
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
|
||||
my %no_dispatch_of :ATTR(:name<no_dispatch> :default<()>);
|
||||
my %outputxml_of :ATTR(:name<outputxml> :default<()>);
|
||||
my %proxy_of :ATTR(:name<proxy> :default<()>);
|
||||
|
||||
# TODO remove when preparing 2.01
|
||||
sub outputtree { warn 'outputtree is deprecated and'
|
||||
. 'will be removed before reaching v2.01 !' }
|
||||
|
||||
SUBFACTORY: {
|
||||
no strict qw(refs);
|
||||
for (qw(class_resolver no_dispatch outputxml proxy)) {
|
||||
my $setter = "set_$_";
|
||||
my $getter = "get_$_";
|
||||
*{ $_ } = sub { my $self = shift;
|
||||
if (@_) {
|
||||
$self->$setter(@_);
|
||||
return $self;
|
||||
}
|
||||
return $self->$getter()
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
BEGIN {
|
||||
eval {
|
||||
require XML::LibXML;
|
||||
$PARSER = XML::LibXML->new();
|
||||
$MESSAGE_HANDLER = SOAP::WSDL::SAX::MessageHandler->new();
|
||||
$PARSER->set_handler( $MESSAGE_HANDLER );
|
||||
};
|
||||
if ($@) {
|
||||
require XML::SAX::ParserFactory;
|
||||
$MESSAGE_HANDLER = SOAP::WSDL::SAX::MessageHandler->new({
|
||||
base => 'XML::SAX::Base' });
|
||||
$PARSER = XML::SAX::ParserFactory->parser(
|
||||
handler => $MESSAGE_HANDLER );
|
||||
}
|
||||
}
|
||||
|
||||
sub call {
|
||||
my $self = shift;
|
||||
my $method = shift;
|
||||
my $data = ref $_[0] ? $_[0] : { @_ };
|
||||
my $content = q{};
|
||||
my ($envelope, $soap_action);
|
||||
|
||||
if (blessed $data
|
||||
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
|
||||
{
|
||||
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
|
||||
|
||||
# TODO replace by something derived from binding - this is just a
|
||||
# workaround...
|
||||
$soap_action = join '/', $data->get_xmlns(), $method;
|
||||
|
||||
}
|
||||
|
||||
return $envelope if $self->no_dispatch();
|
||||
|
||||
# warn $envelope;
|
||||
|
||||
# get response via transport layer
|
||||
# TODO remove dependency from SOAP::Lite and use a
|
||||
# SAX-based filter using XML::LibXML to get the
|
||||
# result.
|
||||
# Filter should have the following methods:
|
||||
# - result: returns the result of the call (like SOAP::Lite, but as
|
||||
# perl data structure)
|
||||
# - header: returns the content of the SOAP header
|
||||
# - fault: returns the result of the call if a SOAP fault is sent back
|
||||
# by the server. Retuns undef (nothing) if the call has been
|
||||
# processed without errors.
|
||||
my $soap = SOAP::Lite->new()->proxy( $self->get_proxy() );
|
||||
my $response = $soap->transport->send_receive(
|
||||
context => $self, # this is provided for context
|
||||
endpoint => $soap->endpoint(),
|
||||
action => $soap_action, # SOAPAction, should be from binding
|
||||
envelope => $envelope, # use custom content
|
||||
);
|
||||
|
||||
# warn 'Received ' . length($response) . ' bytes of content';
|
||||
|
||||
return $response if ($self->outputxml() );
|
||||
|
||||
$MESSAGE_HANDLER->set_class_resolver( $self->get_class_resolver() );
|
||||
|
||||
# if we had no success (Transport layer error status code)
|
||||
# or if transport layer failed
|
||||
if (! $soap->transport->is_success() ) {
|
||||
# Try deserializing response - there may be some
|
||||
if ($response) {
|
||||
eval { $PARSER->parse_string( $response ) };
|
||||
return $MESSAGE_HANDLER->get_data if not $@;
|
||||
};
|
||||
|
||||
require SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
# generate & return fault if we cannot serialize response
|
||||
# or have none...
|
||||
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
|
||||
faultcode => 'soap:Server',
|
||||
faultactor => 'urn:localhost',
|
||||
faultstring => 'Error sending / receiving message: '
|
||||
. $soap->transport->message()
|
||||
});
|
||||
}
|
||||
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 $MESSAGE_HANDLER->get_data();
|
||||
} ## end sub call
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head2 Features different from SOAP::Lite
|
||||
|
||||
SOAP::WSDL does not aim to be a complete replacement for SOAP::Lite - the
|
||||
SOAP::Lite module has it's strengths and weaknesses and SOAP::WSDL is
|
||||
designed as a cure for the weakness of little WSDL support - nothing more,
|
||||
nothing less.
|
||||
|
||||
Nonetheless SOAP::WSDL mimics part of SOAP::Lite's API and behaviour,
|
||||
so SOAP::Lite users can switch without looking up every method call in the
|
||||
documentation.
|
||||
|
||||
A few things are quite differentl from SOAP::Lite, though:
|
||||
|
||||
=head3 SOAP request data
|
||||
|
||||
SOAP request data may either be given as message object, or as hash ref (in
|
||||
which case it will automatically be encoded into a message object).
|
||||
|
||||
=head3 Return values
|
||||
|
||||
The result from call() is not a SOAP::SOM object, but a message object.
|
||||
|
||||
Message objects' classes may be generated from WSDL definitions automatically
|
||||
- see SOAP::WSDL::Generator::Typelib on how to generate your own WSDL based
|
||||
message class library.
|
||||
|
||||
=head3 Fault handling
|
||||
|
||||
SOAP::WSDL::Client returns a fault object on errors, even on transport layer
|
||||
errors.
|
||||
|
||||
The fault object is a SOAP1.1 fault object of the following
|
||||
C<SOAP::WSDL::SOAP::Typelib::Fault11>.
|
||||
|
||||
SOAP::WSDL::SOAP::Typelib::Fault11 objects are false in boolean context, so
|
||||
you can just do something like
|
||||
|
||||
my $result = $soap->call($method, $data);
|
||||
|
||||
if ($result) {
|
||||
# handle result
|
||||
}
|
||||
else {
|
||||
die $result->faultstring();
|
||||
}
|
||||
|
||||
=head3 outputxml
|
||||
|
||||
SOAP::Lite returns only the content of the SOAP body when outputxml is set
|
||||
to true. SOAP::WSDL::Client returns the complete XML response.
|
||||
|
||||
=head3 Auto-Dispatching
|
||||
|
||||
SOAP::WSDL::Client does B<does not> support auto-dispatching.
|
||||
|
||||
This is on purpose: You may easily create interface classes by using
|
||||
SOAP::WSDL::Client and implementing something like
|
||||
|
||||
sub mySoapMethod {
|
||||
my $self = shift;
|
||||
$soap_wsdl_client->call( mySoapMethod, @_);
|
||||
}
|
||||
|
||||
You may even do this in a class factory - SOAP::WSDL provides the methods
|
||||
for generating such interfaces.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
127
lib/SOAP/WSDL/Client/Base.pm
Normal file
127
lib/SOAP/WSDL/Client/Base.pm
Normal file
@@ -0,0 +1,127 @@
|
||||
#!/usr/bin/perl -w
|
||||
package SOAP::WSDL::Client::Base;
|
||||
|
||||
##################################################################################
|
||||
## <OWNER>Internetteam
|
||||
## <AUTHOR>Martin Kutter <martin.kutter@siemens.com>
|
||||
## <CREATIONDATE>25.10.2006
|
||||
##
|
||||
## <FUNCTION>Base client for WSDL-based SOAP access
|
||||
## Automatisch gefüllt:
|
||||
## <CVSPROJECT>$HeadURL:$
|
||||
## <REVISION>$Revision:$
|
||||
################################################################################
|
||||
|
||||
use strict;
|
||||
use Log::Log4perl;
|
||||
|
||||
use Class::Accessor;
|
||||
|
||||
use base qw/Class::Accessor/;
|
||||
|
||||
$SOAP::WSDL::Client::Base::VERSION = sprintf("0.%d", q$LastChangedRevision: 1$ =~/(\d+)/ );
|
||||
|
||||
__PACKAGE__->mk_accessors(
|
||||
qw//
|
||||
);
|
||||
|
||||
my $log = undef; # Global logger to speed up performance
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Client::Base - Base client for WSDL-based SOAP access
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use SOAP::WSDL::Client::Base;
|
||||
|
||||
# TODO Add more Synopsis information
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
# TODO Add Description
|
||||
|
||||
=cut
|
||||
|
||||
=pod
|
||||
|
||||
=head2 new
|
||||
|
||||
=over
|
||||
|
||||
=item SYNOPSIS
|
||||
|
||||
my $obj = ->new();
|
||||
|
||||
=item DESCRIPTION
|
||||
|
||||
Constructor.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new
|
||||
{
|
||||
my $proto = shift;
|
||||
my $class = ref $proto || $proto;
|
||||
my $self = {
|
||||
soapBindingStyle => 'rpc',
|
||||
};
|
||||
bless $self, $class;
|
||||
$self->init(@_);
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub soapBindingStyle
|
||||
{
|
||||
my $self = shift;
|
||||
my $style = shift;
|
||||
if ($style)
|
||||
{
|
||||
die "Binding style must be one of rpc|document"
|
||||
if (not( $style=~m/^(rpc|document)$/));
|
||||
$self->{ soapBindingStyle } = $style;
|
||||
}
|
||||
return $self->{ soapBindingStyle };
|
||||
}
|
||||
|
||||
sub init
|
||||
{
|
||||
}
|
||||
|
||||
sub call
|
||||
{
|
||||
my $self = shift;
|
||||
my $method = shift;
|
||||
my $data = shift;
|
||||
my $content;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter <martin.kutter@siemens.com>
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
Copyright (c) 2005 SIEMENS AG. All rights reserved.
|
||||
|
||||
=head1 Repository information
|
||||
|
||||
$ID: $
|
||||
|
||||
$LastChangedDate: $
|
||||
$LastChangedRevision: $
|
||||
$LastChangedBy: $
|
||||
|
||||
$HeadURL: $
|
||||
|
||||
=cut
|
||||
62
lib/SOAP/WSDL/Definitions.pm
Normal file
62
lib/SOAP/WSDL/Definitions.pm
Normal file
@@ -0,0 +1,62 @@
|
||||
package SOAP::WSDL::Definitions;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %types_of :ATTR(:name<types> :default<[]>);
|
||||
my %message_of :ATTR(:name<message> :default<()>);
|
||||
my %portType_of :ATTR(:name<portType> :default<()>);
|
||||
my %binding_of :ATTR(:name<binding> :default<()>);
|
||||
my %service_of :ATTR(:name<service> :default<()>);
|
||||
|
||||
my %namespace_of :ATTR(:name<namespace> :default<()>);
|
||||
|
||||
my %attributes_of :ATTR();
|
||||
|
||||
%attributes_of = (
|
||||
binding => \%binding_of,
|
||||
message => \%message_of,
|
||||
portType => \%portType_of,
|
||||
service => \%service_of,
|
||||
);
|
||||
|
||||
# Function factory - we could be writing this method for all %attribute
|
||||
# keys, too, but that's just C&P (eehm, Copy & Paste...)
|
||||
foreach my $method(keys %attributes_of ) {
|
||||
no strict qw/refs/;
|
||||
|
||||
# ... btw, we mean this method here...
|
||||
*{ "find_$method" } = sub {
|
||||
my ($self, @args) = @_;
|
||||
my @found_at = grep {
|
||||
$_->get_targetNamespace() eq $args[0] &&
|
||||
$_->get_name() eq $args[1]
|
||||
}
|
||||
@{ $attributes_of{ $method }->{ ident $self } };
|
||||
return $found_at[0];
|
||||
};
|
||||
}
|
||||
|
||||
sub explain {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $txt = '';
|
||||
foreach my $service (@{ $self->get_service() })
|
||||
{
|
||||
$txt .= $service->explain( $opt );
|
||||
$txt .= "\n";
|
||||
}
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
$opt->{ wsdl } ||= $self;
|
||||
$opt->{ prefix } ||= q{};
|
||||
return join "\n",
|
||||
map { $_->to_typemap( $opt ) } @{ $service_of{ ident $self } };
|
||||
}
|
||||
|
||||
1;
|
||||
66
lib/SOAP/WSDL/Envelope.pm
Normal file
66
lib/SOAP/WSDL/Envelope.pm
Normal file
@@ -0,0 +1,66 @@
|
||||
#!/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;
|
||||
}
|
||||
9
lib/SOAP/WSDL/Message.pm
Normal file
9
lib/SOAP/WSDL/Message.pm
Normal file
@@ -0,0 +1,9 @@
|
||||
package SOAP::WSDL::Message;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %part_of :ATTR(:name<part> :default<[]>);
|
||||
|
||||
1;
|
||||
67
lib/SOAP/WSDL/OpMessage.pm
Normal file
67
lib/SOAP/WSDL/OpMessage.pm
Normal file
@@ -0,0 +1,67 @@
|
||||
package SOAP::WSDL::OpMessage;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %body_of :ATTR(:name<body> :default<()>);
|
||||
my %message_of :ATTR(:name<message> :default<()>);
|
||||
my %use_of :ATTR(:name<use> :default<()>);
|
||||
my %namespace :ATTR(:name<namespace> :default<()>);
|
||||
my %encodingStyle_of :ATTR(:name<encodingStyle> :default<()>);
|
||||
|
||||
sub explain
|
||||
{
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $name = shift;
|
||||
my $txt = '';
|
||||
|
||||
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
|
||||
if ( $self->get_message() ) {
|
||||
|
||||
my ($prefix, $localname) = split /:/ , $self->get_message();
|
||||
|
||||
# TODO allow more messages && overloading by specifying name
|
||||
my $message = $opt->{ wsdl }->get_message(
|
||||
$ns_map{ $prefix }, $localname
|
||||
);
|
||||
|
||||
for my $part(@{ $message->[0]->get_part() }) {
|
||||
$opt->{ indent } .= "\t";
|
||||
$txt .= $part->explain($opt);
|
||||
$opt->{ indent } =~s/\t//;
|
||||
$txt .= $opt->{ indent } . "\n";
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if ($self->use())
|
||||
{
|
||||
$txt .= $opt->{ indent } . "$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;
|
||||
18
lib/SOAP/WSDL/Operation.pm
Normal file
18
lib/SOAP/WSDL/Operation.pm
Normal file
@@ -0,0 +1,18 @@
|
||||
package SOAP::WSDL::Operation;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw/SOAP::WSDL::Base/;
|
||||
|
||||
my %operation_of :ATTR(:name<operation> :default<()>);
|
||||
my %input_of :ATTR(:name<input> :default<()>);
|
||||
my %output_of :ATTR(:name<output> :default<()>);
|
||||
my %fault_of :ATTR(:name<fault> :default<()>);
|
||||
my %type_of :ATTR(:name<type> :default<()>);
|
||||
my %style_of :ATTR(:name<style> :default<()>);
|
||||
my %transport_of :ATTR(:name<transport> :default<()>);
|
||||
my %parameterOrder_of :ATTR(:name<parameterOrder> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
|
||||
98
lib/SOAP/WSDL/Part.pm
Normal file
98
lib/SOAP/WSDL/Part.pm
Normal file
@@ -0,0 +1,98 @@
|
||||
package SOAP::WSDL::Part;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %element_of :ATTR(:name<element> :default<()>);
|
||||
my %type_of :ATTR(:name<type> :default<()>);
|
||||
|
||||
sub serialize
|
||||
{
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my $data = shift;
|
||||
my $opt = shift;
|
||||
my $typelib = $opt->{ typelib } || die "No typelib";
|
||||
my %ns_map = reverse %{ $opt->{ namespace } };
|
||||
|
||||
my $item_name;
|
||||
if ($item_name = $self->get_type() ) {
|
||||
# resolve type
|
||||
my ($prefix, $localname) = split /:/ , $item_name, 2;
|
||||
my $type = $typelib->find_type( $ns_map{ $prefix }, $localname )
|
||||
or die "type $item_name , $ns_map{ $prefix } not found";
|
||||
|
||||
my $name = $self->get_name();
|
||||
return $type->serialize( $name, $data->{ $name }, $opt );
|
||||
}
|
||||
elsif ( $item_name = $self->get_element() ) {
|
||||
my ($prefix, $localname) = split /:/ , $item_name, 2;
|
||||
my $element = $typelib->find_element(
|
||||
$ns_map{ $prefix },
|
||||
$localname
|
||||
)
|
||||
or die "element $item_name , $ns_map{ $prefix } not found";
|
||||
$opt->{ qualify } = 1;
|
||||
return $element->serialize( undef, $data->{ $element->get_name() }, $opt );
|
||||
}
|
||||
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 %ns_map = reverse %{ $opt->{ namespace } };
|
||||
my $element = $self->get_type() || $self->get_element();
|
||||
|
||||
# resolve type
|
||||
my ($prefix, $localname) = split /:/ , $element;
|
||||
my $type = $typelib->find_type(
|
||||
$ns_map{ $prefix },
|
||||
$localname
|
||||
)
|
||||
|| $typelib->find_element(
|
||||
$ns_map{ $prefix },
|
||||
$localname
|
||||
);
|
||||
|
||||
if (not $type)
|
||||
{
|
||||
warn "no type/element $element ({ $ns_map{ $prefix } }$localname) found for part " . $self->get_name();
|
||||
return q{};
|
||||
}
|
||||
return $type->explain( $opt, $self->get_name() );
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
my ($self, $opt, $name ) = @_;
|
||||
my $txt = q{};
|
||||
my $typelib = $opt->{ wsdl }->first_types()
|
||||
|| die "No typelib";
|
||||
|
||||
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
my $element = $self->get_type() || $self->get_element();
|
||||
|
||||
# resolve type
|
||||
my ($prefix, $localname) = split /:/ , $element;
|
||||
my $type;
|
||||
if ($type = $typelib->find_type( $ns_map{ $prefix }, $localname ) ) {
|
||||
$txt .= "'/' => " . $type->get_name() . "\n";
|
||||
}
|
||||
else {
|
||||
$type = $typelib->find_element( $ns_map{ $prefix }, $localname );
|
||||
}
|
||||
|
||||
if (not $type) {
|
||||
warn "no type/element $element ({ $ns_map{ $prefix } }$localname) found for part " . $self->get_name();
|
||||
return q{};
|
||||
}
|
||||
$opt->{ path } = [];
|
||||
$txt .= $type->to_typemap( $opt, $self->get_name() );
|
||||
return $txt;
|
||||
}
|
||||
|
||||
1;
|
||||
46
lib/SOAP/WSDL/Port.pm
Normal file
46
lib/SOAP/WSDL/Port.pm
Normal file
@@ -0,0 +1,46 @@
|
||||
package SOAP::WSDL::Port;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %binding_of :ATTR(:name<binding> :default<()>);
|
||||
my %location_of :ATTR(:name<location> :default<()>);
|
||||
|
||||
sub explain {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $txt =
|
||||
"=head2 Port name: " . $self->get_name() . "\n\n"
|
||||
. "=over\n\n"
|
||||
. "=item * Binding: " . $self->get_binding() ."\n\n"
|
||||
. "=item * Location: " . $self->get_location() ."\n\n"
|
||||
. "=back\n\n";
|
||||
# if ( $self->location() );
|
||||
|
||||
my %ns_map = reverse %{ $opt->{ namespace } };
|
||||
|
||||
my ($prefix, $localname) = split /:/ , $self->get_binding();
|
||||
my $binding = $opt->{ wsdl }->find_binding(
|
||||
$ns_map{ $prefix }, $localname
|
||||
) or die "binding $prefix:$localname not found !";
|
||||
|
||||
$txt .= $binding->explain($opt);
|
||||
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
|
||||
my ($prefix, $localname) = split /:/ , $self->get_binding();
|
||||
my $binding = $opt->{ wsdl }->find_binding(
|
||||
$ns_map{ $prefix }, $localname
|
||||
) or die "binding $prefix:$localname not found !";
|
||||
|
||||
return $binding->to_typemap($opt);
|
||||
}
|
||||
1;
|
||||
32
lib/SOAP/WSDL/PortType.pm
Normal file
32
lib/SOAP/WSDL/PortType.pm
Normal file
@@ -0,0 +1,32 @@
|
||||
package SOAP::WSDL::PortType;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %operation_of :ATTR(:name<operation> :default<()>);
|
||||
|
||||
my %attributes_of :ATTR();
|
||||
|
||||
%attributes_of = (
|
||||
operation => \%operation_of,
|
||||
);
|
||||
|
||||
# Function factory - we could be writing this method for all %attribute
|
||||
# keys, too, but that's just C&P (eehm, Copy & Paste...)
|
||||
foreach my $method(keys %attributes_of ) {
|
||||
no strict qw/refs/;
|
||||
|
||||
# ... btw, we mean this method here...
|
||||
*{ "find_$method" } = sub {
|
||||
my ($self, @args) = @_;
|
||||
my @found_at = grep {
|
||||
$_->get_targetNamespace() eq $args[0] &&
|
||||
$_->get_name() eq $args[1]
|
||||
}
|
||||
@{ $attributes_of{ $method }->{ ident $self } };
|
||||
return $found_at[0];
|
||||
};
|
||||
}
|
||||
|
||||
1;
|
||||
373
lib/SOAP/WSDL/SAX/MessageHandler.pm
Normal file
373
lib/SOAP/WSDL/SAX/MessageHandler.pm
Normal file
@@ -0,0 +1,373 @@
|
||||
#!/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 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) {
|
||||
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::LibXML->new();
|
||||
$parser->set_handler( $filter );
|
||||
|
||||
$parser->parse_string( $soap_message );
|
||||
|
||||
my $object_tree = $filter->get_data();
|
||||
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Parses a SOAP message into an object tree.
|
||||
|
||||
For every element in the SOAP message, an object is created. The class
|
||||
of the object is determined via a Resolver object which has to be passed
|
||||
to new via the class_resolver parameter.
|
||||
|
||||
=head1 Writing a class resolver
|
||||
|
||||
The class resolver must returned a method "get_class", which is passed a list
|
||||
ref of the current element's XPath (relative to Body), split by /.
|
||||
|
||||
This method must return a class name appropriate for a XML element.
|
||||
|
||||
A class resolver package might look like this:
|
||||
|
||||
package FakeResolver;
|
||||
|
||||
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',
|
||||
);
|
||||
|
||||
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";
|
||||
};
|
||||
1;
|
||||
|
||||
=head1 Writing type library classes
|
||||
|
||||
Every element must have a correspondent one in the type library.
|
||||
|
||||
Type library classes must provide the following methods:
|
||||
|
||||
Builtin types should be resolved as SOAP::WSDL::XSD::Builtin::* classes
|
||||
|
||||
=over
|
||||
|
||||
=item * new
|
||||
|
||||
Constructor
|
||||
|
||||
=item * add_FOO
|
||||
|
||||
The add_FOO method is called for every child element of the XML node.
|
||||
|
||||
Characters are regarded as child element of the last XML node.
|
||||
|
||||
=back
|
||||
|
||||
A tyelib class implemented as Inside-Out object using Class::Std::Storable
|
||||
as base class would look like this:
|
||||
|
||||
package Typelib::TEnqueueMessage;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
|
||||
my %MMessage_of :ATTR(:name<MMessage> :default<()>);
|
||||
|
||||
sub add_MMessage {
|
||||
my ($self, $value) = @_;
|
||||
my $ident = ident $self;
|
||||
|
||||
# we're the first value
|
||||
return $MMessage_of{ $ident } = $value
|
||||
if not defined $MMessage_of{ $ident };
|
||||
|
||||
# we're the second value
|
||||
return $MMessage_of{ $ident } = [
|
||||
$MMessage_of{ $ident }, $value ]
|
||||
if not ref $MMessage_of{ $ident } eq 'ARRAY';
|
||||
|
||||
# we're third or later
|
||||
push @{ $MMessage_of{ $ident } }, $value;
|
||||
return $MMessage_of{ $ident };
|
||||
}
|
||||
}
|
||||
1;
|
||||
|
||||
Of course one could use a method factory for these add_FOO methods - see
|
||||
t/lib/Typelib/Base.pm for an example.
|
||||
|
||||
=head1 Performance
|
||||
|
||||
SOAP::WSDL::SAX::MessageHandler with a raw XML::LibXML parser almost reaches
|
||||
the performance of XML::Simple with XML::Parser (and expat) as low-level
|
||||
parser.
|
||||
|
||||
And SOAP::WSDL::SAX::MessageHandler builds up a object tree, while
|
||||
XML::Simple just emits hash data structures:
|
||||
|
||||
SOAP::WSDL::SAX::MessageHandler:
|
||||
1 wallclock secs ( 1.39 usr + 0.00 sys = 1.39 CPU) @ 719.42/s (n=1000)
|
||||
|
||||
XML::Simple:
|
||||
2 wallclock secs ( 1.25 usr + 0.01 sys = 1.26 CPU) @ 790.51/s (n=1000)
|
||||
|
||||
If you know a faster way for parsing XML with a reasonable simple API than
|
||||
XML::LibXML, please let me know...
|
||||
|
||||
=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: $
|
||||
|
||||
167
lib/SOAP/WSDL/SAX/WSDLHandler.pm
Normal file
167
lib/SOAP/WSDL/SAX/WSDLHandler.pm
Normal file
@@ -0,0 +1,167 @@
|
||||
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 ($self, $ident) = ($_[0], 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 }
|
||||
);
|
||||
|
||||
if ($action)
|
||||
{
|
||||
if ($action->{ type } eq 'CLASS')
|
||||
{
|
||||
eval "require $action->{ class }";
|
||||
croak $@, $tree_of{ $ident } if ($@);
|
||||
|
||||
my $class = $action->{ class };
|
||||
my $obj = $class->new()->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 get_data {
|
||||
my $self = shift;
|
||||
return $tree_of{ ident $self };
|
||||
}
|
||||
1;
|
||||
47
lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
Normal file
47
lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
Normal file
@@ -0,0 +1,47 @@
|
||||
package SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use Data::Dumper;
|
||||
|
||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
use SOAP::WSDL::XSD::Typelib::Element;
|
||||
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType
|
||||
);
|
||||
|
||||
my %faultcode_of :ATTR(:get<faultcode>);
|
||||
my %faultstring_of :ATTR(:get<faultstring>);
|
||||
my %faultactor_of :ATTR(:get<faultactor>);
|
||||
my %detail_of :ATTR(:get<faultdetail>);
|
||||
|
||||
# always return false in boolean context - a fault is never true...
|
||||
sub as_bool :BOOLIFY { return; }
|
||||
|
||||
__PACKAGE__->_factory(
|
||||
[ qw(faultcode faultstring faultactor faultdetail) ],
|
||||
{
|
||||
faultcode => \%faultcode_of,
|
||||
faultstring => \%faultstring_of,
|
||||
faultactor => \%faultactor_of,
|
||||
detail => \%detail_of,
|
||||
},
|
||||
{
|
||||
faultcode => 'SOAP::WSDL::XSD::Typelib::Builtin::QName',
|
||||
faultstring => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
faultactor => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||
detail => 'SOAP::WSDL::XSD::Typelib::Builtin::anyType',
|
||||
}
|
||||
);
|
||||
|
||||
sub get_xmlns { return 'http://schemas.xmlsoap.org/soap/envelope/' };
|
||||
|
||||
__PACKAGE__->__set_name('Fault');
|
||||
__PACKAGE__->__set_nillable();
|
||||
__PACKAGE__->__set_minOccurs();
|
||||
__PACKAGE__->__set_maxOccurs();
|
||||
__PACKAGE__->__set_ref('');
|
||||
|
||||
1;
|
||||
27
lib/SOAP/WSDL/Service.pm
Normal file
27
lib/SOAP/WSDL/Service.pm
Normal file
@@ -0,0 +1,27 @@
|
||||
package SOAP::WSDL::Service;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %port_of :ATTR(:name<port> :default<()>);
|
||||
|
||||
sub explain {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $txt ="=head1 Service name\n\n" . $self->get_name() . "\n\n";
|
||||
foreach my $port (@{ $self->get_port() } )
|
||||
{
|
||||
$txt .= $port->explain( $opt );
|
||||
}
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
return join "\n",
|
||||
map { $_->to_typemap( $opt ) } @{ $port_of{ ident $self } };
|
||||
}
|
||||
|
||||
1;
|
||||
23
lib/SOAP/WSDL/SoapOperation.pm
Normal file
23
lib/SOAP/WSDL/SoapOperation.pm
Normal file
@@ -0,0 +1,23 @@
|
||||
package SOAP::WSDL::SoapOperation;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %input_of :ATTR(:name<input> :default<()>);
|
||||
my %output_of :ATTR(:name<output> :default<()>);
|
||||
my %fault_of :ATTR(:name<fault> :default<()>);
|
||||
my %style_of :ATTR(:name<style> :default<()>);
|
||||
my %soapAction_of :ATTR(:name<soapAction> :default<()>);
|
||||
|
||||
sub explain {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $txt = '';
|
||||
$opt->{ indent } ||= '';
|
||||
|
||||
$txt .= $opt->{ indent } . "soapAction: " . $self->soapAction() . "\n"
|
||||
if ( $self->soapAction() );
|
||||
|
||||
return $txt;
|
||||
}
|
||||
|
||||
1;
|
||||
152
lib/SOAP/WSDL/TypeLookup.pm
Normal file
152
lib/SOAP/WSDL/TypeLookup.pm
Normal file
@@ -0,0 +1,152 @@
|
||||
package SOAP::WSDL::TypeLookup;
|
||||
|
||||
my %TYPES = (
|
||||
# wsdl:
|
||||
'http://schemas.xmlsoap.org/wsdl/' => {
|
||||
binding => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Binding',
|
||||
},
|
||||
definitions => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Definitions',
|
||||
},
|
||||
portType => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::PortType',
|
||||
},
|
||||
types => {
|
||||
type => 'SKIP',
|
||||
},
|
||||
message => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Message',
|
||||
},
|
||||
part => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Part',
|
||||
},
|
||||
service => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Service',
|
||||
},
|
||||
port => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Port',
|
||||
},
|
||||
operation => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Operation',
|
||||
},
|
||||
input => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::OpMessage',
|
||||
},
|
||||
output => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::OpMessage',
|
||||
},
|
||||
fault => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::OpMessage',
|
||||
},
|
||||
types => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::Types',
|
||||
}
|
||||
},
|
||||
# soap:
|
||||
'http://schemas.xmlsoap.org/wsdl/soap/' => {
|
||||
operation => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::SoapOperation',
|
||||
},
|
||||
binding => {
|
||||
type => 'PARENT',
|
||||
},
|
||||
body => {
|
||||
type => 'PARENT',
|
||||
},
|
||||
address => {
|
||||
type => 'PARENT',
|
||||
}
|
||||
},
|
||||
'http://www.w3c.org/2001/XMLSchema' => {
|
||||
schema => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::Schema',
|
||||
},
|
||||
element => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::Element',
|
||||
},
|
||||
simpleType => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::SimpleType',
|
||||
},
|
||||
complexType => {
|
||||
type => 'CLASS',
|
||||
class => 'SOAP::WSDL::XSD::ComplexType',
|
||||
},
|
||||
simpleContent => {
|
||||
type => 'METHOD',
|
||||
method => 'set_contentModel',
|
||||
value => 'simpleContent'
|
||||
},
|
||||
complexContent => {
|
||||
type => 'METHOD',
|
||||
method => 'set_contentModel',
|
||||
value => 'complexContent'
|
||||
},
|
||||
restriction => {
|
||||
type => 'METHOD',
|
||||
method => 'set_restriction',
|
||||
},
|
||||
list => {
|
||||
type => 'METHOD',
|
||||
method => 'set_list',
|
||||
},
|
||||
union => {
|
||||
type => 'METHOD',
|
||||
method => 'set_union',
|
||||
},
|
||||
enumeration => {
|
||||
type => 'METHOD',
|
||||
method => 'push_enumeration',
|
||||
},
|
||||
group => {
|
||||
type => 'METHOD',
|
||||
method => 'set_flavor',
|
||||
value => 'all',
|
||||
},
|
||||
all => {
|
||||
type => 'METHOD',
|
||||
method => 'set_flavor',
|
||||
value => 'all',
|
||||
},
|
||||
choice => {
|
||||
type => 'METHOD',
|
||||
method => 'set_flavor',
|
||||
value => 'choice',
|
||||
},
|
||||
sequence => {
|
||||
type => 'METHOD',
|
||||
method => 'set_flavor',
|
||||
value => 'sequence',
|
||||
},
|
||||
|
||||
},
|
||||
);
|
||||
|
||||
# thei're equal (typo ?)
|
||||
$TYPES{ 'http://www.w3.org/2001/XMLSchema' } = $TYPES{
|
||||
'http://www.w3c.org/2001/XMLSchema'
|
||||
};
|
||||
|
||||
|
||||
sub lookup {
|
||||
my $self = shift;
|
||||
my $namespace = shift || 'http://schemas.xmlsoap.org/wsdl/';
|
||||
my $name = shift;
|
||||
return $TYPES{ $namespace }->{ $name };
|
||||
}
|
||||
37
lib/SOAP/WSDL/Types.pm
Normal file
37
lib/SOAP/WSDL/Types.pm
Normal file
@@ -0,0 +1,37 @@
|
||||
package SOAP::WSDL::Types;
|
||||
use strict;
|
||||
use warnings;
|
||||
use SOAP::WSDL::XSD::Schema::Builtin;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
|
||||
my %schema_of :ATTR(:name<schema> :default<[]>);
|
||||
|
||||
sub START {
|
||||
my ($self, $ident, $args_of) = @_;
|
||||
$self->push_schema( SOAP::WSDL::XSD::Schema::Builtin->new() );
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub find_type {
|
||||
my ($self, $ns, $name) = @_;
|
||||
|
||||
foreach my $schema (@{ $schema_of{ ident $self } }) {
|
||||
my $type = $schema->find_type($ns, $name);
|
||||
return $type if $type;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub find_element {
|
||||
my ($self, $ns, $name) = @_;
|
||||
|
||||
foreach my $schema (@{ $schema_of{ ident $self } }) {
|
||||
my $type = $schema->find_element($ns, $name);
|
||||
return $type if $type;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
261
lib/SOAP/WSDL/XSD/ComplexType.pm
Normal file
261
lib/SOAP/WSDL/XSD/ComplexType.pm
Normal file
@@ -0,0 +1,261 @@
|
||||
package SOAP::WSDL::XSD::ComplexType;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Class::Std::Storable;
|
||||
use Scalar::Util qw(blessed);
|
||||
use base qw/SOAP::WSDL::Base/;
|
||||
use Data::Dumper;
|
||||
|
||||
my %annotation_of :ATTR(:name<annotation> :default<()>);
|
||||
my %element_of :ATTR(:name<element> :default<()>);
|
||||
my %flavor_of :ATTR(:name<flavor> :default<()>);
|
||||
my %base_of :ATTR(:name<base> :default<()>);
|
||||
my %itemType_of :ATTR(:name<itemType> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %abstract_of :ATTR(:name<abstract> :default<()>);
|
||||
# is set to simpleContent/complexContent
|
||||
my %content_Model_of :ATTR(:name<contentModel> :default<()>);
|
||||
|
||||
sub find_element {
|
||||
my ($self, @args) = @_;
|
||||
my @found_at = grep {
|
||||
$_->get_targetNamespace() eq $args[0] &&
|
||||
$_->get_name() eq $args[1]
|
||||
}
|
||||
@{ $element_of{ ident $self } };
|
||||
return $found_at[0];
|
||||
}
|
||||
|
||||
sub push_element {
|
||||
my $self = shift;
|
||||
my $element = shift;
|
||||
if ($flavor_of{ ident $self } eq 'all')
|
||||
{
|
||||
$element->set_minOccurs(0) if not defined ($element->get_minOccurs);
|
||||
$element->set_maxOccurs(1) if not defined ($element->get_maxOccurs);
|
||||
}
|
||||
elsif ($flavor_of{ ident $self } eq 'sequence')
|
||||
{
|
||||
$element->set_minOccurs(1) if not defined ($element->get_minOccurs);
|
||||
$element->set_maxOccurs(1) if not defined ($element->get_maxOccurs);
|
||||
}
|
||||
push @{ $element_of{ ident $self } }, $element;
|
||||
}
|
||||
|
||||
sub set_restriction {
|
||||
my $self = shift;
|
||||
my $element = shift;
|
||||
$flavor_of{ ident $self } = 'restriction';
|
||||
$base_of{ ident $self } = $element->{ Value };
|
||||
}
|
||||
|
||||
|
||||
sub init {
|
||||
my $self = shift;
|
||||
my @args = @_;
|
||||
$self->SUPER::init( @args );
|
||||
}
|
||||
|
||||
sub serialize
|
||||
{
|
||||
my ($self, $name, $value, $opt) = @_;
|
||||
|
||||
$opt->{ indent } ||= q{};
|
||||
$opt->{ attributes } ||= [];
|
||||
my $flavor = $self->get_flavor();
|
||||
my $xml = ($opt->{ readable }) ? $opt->{ indent } : q{}; # add indentation
|
||||
|
||||
|
||||
if ( $opt->{ qualify } ) {
|
||||
$opt->{ attributes } = [ ' xmlns="' . $self->get_targetNamespace .'"' ];
|
||||
delete $opt->{ qualify };
|
||||
}
|
||||
|
||||
|
||||
$xml .= join q{ } , "<$name" , @{ $opt->{ attributes } };
|
||||
delete $opt->{ attributes }; # don't propagate...
|
||||
|
||||
if ( $opt->{ autotype }) {
|
||||
my $ns = $self->get_targetNamespace();
|
||||
my $prefix = $opt->{ namespace }->{ $ns }
|
||||
|| die 'No prefix found for namespace '. $ns;
|
||||
$xml .= join q{}, " type=\"$prefix:", $self->get_name(), '" '
|
||||
if ($self->get_name() );
|
||||
}
|
||||
$xml .= '>';
|
||||
$xml .= "\n" if ( $opt->{ readable } ); # add linebreak
|
||||
if ( ($flavor eq "sequence") or ($flavor eq "all") )
|
||||
{
|
||||
$opt->{ indent } .= "\t";
|
||||
for my $element (@{ $self->get_element() }) {
|
||||
# might be list - listify
|
||||
$value = [ $value ] if not ref $value eq 'ARRAY';
|
||||
|
||||
for my $single_value (@{ $value }) {
|
||||
my $element_value;
|
||||
if (blessed $single_value) {
|
||||
my $method = 'get_' . $element->get_name();
|
||||
$element_value = $single_value->$method();
|
||||
}
|
||||
else {
|
||||
$element_value = $single_value->{ $element->get_name() };
|
||||
}
|
||||
$element_value = [ $element_value ]
|
||||
if not ref $element_value eq 'ARRAY';
|
||||
|
||||
$xml .= join q{}
|
||||
, map { $element->serialize( undef, $_, $opt ) }
|
||||
@{ $element_value };
|
||||
}
|
||||
}
|
||||
$opt->{ indent } =~s/\t$//;
|
||||
}
|
||||
else {
|
||||
die "sorry, we just handle all and sequence types yet...";
|
||||
}
|
||||
$xml .= $opt->{ indent } if ( $opt->{ readable } ); # add indentation
|
||||
$xml .= '</' . $name . '>';
|
||||
$xml .= "\n" if ($opt->{ readable } ); # add linebreak
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub explain
|
||||
{
|
||||
my ($self, $opt, $name ) = @_;
|
||||
my $flavor = $self->get_flavor();
|
||||
my $xml = '';
|
||||
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
|
||||
$xml .= q{'} . $name . q{' => };
|
||||
|
||||
return q{} if not $flavor; # empty complexType
|
||||
|
||||
if ( ($flavor eq "sequence") or ($flavor eq "all") )
|
||||
{
|
||||
$xml .= "{\n";
|
||||
$opt->{ indent } .= "\t";
|
||||
$xml .= join q{}, map { $_->explain( $opt ) }
|
||||
@{ $self->get_element() };
|
||||
$opt->{ indent } =~s/\t$//; # step back
|
||||
$xml .= $opt->{ indent } . "},\n";
|
||||
}
|
||||
elsif ($flavor eq "complexContent")
|
||||
{
|
||||
|
||||
}
|
||||
elsif ($flavor eq "simpleContent")
|
||||
{
|
||||
|
||||
}
|
||||
else
|
||||
{
|
||||
warn "unknown complexType definition $flavor";
|
||||
}
|
||||
$xml .= "\n" if ($opt->{ readable } ); # add linebreak
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
my ($self, $opt, $name ) = @_;
|
||||
my $flavor = $self->get_flavor();
|
||||
my $txt;
|
||||
return q{} if not $flavor; # empty complexType
|
||||
|
||||
my %nsmap = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
|
||||
if ( ($flavor eq "sequence") or ($flavor eq "all") )
|
||||
{
|
||||
for my $element (@{ $self->get_element() }) {
|
||||
$txt .= $element->to_typemap( $opt );
|
||||
}
|
||||
}
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
|
||||
my $template = <<'EOT';
|
||||
package [% class_prefix %]::[% self.get_name %];
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType
|
||||
);
|
||||
|
||||
[% FOREACH element=self.get_element -%]
|
||||
my %[% element.get_name %]_of :ATTR(:get<[% element.get_name %]>);
|
||||
[% END %]
|
||||
|
||||
__PACKAGE__->_factory(
|
||||
[ qw([% FOREACH element=self.get_element -%]
|
||||
[% element.get_name %]
|
||||
[% END %]) ],
|
||||
{
|
||||
[% FOREACH element=self.get_element %] [% element.get_name %] => \%[% element.get_name %]_of,
|
||||
[% END %]
|
||||
},
|
||||
{
|
||||
[%- FOREACH element=self.get_element;
|
||||
split_name = element.get_type.split(':');
|
||||
prefix = split_name.0;
|
||||
localname = split_name.1;
|
||||
IF nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema' -%]
|
||||
[% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% localname %]',
|
||||
[% ELSE %]
|
||||
[% element.get_name %] => '[% class_prefix %]::[% localname %]',
|
||||
[%- END;
|
||||
END %]
|
||||
}
|
||||
);
|
||||
|
||||
sub get_xmlns { '[% self.get_targetNamespace %]' }
|
||||
|
||||
1;
|
||||
EOT
|
||||
|
||||
$opt->{ base_path } ||= '.';
|
||||
|
||||
require Template;
|
||||
my $tt = Template->new(
|
||||
RELATIVE => 1,
|
||||
);
|
||||
my $code = $tt->process( \$template, {
|
||||
class_prefix => $opt->{ prefix },
|
||||
self => $self,
|
||||
nsmap => { reverse %{ $opt->{ wsdl }->get_xmlns() } },
|
||||
},
|
||||
$opt->{ output },
|
||||
) or die $tt->error();
|
||||
}
|
||||
|
||||
sub _check_value {
|
||||
my $self = shift;
|
||||
}
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * attribute definitions
|
||||
|
||||
Attribute definitions are ignored
|
||||
|
||||
=item * abstract, block, final, mixed
|
||||
|
||||
Handling of these attribute is not implemented yet.
|
||||
|
||||
=item * simpleContent, complexContent, extension, restriction, group, choice
|
||||
|
||||
Handling of these child elements is not implemented yet
|
||||
|
||||
=item * explain may produce erroneous results
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
354
lib/SOAP/WSDL/XSD/Element.pm
Normal file
354
lib/SOAP/WSDL/XSD/Element.pm
Normal file
@@ -0,0 +1,354 @@
|
||||
package SOAP::WSDL::XSD::Element;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
use Data::Dumper;
|
||||
|
||||
my %simpleType_of :ATTR(:name<simpleType> :default<()>);
|
||||
my %complexType_of :ATTR(:name<complexType> :default<()>);
|
||||
my %facet_of :ATTR(:name<facet> :default<()>);
|
||||
my %type_of :ATTR(:name<type> :default<()>);
|
||||
my %abstract_of :ATTR(:name<abstract> :default<()>);
|
||||
my %block_of :ATTR(:name<block> :default<()>);
|
||||
my %default_of :ATTR(:name<default> :default<()>);
|
||||
my %final_of :ATTR(:name<final> :default<()>);
|
||||
my %fixed_of :ATTR(:name<fixed> :default<()>);
|
||||
my %form_of :ATTR(:name<form> :default<()>);
|
||||
my %maxOccurs_of :ATTR(:name<maxOccurs> :default<()>);
|
||||
my %minOccurs_of :ATTR(:name<minOccurs> :default<()>);
|
||||
my %nillable_of :ATTR(:name<nillable> :default<()>);
|
||||
my %ref_of :ATTR(:name<ref> :default<()>);
|
||||
my %substitutionGroup_of :ATTR(:name<substitutionGroup> :default<()>);
|
||||
|
||||
sub first_type {
|
||||
my $result_ref = $complexType_of{ ident shift };
|
||||
return if not $result_ref;
|
||||
return $result_ref if (not ref $result_ref eq 'ARRAY');
|
||||
return $result_ref->[0];
|
||||
}
|
||||
|
||||
sub first_simpleType {
|
||||
my $result_ref = $simpleType_of{ ident shift };
|
||||
return if not $result_ref;
|
||||
return $result_ref if (not ref $result_ref eq 'ARRAY');
|
||||
return $result_ref->[0];
|
||||
}
|
||||
|
||||
sub first_complexType {
|
||||
my $result_ref = $complexType_of{ ident shift };
|
||||
return if not $result_ref;
|
||||
return $result_ref if (not ref $result_ref eq 'ARRAY');
|
||||
return $result_ref->[0];
|
||||
}
|
||||
|
||||
# serialize type instead...
|
||||
sub serialize
|
||||
{
|
||||
my ($self, $name, $value, $opt) = @_;
|
||||
my $type;
|
||||
my $typelib = $opt->{ typelib };
|
||||
my %ns_map = reverse %{ $opt->{ namespace } };
|
||||
my $ident = ident $self;
|
||||
|
||||
# abstract elements may only be serialized via ref - and then we have a
|
||||
# name...
|
||||
die "cannot serialize abstract element" if $abstract_of{ $ident }
|
||||
and not $name;
|
||||
|
||||
# TODO: implement final and substitutionGroup - maybe never implement
|
||||
# substitutionGroup ?
|
||||
|
||||
$name ||= $self->get_name();
|
||||
|
||||
if ( $opt->{ qualify } ) {
|
||||
$opt->{ attributes } = [ ' xmlns="' . $self->get_targetNamespace .'"' ];
|
||||
}
|
||||
|
||||
|
||||
# set default and fixed - fixed overrides everything,
|
||||
# default only empty (undefined) values
|
||||
if (not defined $value) {
|
||||
$value = $default_of{ ident $self } if $default_of{ ident $self };
|
||||
}
|
||||
$value = $fixed_of{ ident $self } if $fixed_of{ ident $self };
|
||||
|
||||
# TODO check nillable and serialize empty data correctly
|
||||
|
||||
# return if minOccurs is 0 and we have no value
|
||||
if (defined $minOccurs_of{ ident $self }
|
||||
and $minOccurs_of{ ident $self } == 0) {
|
||||
return q{} if not defined $value;
|
||||
}
|
||||
|
||||
# handle direct simpleType and complexType here
|
||||
if ($type = $self->first_simpleType() ) { # simpleType
|
||||
return $type->serialize( $name, $value, $opt );
|
||||
}
|
||||
elsif ($type = $self->first_complexType() ) { # complexType
|
||||
return $type->serialize( $name, $value, $opt );
|
||||
}
|
||||
elsif (my $ref_name = $ref_of{ $ident }) { # ref
|
||||
my ($prefix, $localname) = split /:/ , $ref_name;
|
||||
my $ns = $ns_map{ $prefix };
|
||||
$type = $typelib->find_type( $ns, $localname );
|
||||
die "no type for $prefix:$localname" if (not $type);
|
||||
return $type->serialize( $name, $value, $opt );
|
||||
}
|
||||
|
||||
# lookup type
|
||||
my ($prefix, $localname) = split /:/ , $self->get_type();
|
||||
my $ns = $ns_map{ $prefix };
|
||||
$type = $typelib->find_type(
|
||||
$ns, $localname
|
||||
);
|
||||
|
||||
# safety check
|
||||
die "no type for $prefix:$localname $ns_map{$prefix}" if (not $type);
|
||||
|
||||
return $type->serialize( $name, $value, $opt );
|
||||
}
|
||||
|
||||
sub explain
|
||||
{
|
||||
my ($self, $opt, $name) = @_;
|
||||
my $type;
|
||||
my $text = q{};
|
||||
|
||||
# if we have a simple / complexType, explain right here
|
||||
if ($type = $self->first_simpleType() )
|
||||
{
|
||||
$text .= $type->explain( $opt, $self->get_name() );
|
||||
}
|
||||
elsif ($type = $self->first_complexType() )
|
||||
{
|
||||
$text .= $type->explain( $opt, $self->get_name() )
|
||||
}
|
||||
|
||||
# return if it's not a derived type - we don't handle
|
||||
# other stuff yet.
|
||||
return $text if (not $self->get_type() );
|
||||
|
||||
# if we have a derived type, fetch type and explain
|
||||
my ($prefix, $localname) = split /:/ , $self->get_type();
|
||||
my %ns_map = reverse %{ $opt->{ namespace } };
|
||||
my $ns = $ns_map{ $prefix };
|
||||
|
||||
$type = $opt->{ wsdl }->first_types()->find_type(
|
||||
$ns, $localname
|
||||
);
|
||||
|
||||
die "no type for $prefix:$localname ($ns)" if (not $type);
|
||||
|
||||
return $text .= $type->explain( $opt, $self->get_name() );
|
||||
return 'ERROR: '. $@;
|
||||
}
|
||||
|
||||
sub to_typemap {
|
||||
|
||||
my ($self, $opt) = @_;
|
||||
my $txt = q{};
|
||||
|
||||
my %nsmap = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
|
||||
my $type;
|
||||
push @{ $opt->{path} }, $self->get_name();
|
||||
if ( my $typename = $self->get_type() ) {
|
||||
my ($prefix, $localname) = split /:/, $self->get_type();
|
||||
my $ns = $nsmap{ $prefix };
|
||||
my $typeclass;
|
||||
|
||||
# builtin type
|
||||
if ( $nsmap{ $prefix } eq 'http://www.w3.org/2001/XMLSchema') {
|
||||
$typeclass = "SOAP::WSDL::XSD::Typelib::Builtin::$localname";
|
||||
}
|
||||
else
|
||||
{
|
||||
$type = $opt->{ wsdl }->first_types()->find_type( $ns, $localname );
|
||||
$typeclass = $opt->{ prefix } . $type->get_name();
|
||||
$txt .= $type->to_typemap($opt);
|
||||
}
|
||||
$txt .= q{'} . join( q{/}, @{ $opt->{path} } ) . "' => '$typeclass',\n";
|
||||
}
|
||||
elsif ($type = $self->first_simpleType() ) {
|
||||
my $flavor = $type->get_flavor();
|
||||
if ( $flavor eq 'sequence' ) {
|
||||
$txt .= "# atomic simple type (sequence)\n";
|
||||
$txt .= $type->to_typemap($opt). "\n";
|
||||
$txt .= "# end atomic simple type (sequence)\n";
|
||||
}
|
||||
elsif ( $flavor eq 'all' ) {
|
||||
$txt .= "# atomic simple type (all)\n";
|
||||
$txt .= $type->to_typemap($opt). "\n";
|
||||
$txt .= "# end atomic simple type (all)\n";
|
||||
}
|
||||
|
||||
}
|
||||
elsif ($type = $self->first_complexType() ) {
|
||||
my $typeclass = $opt->{ prefix } . $self->get_name();
|
||||
$txt .= q{'} . join( q{/}, @{ $opt->{path} } ) . "' => '$typeclass',\n";
|
||||
my $flavor = $type->get_flavor();
|
||||
if ( $flavor eq 'sequence' ) {
|
||||
$txt .= "# atomic complex type (sequence)\n";
|
||||
$txt .= $type->to_typemap($opt). "\n";;
|
||||
$txt .= "# end atomic complex type (sequence)\n";
|
||||
}
|
||||
elsif ( $flavor eq 'all' ) {
|
||||
$txt .= "# atomic complex type (all)\n";
|
||||
$txt .= $type->to_typemap($opt). "\n";
|
||||
$txt .= "# end atomic complex type (all)\n";
|
||||
}
|
||||
}
|
||||
pop @{ $opt->{ path } };
|
||||
|
||||
return $txt;
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
|
||||
my $template = <<'EOT';
|
||||
package [% class_prefix %]::[% self.get_name %];
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Element;
|
||||
[% IF (type = self.first_simpleType) %]
|
||||
# <element name="[% self.get_name %]"><simpleType> definition
|
||||
use SOAP::WSDL::XSD::Typelib::SimpleType;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType
|
||||
[% type.flavor_class %]
|
||||
[% type.base_class($class_prefix) %]
|
||||
);
|
||||
[% ELSIF (type = self.first_complexType) %]
|
||||
# <element name="[% self.get_name %]"><complexType> definition
|
||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType
|
||||
);
|
||||
|
||||
[% FOREACH element = type.get_element %]
|
||||
my %[% element.get_name %]_of :ATTR(:get<[% element.get_name %]>);
|
||||
[% END %]
|
||||
|
||||
__PACKAGE__->_factory(
|
||||
[ qw([% FOREACH element = type.get_element %]
|
||||
[% element.get_name %]
|
||||
[% END %]) ],
|
||||
{
|
||||
[% FOREACH element = type.get_element %] [% element.get_name %] => \%[% element.get_name %]_of,
|
||||
[% END %]
|
||||
},
|
||||
{
|
||||
[% FOREACH element = type.get_element;
|
||||
split_name = element.get_type.split(':');
|
||||
prefix = split_name.0;
|
||||
localname = split_name.1;
|
||||
IF nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema' %]
|
||||
[% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% localname %]',
|
||||
[% ELSE %]
|
||||
[% element.get_name %] => '[% class_prefix %]::[% localname %]',
|
||||
[% END %]
|
||||
[% END %]
|
||||
}
|
||||
);
|
||||
[%# END complexType %]
|
||||
[% ELSIF (type = self.get_type) %]
|
||||
# <element name="[% self.get_name %]" type="[% self.get_type %]"/> definition
|
||||
[% (typename = self.get_type);
|
||||
split_name = element.type.split(':');
|
||||
prefix = split_name.0;
|
||||
localname = split_name.1;
|
||||
-%]
|
||||
[% IF (nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema');
|
||||
base_class = 'SOAP::WSDL::XSD::Typelib::Builtin::' _ localname ;
|
||||
ELSE;
|
||||
base_class = class_prefix _ '::' _ localname;
|
||||
-%]
|
||||
|
||||
use [% base_class %];
|
||||
[% END %]
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
[% base_class %]
|
||||
);
|
||||
[% ELSIF (element = self.get_ref)
|
||||
%]
|
||||
# element ref"element" definition
|
||||
# Sorry, we don't handle this yet...
|
||||
[% END %]
|
||||
|
||||
sub get_xmlns { '[% self.get_targetNamespace %]' }
|
||||
|
||||
__PACKAGE__->__set_name('[% self.get_name %]');
|
||||
__PACKAGE__->__set_nillable([% self.get_nillable %]);
|
||||
__PACKAGE__->__set_minOccurs([% self.get_minOccurs %]);
|
||||
__PACKAGE__->__set_maxOccurs([% self.get_maxOccurs %]);
|
||||
__PACKAGE__->__set_ref('[% self.get_ref %]');
|
||||
|
||||
1;
|
||||
EOT
|
||||
|
||||
require Template;
|
||||
my $tt = Template->new(
|
||||
RELATIVE => 1,
|
||||
);
|
||||
my $code = $tt->process( \$template, {
|
||||
class_prefix => $opt->{ prefix },
|
||||
self => $self,
|
||||
nsmap => { reverse %{ $opt->{ wsdl }->get_xmlns() } },
|
||||
},
|
||||
$opt->{ output },
|
||||
)
|
||||
or die $tt->error();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Element - XSD Element representation
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Represents a XML Schema Definition's Element element for serializing into
|
||||
various forms.
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * block
|
||||
|
||||
Handling of the block attribute is not implemented yet.
|
||||
|
||||
=item * final
|
||||
|
||||
Handling of the final attribute is not implemented yet.
|
||||
|
||||
=item * substitutionGroup
|
||||
|
||||
Handling of the substitutionGroup attribute is not implemented yet
|
||||
|
||||
=item * explain may produce erroneous results
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
This module is part of SOAP-WSDL. See SOAP::WSDL for license.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Insert @ instead of whitespace into e-mail.
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
55
lib/SOAP/WSDL/XSD/Primitive.pm
Normal file
55
lib/SOAP/WSDL/XSD/Primitive.pm
Normal file
@@ -0,0 +1,55 @@
|
||||
package SOAP::WSDL::XSD::Primitive;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
use Data::Dumper;
|
||||
|
||||
sub serialize
|
||||
{
|
||||
my ($self, $name, $value, $opt) = @_;
|
||||
my $xml;
|
||||
$opt->{ indent } ||= "";
|
||||
$opt->{ attributes } ||= [];
|
||||
|
||||
$xml .= $opt->{ indent } if ($opt->{ readable });
|
||||
$xml .= '<' . join ' ', $name, @{ $opt->{ attributes } };
|
||||
if ( $opt->{ autotype })
|
||||
{
|
||||
my $ns = $self->get_targetNamespace();
|
||||
my $prefix = $opt->{ namespace }->{ $ns }
|
||||
|| die 'No prefix found for namespace '. $ns;
|
||||
$xml .= ' type="' . $prefix . ':'
|
||||
. $self->get_name() . '"' if ($self->get_name() );
|
||||
}
|
||||
|
||||
if (defined $value)
|
||||
{
|
||||
$xml .= '>';
|
||||
$xml .= "$value";
|
||||
$xml .= '</' . $name . '>' ;
|
||||
}
|
||||
else
|
||||
{
|
||||
$xml .= '/>';
|
||||
}
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub explain
|
||||
{
|
||||
my ($self, $opt, $name ) = @_;
|
||||
my $perl;
|
||||
$opt->{ indent } ||= "";
|
||||
$perl .= $opt->{ indent } if ($opt->{ readable });
|
||||
|
||||
$perl .= q{'} . $name . q{' => $someValue };
|
||||
$perl .= "\n" if ($opt->{ readable });
|
||||
return $perl;
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
warn "# primitive";
|
||||
}
|
||||
1;
|
||||
72
lib/SOAP/WSDL/XSD/Schema.pm
Normal file
72
lib/SOAP/WSDL/XSD/Schema.pm
Normal file
@@ -0,0 +1,72 @@
|
||||
package SOAP::WSDL::XSD::Schema;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
# child elements
|
||||
my %type_of :ATTR(:name<type> :default<[]>);
|
||||
my %element_of :ATTR(:name<element> :default<[]>);
|
||||
|
||||
# attributes
|
||||
my %attributeFormDefault_of :ATTR(:name<attributeFormDefault> :default<()>);
|
||||
my %blockDefault_of :ATTR(:name<blockDefault> :default<()>);
|
||||
my %elementFormDefault_of :ATTR(:name<elementFormDefault> :default<()>);
|
||||
my %finalDefault_of :ATTR(:name<finalDefault> :default<()>);
|
||||
my %version_of :ATTR(:name<version> :default<()>);
|
||||
|
||||
# id
|
||||
# name
|
||||
# targetNamespace inherited from Base
|
||||
# xmlns
|
||||
|
||||
#
|
||||
# attributeFormDefault = (qualified | unqualified) : unqualified
|
||||
# blockDefault = (#all | List of (extension | restriction | substitution)) : ''
|
||||
# elementFormDefault = (qualified | unqualified) : unqualified
|
||||
# finalDefault = (#all | List of (extension | restriction | list | union)) : ''
|
||||
# id = ID
|
||||
# targetNamespace = anyURI
|
||||
# version = token
|
||||
# xml:lang = language
|
||||
#
|
||||
#
|
||||
# alias type with all variants
|
||||
# AUTOMETHOD is WAY too slow..
|
||||
{
|
||||
no strict qw/refs/;
|
||||
for my $name (qw(simpleType complexType) ) {
|
||||
*{ "set_$name" } = \&set_type;
|
||||
*{ "get_$name" } = \&get_type;
|
||||
*{ "push_$name" } = \&push_type;
|
||||
*{ "find_$name" } = \&find_type;
|
||||
}
|
||||
}
|
||||
|
||||
sub push_type {
|
||||
# use $_[n] for performance -
|
||||
# we're called on each and every type inside WSDL
|
||||
push @{ $type_of{ ident $_[0]} }, $_[1];
|
||||
}
|
||||
|
||||
sub find_element {
|
||||
my ($self, @args) = @_;
|
||||
my @found_at = grep {
|
||||
$_->get_targetNamespace() eq $args[0] &&
|
||||
$_->get_name() eq $args[1]
|
||||
}
|
||||
@{ $element_of{ ident $self } };
|
||||
return $found_at[0];
|
||||
}
|
||||
|
||||
sub find_type {
|
||||
my ($self, @args) = @_;
|
||||
my @found_at = grep {
|
||||
$_->get_targetNamespace() eq $args[0] &&
|
||||
$_->get_name() eq $args[1]
|
||||
}
|
||||
@{ $type_of{ ident $self } };
|
||||
return $found_at[0];
|
||||
}
|
||||
|
||||
1;
|
||||
64
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
Normal file
64
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
Normal file
@@ -0,0 +1,64 @@
|
||||
package SOAP::WSDL::XSD::Schema::Builtin;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Schema;
|
||||
use SOAP::WSDL::XSD::Primitive;
|
||||
use base qw(SOAP::WSDL::XSD::Schema);
|
||||
|
||||
# all builtin types - add validation (e.g. content restrictions) later...
|
||||
my %PRIMITIVES = (
|
||||
'string' => {},
|
||||
'boolean' => {},
|
||||
'decimal' => {},
|
||||
'dateTime' => {},
|
||||
'float' => {},
|
||||
'double' => {},
|
||||
'duration' => {},
|
||||
'time' => {},
|
||||
'date' => {},
|
||||
'gYearMonth' => {},
|
||||
'gYear' => {},
|
||||
'gMonthDay' => {},
|
||||
'gDay' => {},
|
||||
'gMonth' => {},
|
||||
'hexBinary' => {},
|
||||
'base64Binary' => {},
|
||||
'anyURI' => {},
|
||||
'QName' => {},
|
||||
'NOTATION' => {},
|
||||
'integer' => {},
|
||||
'non-positive-integer' => {},
|
||||
'non-negative-integer' => {},
|
||||
'positiveInteger' => {},
|
||||
'negativeInteger' => {},
|
||||
'long' => {},
|
||||
'int' => {},
|
||||
'unsignedInt' => {},
|
||||
'short' => {},
|
||||
'unsignedShort' => {},
|
||||
'byte' => {},
|
||||
'unsignedByte' => {},
|
||||
'normalizedString' => {},
|
||||
'token' => {},
|
||||
'NMTOKEN' => {},
|
||||
);
|
||||
|
||||
# TODO place into appropriate schema and push on schema definitions list
|
||||
# in types
|
||||
sub START {
|
||||
my $self = shift;
|
||||
my @args = @_;
|
||||
|
||||
while (my ($name, $value) = each %PRIMITIVES )
|
||||
{
|
||||
$self->push_type( SOAP::WSDL::XSD::Primitive->new({
|
||||
name => $name,
|
||||
targetNamespace => 'http://www.w3.org/2001/XMLSchema',
|
||||
} )
|
||||
);
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
1;
|
||||
179
lib/SOAP/WSDL/XSD/SimpleType.pm
Normal file
179
lib/SOAP/WSDL/XSD/SimpleType.pm
Normal file
@@ -0,0 +1,179 @@
|
||||
package SOAP::WSDL::XSD::SimpleType;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::Base);
|
||||
|
||||
my %base_of :ATTR(:name<base> :default<()>);
|
||||
my %flavor_of :ATTR(:name<flavor> :default<()>);
|
||||
my %itemType_of :ATTR(:name<itemType> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
# is set to simpleContent/complexContent
|
||||
my %content_Model_of :ATTR(:name<contentModel> :default<()>);
|
||||
|
||||
sub set_restriction {
|
||||
my $self = shift;
|
||||
my @attributes = @_;
|
||||
$self->set_flavor( 'restriction' );
|
||||
foreach my $attr (@attributes)
|
||||
{
|
||||
next if (not $attr->{ LocalName } eq 'restriction');
|
||||
$self->base( $attr->{ Value } );
|
||||
}
|
||||
}
|
||||
|
||||
sub set_list {
|
||||
my $self = shift;
|
||||
my @attributes = @_;
|
||||
$self->set_flavor( 'list' );
|
||||
foreach my $attr (@attributes)
|
||||
{
|
||||
next if (not $attr->{ LocalName } eq 'list');
|
||||
$self->set_base( $attr->{ Value } );
|
||||
}
|
||||
}
|
||||
|
||||
sub set_union {
|
||||
my $self = shift;
|
||||
my @attributes = @_;
|
||||
$self->set_flavor( 'union' );
|
||||
foreach my $attr (@attributes)
|
||||
{
|
||||
next if (not $attr->{ LocalName } eq 'memberTypes');
|
||||
$self->set_base( [ split /\s/, $attr->{ Value } ] );
|
||||
}
|
||||
}
|
||||
|
||||
sub push_enumeration
|
||||
{
|
||||
my $self = shift;
|
||||
my @attr = @_;
|
||||
my @attributes = @_;
|
||||
$self->set_flavor( 'enumeration' );
|
||||
foreach my $attr (@attributes)
|
||||
{
|
||||
next if (not $attr->{ LocalName } eq 'value');
|
||||
push @{ $enumeration_of{ ident $self } }, $attr->{ 'Value' };
|
||||
}
|
||||
}
|
||||
|
||||
sub serialize {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my $value = shift;
|
||||
my $opt = shift;
|
||||
my $ident = ident $self;
|
||||
|
||||
$opt->{ attributes } ||= [];
|
||||
$opt->{ indent } ||= q{};
|
||||
|
||||
$self->_check_value( $value );
|
||||
|
||||
return $self->_serialize_single($name, $value , $opt)
|
||||
if ( $flavor_of{ $ident } eq 'restriction'
|
||||
or $flavor_of{ $ident } eq 'union'
|
||||
or $flavor_of{ $ident } eq 'enumeration');
|
||||
|
||||
if ($flavor_of{ $ident } eq 'list' )
|
||||
{
|
||||
$value ||= [];
|
||||
$value = [ $value ] if ( ref( $value) ne 'ARRAY' );
|
||||
return $self->_serialize_single($name, join( q{ }, @{ $value } ), $opt);
|
||||
}
|
||||
}
|
||||
|
||||
sub _serialize_single {
|
||||
my ($self, $name, $value, $opt) = @_;
|
||||
my $xml = '';
|
||||
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
|
||||
$xml .= '<' . join ' ', $name, @{ $opt->{ attributes } };
|
||||
if ( $opt->{ autotype }) {
|
||||
my $ns = $self->get_targetNamespace();
|
||||
my $prefix = $opt->{ namespace }->{ $ns }
|
||||
|| die 'No prefix found for namespace '. $ns;
|
||||
$xml .= ' type="' . $prefix . ':' . $self->get_name() .'"';
|
||||
}
|
||||
|
||||
# nillabel ?
|
||||
return $xml .'/>' if not defined $value;
|
||||
|
||||
$xml .= join q{}, '>' , $value , '</' , $name , '>';
|
||||
$xml .= "\n" if ($opt->{ readable });
|
||||
return $xml;
|
||||
}
|
||||
|
||||
sub explain {
|
||||
my ($self, $opt, $name) = @_;
|
||||
my $perl;
|
||||
$opt->{ indent } ||= "";
|
||||
$perl .= $opt->{ indent } if ($opt->{ readable });
|
||||
$perl .= q{'} . $name . q{' => $someValue };
|
||||
$perl .= "\n" if ($opt->{ readable });
|
||||
return $perl;
|
||||
}
|
||||
|
||||
sub _check_value {
|
||||
my $self = shift;
|
||||
}
|
||||
|
||||
sub toClass {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
my $class_prefix = $opt->{ prefix };
|
||||
my $name = $opt->{name} || $self->get_name();
|
||||
my $flavor = $self->get_flavor() eq 'list'
|
||||
? 'SOAP::WSDL::XSD::Typelib::Builtin::list'
|
||||
: $self->get_flavor() eq 'restriction'
|
||||
? 'SOAP::WSDL::XSD::Typelib::SimpleType::restriction'
|
||||
: q{};
|
||||
my $base = $self->get_base();
|
||||
my $targetNamespace = $self->get_targetNamespace;
|
||||
my ($prefix, $localname) = split /:/, $base;
|
||||
my %ns_map = reverse %{ $opt->{ wsdl }->get_xmlns() };
|
||||
$base = ($ns_map{ $prefix} eq 'http://www.w3.org/2001/XMLSchema')
|
||||
? "SOAP::WSDL::XSD::Typelib::Builtin::$localname"
|
||||
: "$opt->{prefix}::$localname";
|
||||
|
||||
my $code =<<"EOT";
|
||||
package $class_prefix::$name;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use SOAP::WSDL::XSD::Typelib::SimpleType;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType
|
||||
$flavor
|
||||
$base
|
||||
);
|
||||
|
||||
1;
|
||||
|
||||
sub get_xmlns { '$targetNamespace' }
|
||||
|
||||
EOT
|
||||
|
||||
return $code;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * simpleContent, complexContent
|
||||
|
||||
These child elements are not implemented yet
|
||||
|
||||
=item * union
|
||||
|
||||
union simpleType definitions probalbly serialize wrong
|
||||
|
||||
=item * explain may produce erroneous results
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
205
lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
Normal file
205
lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
Normal file
@@ -0,0 +1,205 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::anyType;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::anyURI;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::base64Binary;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::boolean;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::byte;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::date;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::dateTime;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::decimal;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::double;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::duration;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::ENTITY;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::float;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::gDay;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::gMonth;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::gYear;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::hexBinary;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::ID;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::IDREF;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::IDREFS;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::int;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::integer;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::language;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::list;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::long;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::Name;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::NCName;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::negativeInteger;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::normalizedString;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::NOTATION;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::QName;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::short;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::string;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::time;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::token;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort;
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin - Built-in XML Schema datatypes
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module implements all builtin Types from the XML schema specification.
|
||||
|
||||
Objects of a class may be filled with values and serialize correctly.
|
||||
|
||||
These basic type classes are most useful when used as element or simpleType
|
||||
base classes.
|
||||
|
||||
The datatypes classes themselves are split up into
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::* modules.
|
||||
|
||||
Using SOAP::WSDL::XSD::Typelib::Builtin uses all of the builtin datatype
|
||||
classes.
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
my $bool = SOAP::WSDL::XSD::Typelib::Builtin::bool->new({ value => 0} );
|
||||
print $bool; # prints "true"
|
||||
|
||||
# implements <simpleType name="MySimpleType">
|
||||
# <list itemType="xsd:string" />
|
||||
# </simpleType>
|
||||
package MySimpleType;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use SOAP::WSDL::XSD::Typelib::SimpleType;
|
||||
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::SimpleType
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::string
|
||||
);
|
||||
1;
|
||||
|
||||
# somewhere else
|
||||
my $list = MySimpleType->new({ value => [ 'You', 'shall', 'overcome' ] });
|
||||
print $list; # prints "You shall overcome"
|
||||
|
||||
=head1 CLASS HIERARCHY
|
||||
|
||||
This is the inheritance graph for builtin types.
|
||||
|
||||
Types with [] marker describe types derived via the item in [] in the XML
|
||||
Schema specs.
|
||||
|
||||
Derivation is implemented via multiple inheritance with the derivation method
|
||||
as first item in the base class list.
|
||||
|
||||
anyType
|
||||
- anySimpleType
|
||||
- duration
|
||||
- dateTime
|
||||
- date
|
||||
- time
|
||||
- gYearMonth
|
||||
- gYear
|
||||
- gMonthDay
|
||||
- gDay
|
||||
- gMonth
|
||||
- boolean
|
||||
- base64Binary
|
||||
- hexBinary
|
||||
- float
|
||||
- decimal
|
||||
- integer
|
||||
- nonPositiveInteger
|
||||
- negativeInteger
|
||||
- nonNegativeInteger
|
||||
- positiveInteger
|
||||
- unsignedLong
|
||||
- unsignedInt
|
||||
- unsignedShort
|
||||
- unsignedByte
|
||||
- long
|
||||
- int
|
||||
- short
|
||||
- byte
|
||||
- double
|
||||
- anyURI
|
||||
- string
|
||||
- normalizedString
|
||||
- language
|
||||
- Name
|
||||
- NCName
|
||||
- ID
|
||||
- IDREF
|
||||
- IDREFS [list]
|
||||
- ENTITY
|
||||
- NMTOKEN
|
||||
- NMTOKENS [list]
|
||||
|
||||
=head1 OVERLOADED OPERATORS
|
||||
|
||||
Overloading is implemented via Class::Std's trait mechanism.
|
||||
|
||||
The following behaviours apply:
|
||||
|
||||
=over
|
||||
|
||||
=item * string context
|
||||
|
||||
All classes use the C<serialize> method for stringification.
|
||||
|
||||
=item * bool context
|
||||
|
||||
All classes derived from anySimpleType return their value in bool context
|
||||
|
||||
=item * numeric context
|
||||
|
||||
The boolean class returns 0 or 1 in numeric context.
|
||||
|
||||
decimal, float and double (and derived classes) return their value in
|
||||
numeric context.
|
||||
|
||||
=back
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
=over
|
||||
|
||||
=item * Thread safety
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin uses Class::Std::Storable which uses
|
||||
Class::Std. Class::Std is not thread safe, so
|
||||
SOAP::WSDL::XSD::Typelib::Builtin is neither.
|
||||
|
||||
=item * XML Schema facets
|
||||
|
||||
No facets are implemented yet.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Replace whitespace by @ in e-mail address.
|
||||
|
||||
Martin Kutter E<gt>martin.kutter fen-net.deE<lt>
|
||||
|
||||
=head1 Licenxe
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This library is free software, you may distribute/modify it under the
|
||||
same terms as perl itself
|
||||
|
||||
=cut
|
||||
27
lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
Normal file
27
lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
Normal file
@@ -0,0 +1,27 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::ENTITY;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::NCName);
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::ENTITY - ENTITY objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm
Normal file
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm
Normal file
@@ -0,0 +1,26 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::ID;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::NCName);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::ID - ID objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm
Normal file
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm
Normal file
@@ -0,0 +1,26 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::IDREF;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::ID);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::IDREF - IDREF objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
32
lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm
Normal file
32
lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm
Normal file
@@ -0,0 +1,32 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::IDREFS;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::IDREF);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::IDREFS - IDREFS objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
IDREFS is a list datatype implemented by list derivation from IDREF.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm
Normal file
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm
Normal file
@@ -0,0 +1,26 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::NCName;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::Name);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::NCName - NCName objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm
Normal file
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm
Normal file
@@ -0,0 +1,26 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN - NMTOKEN objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
33
lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm
Normal file
33
lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm
Normal file
@@ -0,0 +1,33 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::NMTOKENS;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN);
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::NMTOKENS - NMTOKENS objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
List of NMTOKEN objects.
|
||||
|
||||
Implemented by derivation via SOAP::WSDL::XSD::Typelib::Builtin::list.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
45
lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm
Normal file
45
lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm
Normal file
@@ -0,0 +1,45 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::NOTATION;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %length_of :ATTR(:name<length> :default<()>);
|
||||
my %minLength_of :ATTR(:name<minLength> :default<()>);
|
||||
my %maxLength_of :ATTR(:name<maxLength> :default<()>);
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::NOTATION - NOTATION object
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
NOTATION represents the NOTATION attribute type from
|
||||
XML 1.0 (Second Edition)
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
Facets are implemented but don't have any influence yet.
|
||||
|
||||
No constraints are implemented yet.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm
Normal file
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm
Normal file
@@ -0,0 +1,26 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::Name;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::Name - Name objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
45
lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm
Normal file
45
lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm
Normal file
@@ -0,0 +1,45 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::QName;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %length_of :ATTR(:name<length> :default<()>);
|
||||
my %minLength_of :ATTR(:name<minLength> :default<()>);
|
||||
my %maxLength_of :ATTR(:name<maxLength> :default<()>);
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::QName - qualified Name object
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
QName represents XML qualified names. The <20>value space<63> of QName
|
||||
is the set of tuples {namespace name, local part}, where namespace
|
||||
name is an anyURI and local part is an NCName.
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
Facets are implemented but don't have any influence yet.
|
||||
|
||||
No constraints are implemented yet.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
66
lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm
Normal file
66
lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm
Normal file
@@ -0,0 +1,66 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
|
||||
|
||||
my %value_of :ATTR(:get<value> :init_arg<value> :default<()>);
|
||||
|
||||
## use $_[n] for speed - we get called zillions of times...
|
||||
# and we don't need to return the last value...
|
||||
sub set_value { $value_of{ ident $_[0] } = $_[1] }
|
||||
|
||||
sub serialize {
|
||||
my ($self, $opt) = @_;
|
||||
my $ident = ident $self;
|
||||
$opt ||= {};
|
||||
return $self->start_tag({ %$opt, nil => 1})
|
||||
if not defined $value_of{ $ident };
|
||||
return join q{}, $self->start_tag($opt, $value_of{ $ident })
|
||||
, $value_of{ $ident }
|
||||
, $self->end_tag($opt);
|
||||
}
|
||||
|
||||
# TODO disallow serializing !
|
||||
sub as_bool :BOOLIFY {
|
||||
return $value_of { ident $_[0] };
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :BOOLIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType - All builtin and all simpleType types inherit from anySimpleType
|
||||
|
||||
=head1 CAVEATS
|
||||
|
||||
=over
|
||||
|
||||
=item * set_value
|
||||
|
||||
In contrast to Class::Std-generated mutators (setters), set_value does
|
||||
not return the last value.
|
||||
|
||||
This is for speed reasons: SOAP::WSDL never needs to know the last value
|
||||
when calling set_calue, but calls it over and over again...
|
||||
|
||||
=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>
|
||||
|
||||
=cut
|
||||
49
lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm
Normal file
49
lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm
Normal file
@@ -0,0 +1,49 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::anyType;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
my %xmlns_of :ATTR(:name<xmlns> :default<()>);
|
||||
|
||||
# use $_[1] for performance
|
||||
sub start_tag {
|
||||
my $opt = $_[1] ||= {};
|
||||
return '<' . $opt->{name} . ' >' if $opt->{ name };
|
||||
return q{}
|
||||
}
|
||||
|
||||
# use $_[1] for performance
|
||||
sub end_tag {
|
||||
return $_[1] && defined $_[1]->{ name }
|
||||
? "</$_[1]->{name} >"
|
||||
: q{};
|
||||
};
|
||||
|
||||
sub serialize_qualified :STRINGIFY {
|
||||
return $_[0]->serialize( { qualified => 1 } );
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :STRINGIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::anyType - Base of all XSD Types
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
48
lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm
Normal file
48
lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm
Normal file
@@ -0,0 +1,48 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::anyURI;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %length_of :ATTR(:name<length> :default<()>);
|
||||
my %minLength_of :ATTR(:name<minLength> :default<()>);
|
||||
my %maxLength_of :ATTR(:name<maxLength> :default<()>);
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::anyURI - URI object
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
anyURI represents a Uniform Resource Identifier Reference (URI).
|
||||
An anyURI value can be absolute or relative, and may have an optional
|
||||
fragment identifier (i.e., it may be a URI Reference).
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
Facets are implemented but don't have any influence yet.
|
||||
|
||||
No constraints are implemented yet.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
35
lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
Normal file
35
lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
Normal file
@@ -0,0 +1,35 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::base64Binary;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %length_of :ATTR(:name<length> :default<()>);
|
||||
my %minLength_of :ATTR(:name<minLength> :default<()>);
|
||||
my %maxLength_of :ATTR(:name<maxLength> :default<()>);
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::base64Binary - base64 encoded binary objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
69
lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
Normal file
69
lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
Normal file
@@ -0,0 +1,69 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::boolean;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
|
||||
my %value_of :ATTR(:get<value> :init_attr<value> :default<()>);
|
||||
|
||||
sub serialize {
|
||||
my ($self, $opt) = @_;
|
||||
my $ident = ident $self;
|
||||
$opt ||= {};
|
||||
return $self->start_tag({ %$opt, nil => 1})
|
||||
if not defined $value_of{ $ident };
|
||||
return join q{}
|
||||
, $self->start_tag($opt)
|
||||
, $value_of{ $ident } ? 'true' : 'false'
|
||||
, $self->end_tag($opt);
|
||||
}
|
||||
|
||||
sub as_num :NUMERIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
sub set_value {
|
||||
my ($self, $value) = @_;
|
||||
$value_of{ ident $self } = defined $value
|
||||
? ($value ne 'false' or ($value))
|
||||
? 1 : 0
|
||||
: 0;
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :BOOLIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::boolean - boolean objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Serializes to "true" or "false".
|
||||
|
||||
Everything true in perl and not "false" is deserialized as true.
|
||||
|
||||
Returns true/false in boolean context.
|
||||
|
||||
Returns 1 / 0 in numeric context.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
33
lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
Normal file
33
lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
Normal file
@@ -0,0 +1,33 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::byte;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::short);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::byte - byte integer objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of short.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm
Normal file
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm
Normal file
@@ -0,0 +1,36 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::date;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::date - date objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
37
lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm
Normal file
37
lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm
Normal file
@@ -0,0 +1,37 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::dateTime;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::dateTime - dateTime objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
|
||||
44
lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm
Normal file
44
lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm
Normal file
@@ -0,0 +1,44 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::decimal;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %totalDigits_of :ATTR(:name<totalDigits> :default<()>);
|
||||
my %fractionDigits_of :ATTR(:name<fractionDigits> :default<()>);
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
sub as_num :NUMERIFY :BOOLIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :NUMERIFY :BOOLIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::decimal - decimal object, base of all non-float numbers
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
56
lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm
Normal file
56
lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm
Normal file
@@ -0,0 +1,56 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::double;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
sub as_num :NUMERIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :NUMERIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::double - double precision float objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The double datatype corresponds to IEEE double-precision 64-bit floating point type.
|
||||
The basic <20>value space<63> of double consists of the values m <20> 2^e, where m is an
|
||||
integer whose absolute value is less than 2^53, and e is an integer between
|
||||
-1075 and 970, inclusive.
|
||||
|
||||
In addition to the basic <20>value space<63> described above, the <20>value space<63> of double
|
||||
also contains the following special values: positive and negative zero, positive and
|
||||
negative infinity and not-a-number. The <20>order-relation<6F> on double is:
|
||||
|
||||
x < y iff y - x is positive.
|
||||
|
||||
Positive zero is greater than negative zero.
|
||||
|
||||
Not-a-number equals itself and is greater than all double values including
|
||||
positive infinity.
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
None of the "special" behaviours and values are implemented yet.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm
Normal file
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm
Normal file
@@ -0,0 +1,36 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::duration;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::duration - duration objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
43
lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm
Normal file
43
lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm
Normal file
@@ -0,0 +1,43 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::float;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
|
||||
sub as_num :NUMERIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :NUMERIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::float - float objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm
Normal file
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm
Normal file
@@ -0,0 +1,36 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::gDay;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::gDay - day objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm
Normal file
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm
Normal file
@@ -0,0 +1,36 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::gMonth;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::gMonth - month objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm
Normal file
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm
Normal file
@@ -0,0 +1,36 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay - month day objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm
Normal file
36
lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm
Normal file
@@ -0,0 +1,36 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::gYear;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::gYear - year objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
34
lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm
Normal file
34
lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm
Normal file
@@ -0,0 +1,34 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth - year and month objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
33
lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm
Normal file
33
lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm
Normal file
@@ -0,0 +1,33 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::hexBinary;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %length_of :ATTR(:name<length> :default<()>);
|
||||
my %minLength_of :ATTR(:name<minLength> :default<()>);
|
||||
my %maxLength_of :ATTR(:name<maxLength> :default<()>);
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::hexBinary - hex encoded binary objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm
Normal file
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm
Normal file
@@ -0,0 +1,31 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::int;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::long);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::int - int objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of long.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
32
lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm
Normal file
32
lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm
Normal file
@@ -0,0 +1,32 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::integer;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::decimal);
|
||||
|
||||
sub as_num :NUMERIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :NUMERIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::integer - integer objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm
Normal file
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm
Normal file
@@ -0,0 +1,26 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::language;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::language - language objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
41
lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm
Normal file
41
lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm
Normal file
@@ -0,0 +1,41 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::list;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
sub serialize {
|
||||
my ($self, $opt) = @_;
|
||||
my $value = $self->get_value();
|
||||
return $self->start_tag({ %$opt, nil => 1 }) if not defined $value;
|
||||
$value = [ $value ] if not ref $value;
|
||||
return join q{}, $self->start_tag($opt, $value)
|
||||
, join( q{ }, @{ $value } )
|
||||
, $self->end_tag($opt, $value);
|
||||
}
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list - list derivation base class
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
To derive from some class by list, just inherit from list.
|
||||
|
||||
Make sure SOAP::WSDL::XSD::Typelib::Builtin::list is before the type
|
||||
to derive from in the @ISA list.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm
Normal file
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm
Normal file
@@ -0,0 +1,31 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::long;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::long - long integer objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of integer.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
30
lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm
Normal file
30
lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm
Normal file
@@ -0,0 +1,30 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::negativeInteger;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::egativeInteger - negative integer objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of integer.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
30
lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm
Normal file
30
lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm
Normal file
@@ -0,0 +1,30 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger - non negative integer objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of integer.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
30
lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm
Normal file
30
lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm
Normal file
@@ -0,0 +1,30 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger - nonPositiveInteger objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of integer.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm
Normal file
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm
Normal file
@@ -0,0 +1,26 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::normalizedString;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::string);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::normalizedString - normalizedString objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm
Normal file
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm
Normal file
@@ -0,0 +1,31 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger - positive integer objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of nonNegativeInteger.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm
Normal file
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm
Normal file
@@ -0,0 +1,31 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::short;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::int);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::short - short int objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of int.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
33
lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
Normal file
33
lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
Normal file
@@ -0,0 +1,33 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::string;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %length_of :ATTR(:name<length> :default<()>);
|
||||
my %minLength_of :ATTR(:name<minLength> :default<()>);
|
||||
my %maxLength_of :ATTR(:name<maxLength> :default<()>);
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::string - string objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
34
lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
Normal file
34
lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
Normal file
@@ -0,0 +1,34 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::time;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
my %pattern_of :ATTR(:name<pattern> :default<()>);
|
||||
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
|
||||
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
|
||||
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
|
||||
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::time - time objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
Normal file
26
lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
Normal file
@@ -0,0 +1,26 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::token;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::normalizedString);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::token - token objects
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm
Normal file
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm
Normal file
@@ -0,0 +1,31 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte - unsigned byte objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of unsignedShort.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
32
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm
Normal file
32
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm
Normal file
@@ -0,0 +1,32 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt - unsigned int objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of unsignedLong.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2004-2007 Martin Kutter.
|
||||
|
||||
This file is part of SOAP-WSDL. You may distribute/modify it under
|
||||
the same terms as perl itself
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
|
||||
|
||||
=cut
|
||||
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm
Normal file
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm
Normal file
@@ -0,0 +1,31 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong - unsigned long integer objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of nonNegativeInteger.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
Normal file
31
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
Normal file
@@ -0,0 +1,31 @@
|
||||
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort - unsigned short integer objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Subclass of unsignedInt.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
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
|
||||
188
lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
Normal file
188
lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
Normal file
@@ -0,0 +1,188 @@
|
||||
#!/usr/bin/perl
|
||||
package SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
use strict;
|
||||
use Carp;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use Scalar::Util qw(blessed);
|
||||
use Class::Std::Storable;
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
|
||||
|
||||
my %ELEMENTS_FROM;
|
||||
my %ATTRIBUTES_OF;
|
||||
my %CLASSES_OF;
|
||||
|
||||
# we store per-class elements.
|
||||
# call as __PACKAGE__->_factory
|
||||
sub _factory {
|
||||
my $class = shift;
|
||||
$ELEMENTS_FROM{ $class } = shift;
|
||||
$ATTRIBUTES_OF{ $class } = shift;
|
||||
$CLASSES_OF{ $class } = shift;
|
||||
|
||||
no strict qw(refs);
|
||||
while (my ($name, $attribute_ref) = each %{ $ATTRIBUTES_OF{ $class } } )
|
||||
{
|
||||
my $type = $CLASSES_OF{ $class }->{ $name }
|
||||
or die "No class given for $name";
|
||||
|
||||
$type->isa('UNIVERSAL')
|
||||
or eval "require $type"
|
||||
or croak $@;
|
||||
|
||||
*{ "$class\::set_$name" } = sub {
|
||||
my ($self, $value) = @_;
|
||||
|
||||
# set to
|
||||
# a) value if it's an object
|
||||
# b) New object with value for simple values
|
||||
# c) New object with value for list values and list type
|
||||
# d) List ref of new objects with value for list values and non-list type
|
||||
# e) New object with values passed to new for HASH references
|
||||
#
|
||||
# Die on non-ARRAY/HASH references - if you can define semantics
|
||||
# for GLOB references, feel free to add them.
|
||||
$attribute_ref->{ ident $self } = (blessed $value)
|
||||
? $value
|
||||
: (ref $value ) ?
|
||||
(ref $value eq 'ARRAY')
|
||||
? $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list')
|
||||
? $type->new({ value => $value })
|
||||
: [ map { $type->new({ value => $_ }) } @{ $value } ]
|
||||
: (ref $value eq 'HASH')
|
||||
? $type->new( $value )
|
||||
: die "Cannot use non-ARRAY/HASH as data"
|
||||
: $type->new({ value => $value });
|
||||
|
||||
};
|
||||
|
||||
*{ "$class\::add_$name" } = sub {
|
||||
my ($self, $value) = @_;
|
||||
my $ident = ident $self;
|
||||
if (not defined $value) {
|
||||
warn "attempting to add empty value to " . ref $self;
|
||||
}
|
||||
|
||||
return $attribute_ref->{ $ident } = $value
|
||||
if not defined $attribute_ref->{ $ident };
|
||||
|
||||
# listify previous value if it's no list
|
||||
$attribute_ref->{ $ident } = [ $attribute_ref->{ $ident } ]
|
||||
if not ref $attribute_ref->{ $ident } eq 'ARRAY';
|
||||
|
||||
# add to list
|
||||
return push @{ $attribute_ref->{ $ident } }, $value;
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
sub START {
|
||||
my ($self, $ident, $args_of) = @_;
|
||||
my $class = ref $self;
|
||||
|
||||
# iterate over keys of arguments
|
||||
# and call set appropriate field in clase
|
||||
map { ($ATTRIBUTES_OF{ $class }->{ $_ })
|
||||
? do {
|
||||
my $method = "set_$_";
|
||||
$self->$method( $args_of->{ $_ } );
|
||||
}
|
||||
: $_ eq 'xmlns'
|
||||
? do {}
|
||||
: croak "unknown field $_ in $class";
|
||||
} keys %$args_of;
|
||||
};
|
||||
|
||||
sub _get_elements {
|
||||
my $self = shift;
|
||||
my $class = ref $self;
|
||||
my $ident = ident $self;
|
||||
return map { $_->{ $ident } } @{ $ELEMENTS_FROM{ $class } };
|
||||
}
|
||||
|
||||
# this serialize method works fine for <all> and <sequence>
|
||||
# complextypes, as well as for <restriction><all> or
|
||||
# <restriction><sequence>.
|
||||
# But what about choice, group, extension ?
|
||||
#
|
||||
sub _serialize {
|
||||
my $ident = ident $_[0];
|
||||
my $class = ref $_[0];
|
||||
|
||||
# return concatenated return value of serialize call of all
|
||||
# elements retrieved from get_elements expanding list refs.
|
||||
# get_elements is inlined for performance.
|
||||
return join q{} , map {
|
||||
my $element = $ATTRIBUTES_OF{ $class }->{ $_ }->{ $ident };
|
||||
|
||||
if (defined $element) {
|
||||
$element = [ $element ]
|
||||
if not ref $element eq 'ARRAY';
|
||||
my $name = $_;
|
||||
|
||||
map {
|
||||
# serialize element elements with their own serializer
|
||||
# but name them like they're named here.
|
||||
if ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) {
|
||||
$_->serialize( { name => $_ } );
|
||||
}
|
||||
# serialize complextype elments (of other types) with their
|
||||
# serializer, but add element tags around.
|
||||
else {
|
||||
join q{}, $_->start_tag({ name => $name })
|
||||
, $_->serialize()
|
||||
, $_->end_tag({ name => $name });
|
||||
}
|
||||
} @{ $element }
|
||||
}
|
||||
else {
|
||||
q{};
|
||||
}
|
||||
} (@{ $ELEMENTS_FROM{ $class } });
|
||||
}
|
||||
|
||||
sub serialize {
|
||||
my ($self, $opt) = @_;
|
||||
$opt ||= {};
|
||||
|
||||
# do we have a empty element ?
|
||||
return $self->start_tag({ %$opt, empty => 1 })
|
||||
if not @{ $ELEMENTS_FROM{ ref $self } };
|
||||
return join q{}, $self->start_tag($opt),
|
||||
$self->_serialize(), $self->end_tag();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 Bugs and limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * Thread safety
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin uses Class::Std::Storable which uses
|
||||
Class::Std. Class::Std is not thread safe, so
|
||||
SOAP::WSDL::XSD::Typelib::Builtin is neither.
|
||||
|
||||
=item * XML Schema facets
|
||||
|
||||
No facets are implemented yet.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Replace whitespace by @ in e-mail address.
|
||||
|
||||
Martin Kutter E<gt>martin.kutter fen-net.deE<lt>
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
This library is free software, you may distribute/modify it under the
|
||||
same terms as perl itself
|
||||
|
||||
=cut
|
||||
101
lib/SOAP/WSDL/XSD/Typelib/Element.pm
Normal file
101
lib/SOAP/WSDL/XSD/Typelib/Element.pm
Normal file
@@ -0,0 +1,101 @@
|
||||
#!/usr/bin/perl
|
||||
package SOAP::WSDL::XSD::Typelib::Element;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use Data::Dumper;
|
||||
|
||||
my %NAME;
|
||||
my %NILLABLE;
|
||||
my %REF;
|
||||
my %MIN_OCCURS;
|
||||
my %MAX_OCCURS;
|
||||
|
||||
# Class data - remember, we're the base class for a class factory or for
|
||||
# generated code...
|
||||
# use BLOCK: for scoping
|
||||
BLOCK: {
|
||||
my %method_lookup = (
|
||||
_name => \%NAME,
|
||||
_nillable => \%NILLABLE,
|
||||
_ref => \%REF,
|
||||
_minOccurs => \%MIN_OCCURS,
|
||||
_maxOccurs => \%MAX_OCCURS,
|
||||
);
|
||||
|
||||
no strict qw(refs);
|
||||
while (my ($name, $value) = each %method_lookup ) {
|
||||
*{ "__set$name" } = sub {
|
||||
my $class = ref $_[0] || $_[0];
|
||||
$value->{ $class } = $_[1];
|
||||
};
|
||||
*{ "__get$name" } = sub {
|
||||
my $class = ref $_[0] || $_[0];
|
||||
return $value->{ $class };
|
||||
};
|
||||
}
|
||||
};
|
||||
|
||||
sub start_tag {
|
||||
my ($self, $opt, $value) = @_;
|
||||
my $class = ref $self;
|
||||
my $ending = '>';
|
||||
my @attr_from = ();
|
||||
|
||||
$ending = '/>' if ($opt->{ empty });
|
||||
|
||||
if ($opt->{qualified}) {
|
||||
push @attr_from, 'xmlns="' . $self->get_xmlns . '"';
|
||||
}
|
||||
if ($opt->{ nil }) {
|
||||
return q{} if not $NILLABLE{ $class };
|
||||
push @attr_from, 'xsi:nil="true"';
|
||||
$ending = '/>';
|
||||
}
|
||||
return join q{ }, "<$NAME{$class}" , @attr_from , $ending;
|
||||
}
|
||||
|
||||
sub end_tag {
|
||||
my ($self, $class) = ($_[0], ref $_[0]);
|
||||
return "</$NAME{$class}>";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package MyElement;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use base (
|
||||
'SOAP::WSDL::XSD::Typelib::Element',
|
||||
);
|
||||
|
||||
__PACKAGE__->__set_name('MyElementName');
|
||||
__PACKAGE__->__set_nillable(1);
|
||||
__PACKAGE__->__set_minOccurs(1);
|
||||
__PACKAGE__->__set_maxOccurs(1);
|
||||
__PACKAGE__->__set_ref(1);
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
=over
|
||||
|
||||
=item * minOccurs maxOccurs ref not implemented
|
||||
|
||||
These attributes are not yet supported, though they may be set as class
|
||||
properties via __PACKAGE__->__set_FOO methods.
|
||||
|
||||
=item * 'http://www.w3.org/2001/XMLSchema-instance prefix is hardcoded
|
||||
|
||||
The prefix for 'http://www.w3.org/2001/XMLSchema-instance (used as namespace
|
||||
for the {http://www.w3.org/2001/XMLSchema-instance}nil="true" attribute
|
||||
is hardcoded as 'xsi'.
|
||||
|
||||
You should definitly provide your XML envelope generator with the same prefix
|
||||
namespace combination (Default for SOAP::WSDL::Envelope).
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
132
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
Normal file
132
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
Normal file
@@ -0,0 +1,132 @@
|
||||
#!/usr/bin/perl
|
||||
package SOAP::WSDL::XSD::Typelib::SimpleType;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
|
||||
package SOAP::WSDL::XSD::Typelib::SimpleType::restriction;
|
||||
use strict;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::SimpleType);
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType - simple type base class
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module implements a base class for designing simple type classes
|
||||
modelling XML Schema simpleType definitions.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# example simpleType derived by restriction
|
||||
# XSD would be:
|
||||
# <simpleType name="MySimpleType">
|
||||
# <restriction base="xsd:string" />
|
||||
# </simpleType>
|
||||
package MySimpleType;
|
||||
use Class::Std::Storable;
|
||||
# restriction base implemented via inheritance
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use SOAP::WSDL::XSD::Typelib::SimpleType;
|
||||
use base qw(
|
||||
# derive by restriction
|
||||
'SOAP::WSDL::XSD::Typelib::SimpleType::restriction',
|
||||
# restriction base
|
||||
'SOAP::WSDL::XSD::Typelib::Builtin::string'
|
||||
);
|
||||
|
||||
# example simpleType derived by list.
|
||||
# XSD would be:
|
||||
# <simpleType name="MySimpleListType">
|
||||
# <list itemTipe="xsd:string" />
|
||||
# </simpleType>
|
||||
package MySimpleListType;
|
||||
use Class::Std::Storable;
|
||||
# restriction base implemented via inheritance
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use base ('SOAP::WSDL::XSD::Typelib::SimpleType',
|
||||
'SOAP::WSDL::XSD::Typelib::Builtin::list', # derive by list
|
||||
'SOAP::WSDL::XSD::Typelib::Builtin::string' # list itemType
|
||||
);
|
||||
|
||||
=head1 How to write your own simple type
|
||||
|
||||
Writing a simple type class is easy - all you have to do is setting up the
|
||||
base classes correctly.
|
||||
|
||||
The following rules apply:
|
||||
|
||||
=over
|
||||
|
||||
=item * simpleType derived via list
|
||||
|
||||
simpleType classes derived via list must inherit from these classes in
|
||||
exactly this order:
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::list # derive by list
|
||||
The::List::ItemType::Class # list itemType
|
||||
|
||||
The::List::ItemType::Class can either be a builtin class (see
|
||||
SOAP::WSDL::XSD::Builtin) or another simpleType class (any other class
|
||||
implementing the right methods is supported too, but not for the
|
||||
faint of heart).
|
||||
|
||||
=item * simpleType derived via restriction
|
||||
|
||||
simpleType classes derived via restriction must inherit from these classes in
|
||||
exactly this order:
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType # you may leave out this
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType::restriction # derive by retriction
|
||||
The::Restriction::Base::Class # resytriction base
|
||||
|
||||
The::Restriction::Base::Class can either be a builtin class (see
|
||||
SOAP::WSDL::XSD::Builtin) or another simpleType class.
|
||||
|
||||
The slight inconsistency between the these variants is caused by the
|
||||
restriction element, which has different meanings for simpleType and
|
||||
complexType definitions.
|
||||
|
||||
=back
|
||||
|
||||
=head1 BUGS AND LIMITATIONS
|
||||
|
||||
=over
|
||||
|
||||
=item * Thread safety
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType uses Class::Std::Storable which uses
|
||||
Class::Std. Class::Std is not thread safe, so
|
||||
SOAP::WSDL::XSD::Typelib::SimpleType is neither.
|
||||
|
||||
=item * union
|
||||
|
||||
union simple types are not supported yet.
|
||||
|
||||
=item * XML Schema facets
|
||||
|
||||
No facets are implemented yet.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Replace whitespace by @ in e-mail address.
|
||||
|
||||
Martin Kutter E<gt>martin.kutter fen-net.deE<lt>
|
||||
|
||||
=head1 COPYING
|
||||
|
||||
This library is free software, you may distribute/modify it under the
|
||||
same terms as perl itself
|
||||
|
||||
=cut
|
||||
30
t/001_use.t
Normal file
30
t/001_use.t
Normal file
@@ -0,0 +1,30 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More qw/no_plan/; # TODO: change to tests => N;
|
||||
use lib '../lib';
|
||||
chdir 't/' if (-d 't/');
|
||||
|
||||
my @modules = qw(
|
||||
SOAP::WSDL::Definitions
|
||||
SOAP::WSDL::Message
|
||||
SOAP::WSDL::Operation
|
||||
SOAP::WSDL::OpMessage
|
||||
SOAP::WSDL::SoapOperation
|
||||
SOAP::WSDL::Binding
|
||||
SOAP::WSDL::Port
|
||||
SOAP::WSDL::PortType
|
||||
SOAP::WSDL::Types
|
||||
SOAP::WSDL::SAX::WSDLHandler
|
||||
SOAP::WSDL::XSD::Primitive
|
||||
SOAP::WSDL::XSD::ComplexType
|
||||
SOAP::WSDL::XSD::SimpleType
|
||||
SOAP::WSDL::XSD::Element
|
||||
SOAP::WSDL::XSD::Schema
|
||||
);
|
||||
|
||||
for my $module (@modules)
|
||||
{
|
||||
use_ok($module);
|
||||
ok($module->new(), "Object creation");
|
||||
}
|
||||
335
t/002_sax.t
Normal file
335
t/002_sax.t
Normal file
@@ -0,0 +1,335 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
use Test::More tests => 17; # qw/no_plan/; # TODO: change to tests => N;
|
||||
use lib '../lib';
|
||||
use XML::SAX::ParserFactory;
|
||||
|
||||
eval {
|
||||
require Test::XML;
|
||||
import Test::XML;
|
||||
};
|
||||
|
||||
use_ok(qw/SOAP::WSDL::SAX::WSDLHandler/);
|
||||
|
||||
my $filter;
|
||||
|
||||
ok($filter = SOAP::WSDL::SAX::WSDLHandler->new(
|
||||
{ base => 'XML::SAX::Base' }
|
||||
), "Object creation");
|
||||
|
||||
my $parser = XML::SAX::ParserFactory->parser(
|
||||
Handler => $filter
|
||||
);
|
||||
|
||||
$parser->parse_string( xml() );
|
||||
|
||||
my $wsdl;
|
||||
ok( $wsdl = $filter->get_data() , "get object tree");
|
||||
|
||||
# print Dumper $wsdl;
|
||||
|
||||
my $types = $wsdl->first_types();
|
||||
|
||||
my $serializer_options = {
|
||||
readable => 1,
|
||||
autotype => 1,
|
||||
namespace => { 'urn:myNamespace' => 'tns',
|
||||
"http://www.w3.org/2001/XMLSchema" => 'xsd' },
|
||||
typelib => $wsdl->first_types(),
|
||||
indent => "\t",
|
||||
};
|
||||
|
||||
my $xml;
|
||||
my $type = $types->find_type( 'urn:myNamespace', 'testSimpleType1' );
|
||||
|
||||
|
||||
ok($xml = $type->serialize( 'test', 1 , $serializer_options ),
|
||||
"serialize simple Type"
|
||||
);
|
||||
|
||||
# print $xml;
|
||||
|
||||
SKIP: {
|
||||
skip_without_test_xml();
|
||||
is_xml( $xml, '<test type="tns:testSimpleType1">1</test>',
|
||||
"content compare" );
|
||||
};
|
||||
|
||||
$type = $types->find_type( 'urn:myNamespace', 'testSimpleList' );
|
||||
ok($xml = $type->serialize( 'testList', [ 1, 2, 3 ] , $serializer_options ),
|
||||
"serialize simple list type"
|
||||
);
|
||||
SKIP: {
|
||||
skip_without_test_xml();
|
||||
is_xml( $xml, '<testList type="tns:testSimpleList">1 2 3</testList>',
|
||||
"content compare" );
|
||||
};
|
||||
|
||||
$type = $types->find_element( 'urn:myNamespace', 'TestElement' );
|
||||
|
||||
ok($xml = $type->serialize( undef, 1 , $serializer_options ),
|
||||
"serialize simple element");
|
||||
SKIP: {
|
||||
skip_without_test_xml();
|
||||
is_xml( $xml, '<TestElement type="xsd:int">1</TestElement>',
|
||||
"content compare" );
|
||||
};
|
||||
|
||||
ok( $xml = $types->find_type( 'urn:myNamespace', 'length3')->serialize(
|
||||
'TestComplex', { size => -13, unit => 'BLA' } ,
|
||||
$serializer_options
|
||||
),
|
||||
"serialize complex type");
|
||||
|
||||
SKIP: {
|
||||
skip_without_test_xml();
|
||||
is_xml( $xml, q{
|
||||
<TestComplex type="tns:length3">
|
||||
<size type="xsd:non-positive-integer">-13</size>
|
||||
<unit type="xsd:NMTOKEN">BLA</unit>
|
||||
</TestComplex>},
|
||||
"content compare" );
|
||||
};
|
||||
|
||||
ok($xml = $types->find_element( 'urn:myNamespace', 'TestElementComplexType')
|
||||
->serialize(
|
||||
undef, { size => -13, unit => 'BLA' } , $serializer_options ),
|
||||
"serialize element with complex type"
|
||||
);
|
||||
SKIP: {
|
||||
skip_without_test_xml();
|
||||
is_xml( $xml, q{
|
||||
<TestElementComplexType type="tns:length3">
|
||||
<size type="xsd:non-positive-integer">-13</size>
|
||||
<unit type="xsd:NMTOKEN">BLA</unit>
|
||||
</TestElementComplexType>
|
||||
},
|
||||
"content compare" );
|
||||
};
|
||||
|
||||
|
||||
ok($xml = $types->find_type( 'urn:myNamespace', 'complex')->serialize(
|
||||
'complexComplex',
|
||||
{ 'length' => { size => -13, unit => 'BLA' }, 'int' => 1 },
|
||||
$serializer_options ),
|
||||
"serialize complex type with complex content"
|
||||
);
|
||||
SKIP: {
|
||||
skip_without_test_xml();
|
||||
is_xml( $xml, q{
|
||||
<complexComplex type="tns:complex">
|
||||
<length type="tns:length3">
|
||||
<size type="xsd:non-positive-integer">-13</size>
|
||||
<unit type="xsd:NMTOKEN">BLA</unit>
|
||||
</length>
|
||||
<int type="xsd:int">1</int>
|
||||
</complexComplex>
|
||||
},
|
||||
"content compare" );
|
||||
}
|
||||
ok($xml = $wsdl->find_message('urn:myNamespace', 'testRequest')
|
||||
->get_part()->[0]->serialize(
|
||||
undef,
|
||||
{ test => { length => { size => -13, unit => 'BLA' } , int => 3 } },
|
||||
$serializer_options ),
|
||||
"serialize part"
|
||||
);
|
||||
SKIP: {
|
||||
skip_without_test_xml();
|
||||
is_xml( $xml, q{
|
||||
<test type="tns:complex">
|
||||
<length type="tns:length3">
|
||||
<size type="xsd:non-positive-integer">-13</size>
|
||||
<unit type="xsd:NMTOKEN">BLA</unit>
|
||||
</length>
|
||||
<int type="xsd:int">3</int>
|
||||
</test>
|
||||
},
|
||||
"content compare")
|
||||
};
|
||||
|
||||
my $opt = {
|
||||
typelib => $types,
|
||||
readable => 1,
|
||||
autotype => 0,
|
||||
namespace => { 'urn:myNamespace' => 'tns',
|
||||
'http://www.w3.org/2001/XMLSchema' => 'xsd',
|
||||
'http://schemas.xmlsoap.org/wsdl/' => 'wsdl',
|
||||
},
|
||||
indent => "",
|
||||
wsdl => $wsdl,
|
||||
};
|
||||
|
||||
# ok $wsdl->explain($opt) =~ m/#optional/m;
|
||||
|
||||
sub skip_without_test_xml {
|
||||
skip("Test::XML not available", 1) if (not $Test::XML::VERSION);
|
||||
}
|
||||
|
||||
sub xml
|
||||
{
|
||||
return q{<?xml version="1.0"?>
|
||||
<definitions name="simpleType"
|
||||
targetNamespace="urn:myNamespace"
|
||||
xmlns="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:tns="urn:myNamespace"
|
||||
xmlns:xsd="http://www.w3c.org/2001/XMLSchema"
|
||||
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
>
|
||||
<types>
|
||||
<xsd:schema targetNamespace="urn:myNamespace">
|
||||
<xsd:complexType name="length3">
|
||||
<xsd:all>
|
||||
<xsd:element name="size" type="xsd:non-positive-integer"/>
|
||||
<xsd:element name="unit" type="xsd:NMTOKEN"/>
|
||||
</xsd:all>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="complex">
|
||||
<xsd:sequence>
|
||||
<xsd:element name="length" type="tns:length3"/>
|
||||
<xsd:element name="int" type="xsd:int"/>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:element name="TestElement" type="xsd:int"/>
|
||||
<xsd:element name="TestElementComplexType" type="tns:length3"/>
|
||||
<xsd:simpleType name="testSimpleType1">
|
||||
<xsd:restriction base="int">
|
||||
<xsd:enumeration value="1"/>
|
||||
<xsd:enumeration value="2"/>
|
||||
<xsd:enumeration value="3"/>
|
||||
</xsd:restriction>
|
||||
</xsd:simpleType>
|
||||
|
||||
<xsd:simpleType name="testSimpleList">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
SimpleType Test
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:list itemType="int">
|
||||
</xsd:list>
|
||||
</xsd:simpleType>
|
||||
<xsd:simpleType name="testSimpleUnion">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
SimpleType Union test
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:union memberTypes="int float">
|
||||
</xsd:union>
|
||||
</xsd:simpleType>
|
||||
</xsd:schema>
|
||||
</types>
|
||||
<message name="testRequest">
|
||||
<part name="test" type="tns:complex"/>
|
||||
</message>
|
||||
<message name="testResponse">
|
||||
<part name="test" type="tns:testSimpleType1"/>
|
||||
</message>
|
||||
<message name="testRequest2">
|
||||
<part name="test" type="tns:testSimpleType1"/>
|
||||
</message>
|
||||
<message name="testResponse2">
|
||||
<part name="test" type="tns:testSimpleType1"/>
|
||||
</message>
|
||||
<portType name="testPort">
|
||||
<operation name="test">
|
||||
<documentation>
|
||||
Test-Methode
|
||||
</documentation>
|
||||
|
||||
<input message="tns:testRequest"/>
|
||||
<output message="tns:testResponse"/>
|
||||
</operation>
|
||||
<operation name="test2">
|
||||
<documentation>
|
||||
Test-Methode
|
||||
</documentation>
|
||||
|
||||
<input message="tns:testRequest2"/>
|
||||
<output message="tns:testResponse2"/>
|
||||
</operation>
|
||||
</portType>
|
||||
<portType name="testPort2">
|
||||
<operation name="test">
|
||||
<documentation>
|
||||
Test-Methode
|
||||
</documentation>
|
||||
|
||||
<input message="tns:testRequest"/>
|
||||
<output message="tns:testResponse"/>
|
||||
</operation>
|
||||
</portType>
|
||||
<portType name="testPort3">
|
||||
<operation name="test">
|
||||
<documentation>
|
||||
Test-Methode
|
||||
</documentation>
|
||||
<input message="tns:testRequest"/>
|
||||
<output message="tns:testResponse"/>
|
||||
</operation>
|
||||
</portType>
|
||||
|
||||
<binding type="tns:testPort" name="testBinding">
|
||||
<operation name="test">
|
||||
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
|
||||
<soap:operation soapAction="test">
|
||||
<input>
|
||||
<soap:body use="literal"/>
|
||||
</input>
|
||||
<output>
|
||||
<soap:body use="literal"/>
|
||||
</output>
|
||||
</soap:operation>
|
||||
</operation>
|
||||
</binding>
|
||||
<binding type="tns:testPort2" name="testBinding2">
|
||||
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
|
||||
<operation name="test">
|
||||
<soap:operation soapAction="test">
|
||||
<input>
|
||||
<soap:body use="literal"/>
|
||||
</input>
|
||||
<output>
|
||||
<soap:body use="literal"/>
|
||||
</output>
|
||||
</soap:operation>
|
||||
</operation>
|
||||
</binding>
|
||||
<binding type="tns:testPort3" name="testBinding3">
|
||||
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
|
||||
<operation name="test">
|
||||
<soap:operation soapAction="test">
|
||||
<input>
|
||||
<soap:body use="literal"/>
|
||||
</input>
|
||||
<output>
|
||||
<soap:body use="literal"/>
|
||||
</output>
|
||||
</soap:operation>
|
||||
</operation>
|
||||
</binding>
|
||||
<service name="testService">
|
||||
<port name="testPort" binding="tns:testBinding">
|
||||
<soap:address location="http://127.0.0.1/testPort" />
|
||||
</port>
|
||||
<port name="testPort2" binding="tns:testBinding2">
|
||||
<soap:address location="http://127.0.0.1/testPort2" />
|
||||
</port>
|
||||
</service>
|
||||
<service name="testService2">
|
||||
<port name="testPort3" binding="tns:testBinding3">
|
||||
<soap:address location="http://127.0.0.1/testPort3" />
|
||||
</port>
|
||||
|
||||
</service>
|
||||
</definitions>
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
287
t/003_sax_serializer.t
Normal file
287
t/003_sax_serializer.t
Normal file
@@ -0,0 +1,287 @@
|
||||
use Test::More tests => 11;
|
||||
use Data::Dumper;
|
||||
use lib '../lib';
|
||||
use XML::LibXML;
|
||||
|
||||
use_ok(qw/SOAP::WSDL::SAX::WSDLHandler/);
|
||||
|
||||
my $filter;
|
||||
|
||||
ok($filter = SOAP::WSDL::SAX::WSDLHandler->new(), "Object creation");
|
||||
|
||||
my $parser = XML::LibXML->new();
|
||||
$parser->set_handler( $filter );
|
||||
|
||||
eval { $parser->parse_string( xml() ) };
|
||||
if ($@)
|
||||
{
|
||||
fail("parsing WSDL");
|
||||
die "Can't test without parsed WSDL";
|
||||
}
|
||||
else
|
||||
{
|
||||
pass("parsing XML");
|
||||
}
|
||||
|
||||
my $wsdl;
|
||||
ok( $wsdl = $filter->get_data() , "get object tree");
|
||||
|
||||
|
||||
my $schema = $wsdl->first_types();
|
||||
|
||||
my $opt = {
|
||||
readable => 0,
|
||||
autotype => 1,
|
||||
namespace => $wsdl->get_xmlns(),
|
||||
indent => "\t",
|
||||
typelib => $schema,
|
||||
};
|
||||
|
||||
is( $schema->find_type( 'myNamespace', 'testSimpleType1' )->serialize(
|
||||
'test', 1 , $opt ),
|
||||
q{<test type="tns:testSimpleType1">1</test>} , "serialize simple type");
|
||||
|
||||
is( $schema->find_type( 'myNamespace', 'testSimpleList' )->serialize(
|
||||
'testList', [ 1, 2, 3 ] , $opt),
|
||||
q{<testList type="tns:testSimpleList">1 2 3</testList>},
|
||||
"serialize simple list type"
|
||||
);
|
||||
|
||||
is( $schema->find_element( 'myNamespace', 'TestElement' )->serialize(
|
||||
undef, 1 , $opt),
|
||||
q{<TestElement type="xsd:int">1</TestElement>}, "Serialize element"
|
||||
);
|
||||
|
||||
$opt->{ readable } = 0;
|
||||
|
||||
is( $schema->find_type( 'myNamespace', 'length3')->serialize(
|
||||
'TestComplex', { size => -13, unit => 'BLA' } ,
|
||||
$opt ),
|
||||
q{<TestComplex type="tns:length3" >}
|
||||
. q{<size type="xsd:non-positive-integer">-13</size>}
|
||||
. q{<unit type="xsd:NMTOKEN">BLA</unit></TestComplex>}
|
||||
, "serialize complex type" );
|
||||
|
||||
is( $schema->find_element( 'myNamespace', 'TestElementComplexType')->serialize(
|
||||
undef, { size => -13, unit => 'BLA' } ,
|
||||
$opt ),
|
||||
q{<TestElementComplexType type="tns:length3" >}
|
||||
. q{<size type="xsd:non-positive-integer">-13</size>}
|
||||
. q{<unit type="xsd:NMTOKEN">BLA</unit></TestElementComplexType>},
|
||||
"element with complex type"
|
||||
);
|
||||
|
||||
is( $schema->find_type( 'myNamespace', 'complex')->serialize(
|
||||
'complexComplex',
|
||||
{ 'length' => { size => -13, unit => 'BLA' }, 'int' => 1 },
|
||||
$opt ),
|
||||
q{<complexComplex type="tns:complex" >}
|
||||
. q{<length type="tns:length3" >}
|
||||
. q{<size type="xsd:non-positive-integer">-13</size>}
|
||||
. q{<unit type="xsd:NMTOKEN">BLA</unit></length>}
|
||||
. q{<int type="xsd:int">1</int></complexComplex>},
|
||||
"nested complex type"
|
||||
);
|
||||
|
||||
is( $wsdl->find_message('myNamespace', 'testRequest')->first_part()->serialize(
|
||||
undef, { test => { length => { size => -13, unit => 'BLA' } , int => 3 } },
|
||||
$opt ),
|
||||
q{<test type="tns:complex" >}
|
||||
. q{<length type="tns:length3" >}
|
||||
. q{<size type="xsd:non-positive-integer">-13</size>}
|
||||
. q{<unit type="xsd:NMTOKEN">BLA</unit>}
|
||||
. q{</length><int type="xsd:int">3</int></test>}
|
||||
, "Message part"
|
||||
);
|
||||
|
||||
|
||||
exit;
|
||||
|
||||
foreach my $service (@{ $wsdl->service() })
|
||||
{
|
||||
print "Service: ", $service->name(), "\n";
|
||||
|
||||
foreach my $port( @{ $service->port() })
|
||||
{
|
||||
print " ", "port name: ", $port->name, "\n";
|
||||
print " ", "binding: ", $port->binding(), "\n";
|
||||
print " ", "location: ", $port->location,"\n";
|
||||
my $portType = $wsdl->get_portType(
|
||||
$wsdl->get_binding( $port->binding() )->type()
|
||||
);
|
||||
foreach my $operation ( @{ $portType->operation() } )
|
||||
{
|
||||
print " ", "Operation name: ", $operation->name(), "\n";
|
||||
print " ", "Input message: ",
|
||||
$operation->input()->message(), "\n"
|
||||
if ($operation->input());
|
||||
my $input = $wsdl->get_message( $operation->input()->message() );
|
||||
print " ", "Type: ", $input->name(), "\n";
|
||||
|
||||
print " ", "Output message: ",
|
||||
$operation->output()->message(), "\n"
|
||||
if ($operation->output());
|
||||
my $output = $wsdl->get_message( $operation->output()->message() );
|
||||
print " ", "Type: ", $output->name(), "\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub xml
|
||||
{
|
||||
return q{<?xml version="1.0"?>
|
||||
<definitions name="simpleType"
|
||||
targetNamespace="myNamespace"
|
||||
xmlns="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:tns="myNamespace"
|
||||
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
>
|
||||
<types>
|
||||
<xsd:schema targetNamespace="myNamespace">
|
||||
<xsd:complexType name="length3">
|
||||
<xsd:sequence>
|
||||
<xsd:element name="size" type="xsd:non-positive-integer"/>
|
||||
<xsd:element name="unit" type="xsd:NMTOKEN"/>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="complex">
|
||||
<xsd:sequence>
|
||||
<xsd:element name="length" type="tns:length3"/>
|
||||
<xsd:element name="int" type="xsd:int"/>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:element name="TestElement" type="xsd:int"/>
|
||||
<xsd:element name="TestElementComplexType" type="tns:length3"/>
|
||||
<xsd:simpleType name="testSimpleType1">
|
||||
<xsd:restriction base="int">
|
||||
<xsd:enumeration value="1"/>
|
||||
<xsd:enumeration value="2"/>
|
||||
<xsd:enumeration value="3"/>
|
||||
</xsd:restriction>
|
||||
</xsd:simpleType>
|
||||
|
||||
<xsd:simpleType name="testSimpleList">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
SimpleType Test
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:list itemType="int">
|
||||
</xsd:list>
|
||||
</xsd:simpleType>
|
||||
<xsd:simpleType name="testSimpleUnion">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
SimpleType Union test
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:union memberTypes="int float">
|
||||
</xsd:union>
|
||||
</xsd:simpleType>
|
||||
</xsd:schema>
|
||||
</types>
|
||||
<message name="testRequest">
|
||||
<part name="test" type="tns:complex"/>
|
||||
</message>
|
||||
<message name="testResponse">
|
||||
<part name="test" type="tns:testSimpleType1"/>
|
||||
</message>
|
||||
<message name="testRequest2">
|
||||
<part name="test" type="tns:testSimpleType1"/>
|
||||
</message>
|
||||
<message name="testResponse2">
|
||||
<part name="test" type="tns:testSimpleType1"/>
|
||||
</message>
|
||||
<portType name="testPort">
|
||||
<operation name="test">
|
||||
<documentation>
|
||||
Test-Methode
|
||||
</documentation>
|
||||
|
||||
<input message="testRequest"/>
|
||||
<output message="testResponse"/>
|
||||
</operation>
|
||||
<operation name="test2">
|
||||
<documentation>
|
||||
Test-Methode
|
||||
</documentation>
|
||||
|
||||
<input message="testRequest2"/>
|
||||
<output message="testResponse2"/>
|
||||
</operation>
|
||||
</portType>
|
||||
<portType name="testPort2">
|
||||
<operation name="test">
|
||||
<documentation>
|
||||
Test-Methode
|
||||
</documentation>
|
||||
|
||||
<input message="testRequest"/>
|
||||
<output message="testResponse"/>
|
||||
</operation>
|
||||
</portType>
|
||||
<portType name="testPort3">
|
||||
<operation name="test">
|
||||
<documentation>
|
||||
Test-Methode
|
||||
</documentation>
|
||||
<input message="testRequest"/>
|
||||
<output message="testResponse"/>
|
||||
</operation>
|
||||
</portType>
|
||||
|
||||
<binding type="testPort" name="testBinding">
|
||||
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
|
||||
<soap:operation soapAction="test">
|
||||
<input>
|
||||
<soap:body use="literal"/>
|
||||
</input>
|
||||
<output>
|
||||
<soap:body use="literal"/>
|
||||
</output>
|
||||
</soap:operation>
|
||||
</binding>
|
||||
<binding type="testPort2" name="testBinding2">
|
||||
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
|
||||
<soap:operation soapAction="test">
|
||||
<input>
|
||||
<soap:body use="literal"/>
|
||||
</input>
|
||||
<output>
|
||||
<soap:body use="literal"/>
|
||||
</output>
|
||||
</soap:operation>
|
||||
</binding>
|
||||
<binding type="testPort3" name="testBinding3">
|
||||
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
|
||||
<soap:operation soapAction="test">
|
||||
<input>
|
||||
<soap:body use="literal"/>
|
||||
</input>
|
||||
<output>
|
||||
<soap:body use="literal"/>
|
||||
</output>
|
||||
</soap:operation>
|
||||
</binding>
|
||||
<service name="testService">
|
||||
<port name="testPort" binding="testBinding">
|
||||
<soap:address location="http://127.0.0.1/testPort" />
|
||||
</port>
|
||||
<port name="testPort2" binding="testBinding2">
|
||||
<soap:address location="http://127.0.0.1/testPort2" />
|
||||
</port>
|
||||
<port name="testPort3" binding="testBinding3">
|
||||
<soap:address location="http://127.0.0.1/testPort3" />
|
||||
</port>
|
||||
|
||||
</service>
|
||||
</definitions>
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
405
t/004_sax_wsdl.t
Normal file
405
t/004_sax_wsdl.t
Normal file
@@ -0,0 +1,405 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 5;
|
||||
use lib '../lib';
|
||||
use XML::SAX::ParserFactory;
|
||||
|
||||
use diagnostics;
|
||||
|
||||
eval {
|
||||
require Test::XML;
|
||||
import Test::XML;
|
||||
};
|
||||
|
||||
use_ok(qw/SOAP::WSDL::SAX::WSDLHandler/);
|
||||
|
||||
my $filter;
|
||||
|
||||
ok($filter = SOAP::WSDL::SAX::WSDLHandler->new(), "Object creation");
|
||||
|
||||
use XML::LibXML;
|
||||
my $parser = XML::LibXML->new();
|
||||
$parser->set_handler( $filter );
|
||||
|
||||
eval { $parser->parse_string( xml() ) };
|
||||
if ($@)
|
||||
{
|
||||
fail("parsing WSDL");
|
||||
die "Can't test without parsed WSDL: $@";
|
||||
}
|
||||
else
|
||||
{
|
||||
pass("parsing XML");
|
||||
}
|
||||
|
||||
my $wsdl;
|
||||
ok( $wsdl = $filter->get_data() , "get object tree");
|
||||
|
||||
my $schema = $wsdl->get_types()->[0]->get_schema()->[0] || die "No schema !";
|
||||
|
||||
my $opt = {
|
||||
typelib => $wsdl->first_types,
|
||||
readable => 1,
|
||||
autotype => 0,
|
||||
namespace => { 'http://www.example.org/MessageGateway2/' => 'tns',
|
||||
'http://www.w3.org/2001/XMLSchema' => 'xsd',
|
||||
'http://schemas.xmlsoap.org/wsdl/' => 'wsdl',
|
||||
},
|
||||
indent => "",
|
||||
};
|
||||
|
||||
my $data = { EnqueueMessage => {
|
||||
MMessage => {
|
||||
MRecipientURI => 'anyURI',
|
||||
MSenderAddress => 'a string',
|
||||
MMessageContent => 'a string',
|
||||
MSubject => 'a string',
|
||||
MDeliveryReportRecipientURI => 'anyURI',
|
||||
MKeepalive => {
|
||||
MKeepaliveTimeout => 1234567,
|
||||
MKeepaliveErrorPolicy => ' ( suppress | report ) ',
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
};
|
||||
|
||||
|
||||
SKIP: { skip_without_test_xml();
|
||||
is_xml( $wsdl->find_message(
|
||||
"http://www.example.org/MessageGateway2/" ,'EnqueueMessageRequest'
|
||||
)->first_part()->serialize( 'test', $data, $opt ),
|
||||
xml_message()
|
||||
, "Serialized message part"
|
||||
);
|
||||
}
|
||||
|
||||
sub skip_without_test_xml {
|
||||
skip("Test::XML not available", 1) if (not $Test::XML::VERSION);
|
||||
}
|
||||
|
||||
sub xml_message {
|
||||
return
|
||||
q{<EnqueueMessage xmlns="http://www.example.org/MessageGateway2/">
|
||||
<MMessage>
|
||||
<MRecipientURI>anyURI</MRecipientURI>
|
||||
<MSenderAddress>a string</MSenderAddress>
|
||||
<MMessageContent>a string</MMessageContent>
|
||||
<MSubject>a string</MSubject>
|
||||
<MDeliveryReportRecipientURI>anyURI</MDeliveryReportRecipientURI>
|
||||
<MKeepalive>
|
||||
<MKeepaliveTimeout>1234567</MKeepaliveTimeout>
|
||||
<MKeepaliveErrorPolicy> ( suppress | report ) </MKeepaliveErrorPolicy>
|
||||
</MKeepalive>
|
||||
</MMessage>
|
||||
</EnqueueMessage>
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
sub xml {
|
||||
return q{<?xml version="1.0" encoding="UTF-8"?>
|
||||
<wsdl:definitions name="MessageGateway"
|
||||
targetNamespace="http://www.example.org/MessageGateway2/"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:tns="http://www.example.org/MessageGateway2/"
|
||||
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/">
|
||||
<wsdl:types>
|
||||
<xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
targetNamespace="http://www.example.org/MessageGateway2/">
|
||||
|
||||
<xsd:element name="EnqueueMessage" type="tns:TEnqueueMessage"
|
||||
xmlns:tns="http://www.example.org/MessageGateway2/">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Enqueue message request element</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
<xsd:complexType name="TMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
A type containing all elements of a message to enqueue.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MRecipientURI" type="xsd:anyURI" minOccurs="1"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
|
||||
<xsd:documentation>
|
||||
The recipient in URI notaitions. Valid URI schemas are: mailto:, sms:,
|
||||
phone:. Not all URI schemas need to be implemented at the current
|
||||
implementation stage.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MSenderAddress" type="xsd:string" minOccurs="0"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
E-Mail sender address. Ignored for all but mailto: recipient URIs.
|
||||
</xsd:documentation>
|
||||
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MMessageContent" type="xsd:string" minOccurs="1"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Message Content.</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MSubject" type="xsd:string" minOccurs="0" maxOccurs="1">
|
||||
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Message Subject. Ignored for all but mailto: URIs
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MDeliveryReportRecipientURI" type="xsd:anyURI" minOccurs="0"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
|
||||
URI to send a delivery report to. May be of one of the following schemes:
|
||||
mailto:, http:, https:. Reports to mailto: URIs are sent as plaintext,
|
||||
reports to http(s) URIs are sent as SOAP requests following the
|
||||
MessageGatewayClient service definition.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MKeepalive" type="tns:TKeepalive" minOccurs="0"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Container for keepalive information. May be missing.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="TKeepalive">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Type containing keeplive information.</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
|
||||
<xsd:element name="MKeepaliveTimeout" type="xsd:double">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Keepalive timeout. The keepalive timeout spezifies how long the sending of
|
||||
a message will be delayed waiting for keepalive updates. If a keepalive
|
||||
update is received during this period, the timeout will be reset. If not,
|
||||
the message will be sent after the timeout has expired.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MKeepaliveErrorPolicy" minOccurs="0" maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
|
||||
<xsd:documentation>
|
||||
Policy to comply to in case of system errors. Valid values are "suppress"
|
||||
and "report". If the policy is set to "suppress", keepalive messages will
|
||||
not be sent to their recipients in case of partial system failure, even if
|
||||
the keepalive has expired. This may result in "false negatives", i.e.
|
||||
messages may not be sent, even though their keepalive has expired. If the
|
||||
value is "report", keepalive messages will be sent from any cluster node.
|
||||
This may result in "false positive" alerts.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:simpleType>
|
||||
<xsd:restriction base="xsd:string">
|
||||
<xsd:enumeration value="suppress"></xsd:enumeration>
|
||||
<xsd:enumeration value="report"></xsd:enumeration>
|
||||
</xsd:restriction>
|
||||
</xsd:simpleType>
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="TMessageID">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Type containing a message ID.</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MMessageID" type="xsd:string" minOccurs="1" maxOccurs="1"></xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="TKeepliveMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Type containing all elements of a keppalive update / remove request.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MMessageID" type="xsd:string" minOccurs="1" maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
The ID for the message to update / remove
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
<xsd:element name="MAction" minOccurs="1" maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
The action to perform. Valid values are: "remove", "update". On "remove",
|
||||
the message with the ID specified will be removed from the queue, thus it
|
||||
will never be sent, even if it's timeout expires. On "update" the
|
||||
keepalive timeout of the corresponding message will be reset.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:simpleType>
|
||||
<xsd:restriction base="xsd:string">
|
||||
<xsd:enumeration value="remove"></xsd:enumeration>
|
||||
<xsd:enumeration value="update"></xsd:enumeration>
|
||||
</xsd:restriction>
|
||||
</xsd:simpleType>
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
<xsd:element name="KeepaliveMessage" type="tns:TKeepaliveMessageRequest">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Keepalive message request element</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="KeepaliveMessageResponse" type="tns:TMessageID">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Response element for a keepalive request</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="EnqueueMessageResponse" type="tns:TMessageID">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Enqueue message response element</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
|
||||
<xsd:complexType name="TEnqueueMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
A complex type containing one element: The message to enqueue.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MMessage" type="tns:TMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Element containing a message to enqueue.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
|
||||
<xsd:complexType name="TKeepaliveMessageRequest">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
A complex type containing one element: The keepalive message to process.
|
||||
</xsd:documentation>
|
||||
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MKeepaliveMessage" type="tns:TKeepliveMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Element containing a keepalive message to process.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
</xsd:schema>
|
||||
</wsdl:types>
|
||||
<wsdl:message name="EnqueueMessageRequest">
|
||||
<wsdl:part name="parameters" element="tns:EnqueueMessage">
|
||||
<wsdl:documentation>inputparameters for EnqueueMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
|
||||
</wsdl:message>
|
||||
<wsdl:message name="EnqueueMessageResponse">
|
||||
<wsdl:part name="parameters" element="tns:EnqueueMessageResponse">
|
||||
<wsdl:documentation>outputparameters for EnqueueMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
</wsdl:message>
|
||||
<wsdl:message name="KeepaliveMessageRequest">
|
||||
<wsdl:part name="parameters" element="tns:KeepaliveMessage">
|
||||
|
||||
<wsdl:documentation>input parameters for KeepaliveMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
</wsdl:message>
|
||||
<wsdl:message name="KeepaliveMessageResponse">
|
||||
<wsdl:part name="parameters" element="tns:KeepaliveMessageResponse">
|
||||
<wsdl:documentation>output parameters for KeepaliveMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
</wsdl:message>
|
||||
|
||||
<wsdl:portType name="MGWPortType">
|
||||
<wsdl:documentation>
|
||||
generic port type for all methods required for sending messages over the mosaic
|
||||
message gatewa
|
||||
</wsdl:documentation>
|
||||
<wsdl:operation name="EnqueueMessage">
|
||||
<wsdl:documentation>
|
||||
This method is used to enqueue a normal (immediate send) or a delayed message with
|
||||
keepalive functionality.
|
||||
</wsdl:documentation>
|
||||
<wsdl:input message="tns:EnqueueMessageRequest"></wsdl:input>
|
||||
<wsdl:output message="tns:EnqueueMessageResponse"></wsdl:output>
|
||||
|
||||
</wsdl:operation>
|
||||
<wsdl:operation name="KeepaliveMessage">
|
||||
<wsdl:documentation>
|
||||
This method is used to update or remove a
|
||||
keepalive message.
|
||||
</wsdl:documentation>
|
||||
<wsdl:input message="tns:KeepaliveMessageRequest"></wsdl:input>
|
||||
<wsdl:output message="tns:KeepaliveMessageResponse"></wsdl:output>
|
||||
</wsdl:operation>
|
||||
</wsdl:portType>
|
||||
|
||||
<wsdl:binding name="MGWBinding" type="tns:MGWPortType">
|
||||
<wsdl:documentation>Generic binding for all (SOAP) port</wsdl:documentation>
|
||||
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http" />
|
||||
<wsdl:operation name="EnqueueMessage">
|
||||
<soap:operation soapAction="http://www.example.org/MessageGateway2/EnqueueMessage" />
|
||||
<wsdl:input>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:input>
|
||||
<wsdl:output>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:output>
|
||||
</wsdl:operation>
|
||||
<wsdl:operation name="KeepaliveMessage">
|
||||
<soap:operation
|
||||
soapAction="http://www.example.org/MessageGateway2/KeepaliveMessage" />
|
||||
<wsdl:input>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:input>
|
||||
|
||||
<wsdl:output>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:output>
|
||||
</wsdl:operation>
|
||||
</wsdl:binding>
|
||||
<wsdl:service name="MessageGateway">
|
||||
<wsdl:documentation>
|
||||
Web Service for sending messages over the mosaic message gatewa
|
||||
</wsdl:documentation>
|
||||
|
||||
<wsdl:port name="HTTPPort" binding="tns:MGWBinding">
|
||||
<wsdl:documentation>HTTP(S) port for the mosaic message gatewa</wsdl:documentation>
|
||||
<soap:address location="https://www.example.org/MessageGateway/" />
|
||||
</wsdl:port>
|
||||
</wsdl:service>
|
||||
</wsdl:definitions>};
|
||||
}
|
||||
255
t/005_sax_contributed_wsdl.t
Normal file
255
t/005_sax_contributed_wsdl.t
Normal file
@@ -0,0 +1,255 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More qw/no_plan/; # TODO: change to tests => N;
|
||||
use Data::Dumper;
|
||||
use lib '../lib';
|
||||
use XML::LibXML;
|
||||
|
||||
use diagnostics;
|
||||
|
||||
use_ok(qw/SOAP::WSDL::SAX::WSDLHandler/);
|
||||
|
||||
my $filter;
|
||||
|
||||
ok($filter = SOAP::WSDL::SAX::WSDLHandler->new(), "Object creation");
|
||||
|
||||
my $parser = XML::LibXML->new();
|
||||
$parser->set_handler( $filter );
|
||||
|
||||
eval { $parser->parse_string( xml() ) };
|
||||
if ($@)
|
||||
{
|
||||
fail("parsing WSDL");
|
||||
die "Can't test without parsed WSDL: $@";
|
||||
}
|
||||
else
|
||||
{
|
||||
pass("parsing XML");
|
||||
}
|
||||
|
||||
my $wsdl;
|
||||
ok( $wsdl = $filter->get_data() , "get object tree");
|
||||
|
||||
my $opt = {
|
||||
namespace => $wsdl->get_xmlns(),
|
||||
style => 'perl',
|
||||
wsdl => $wsdl,
|
||||
readable => 1,
|
||||
};
|
||||
|
||||
my $txt;
|
||||
ok( $txt = $wsdl->explain( $opt ) , "explain WSDL" );
|
||||
|
||||
# print $txt;
|
||||
|
||||
sub xml {
|
||||
return q{<?xml version="1.0" encoding="UTF-8"?>
|
||||
<wsdl:definitions targetNamespace="http://example.com/soap/services/ETest/impl"
|
||||
xmlns="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:apachesoap="http://xml.apache.org/xml-soap"
|
||||
xmlns:impl="http://example.com/soap/services/ETest/impl"
|
||||
xmlns:intf="http://example.com/soap/services/ETest"
|
||||
xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
|
||||
xmlns:tns1="urn:ETest"
|
||||
xmlns:tns2="urn:acquisition"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:wsdlsoap="http://schemas.xmlsoap.org/wsdl/soap/"
|
||||
xmlns:xsd="http://www.w3.org/2001/XMLSchema">
|
||||
|
||||
<wsdl:types>
|
||||
<schema targetNamespace="urn:ETest" xmlns="http://www.w3.org/2001/XMLSchema">
|
||||
<import namespace="http://schemas.xmlsoap.org/soap/encoding/" />
|
||||
<complexType name="CreationBaseData">
|
||||
<sequence>
|
||||
<element name="createdBy" nillable="true" type="xsd:long" />
|
||||
<element name="creationDate" nillable="true" type="xsd:dateTime" />
|
||||
<element name="updateDateCenter" nillable="true" type="xsd:dateTime" />
|
||||
<element name="updateDateLocal" nillable="true" type="xsd:dateTime" />
|
||||
<element name="updatedBy" nillable="true" type="xsd:long" />
|
||||
</sequence>
|
||||
</complexType>
|
||||
<complexType name="CreationData">
|
||||
<complexContent>
|
||||
<extension base="tns1:CreationBaseData">
|
||||
<sequence>
|
||||
<element name="creatorFullName" nillable="true" type="xsd:string" />
|
||||
<element name="modifierFullName" nillable="true" type="xsd:string" />
|
||||
</sequence>
|
||||
</extension>
|
||||
</complexContent>
|
||||
</complexType>
|
||||
<complexType abstract="true" name="EProductData">
|
||||
<sequence>
|
||||
<element name="EStatus" nillable="true" type="xsd:string" />
|
||||
<element name="EStatusUpdatedate" nillable="true" type="xsd:dateTime" />
|
||||
<element name="SFXID" nillable="true" type="xsd:string" />
|
||||
<element name="activationFromDate" nillable="true" type="xsd:dateTime" />
|
||||
<element name="activationToDate" nillable="true" type="xsd:dateTime" />
|
||||
<element name="activityStatusDateFrom" nillable="true" type="xsd:dateTime" />
|
||||
<element name="activityStatusDateTo" nillable="true" type="xsd:dateTime" />
|
||||
<element name="canEditSFXID" type="xsd:boolean" />
|
||||
<element name="concurrentNumberOfUsers" nillable="true" type="xsd:int" />
|
||||
<element name="creationData" nillable="true" type="tns1:CreationData" />
|
||||
<element name="deleteable" type="xsd:boolean" />
|
||||
<element name="ETestCode" nillable="true" type="xsd:string" />
|
||||
<element name="id" nillable="true" type="xsd:long" />
|
||||
<element name="instanceCode" nillable="true" type="xsd:string" />
|
||||
<element name="mainContact" nillable="true" type="xsd:string" />
|
||||
<element name="metaLibID" nillable="true" type="xsd:string" />
|
||||
<element name="otherID" nillable="true" type="xsd:string" />
|
||||
<element name="otherSource" nillable="true" type="xsd:string" />
|
||||
<element name="privateNote" nillable="true" type="xsd:string" />
|
||||
<element name="procurementStatus" nillable="true" type="xsd:string" />
|
||||
<element name="procurementStatusUpdateDate" nillable="true" type="xsd:dateTime" />
|
||||
<element name="procurementStatusUpdatedate" nillable="true" type="xsd:dateTime" />
|
||||
<element name="sourceInstanceCode" nillable="true" type="xsd:string" />
|
||||
<element name="sponseringLibraryCode" nillable="true" type="xsd:string" />
|
||||
<element name="sponseringLibraryName" nillable="true" type="xsd:string" />
|
||||
<element name="updateTarget" nillable="true" type="xsd:string" />
|
||||
<element name="workExpressionCode" nillable="true" type="xsd:string" />
|
||||
</sequence>
|
||||
</complexType>
|
||||
<complexType name="EProductInformation">
|
||||
<sequence>
|
||||
<element name="acquisitions" nillable="true"
|
||||
type="impl:ArrayOf_tns2_AcquisitionData" />
|
||||
<element name="data" nillable="true" type="tns1:EProductData" />
|
||||
</sequence>
|
||||
</complexType>
|
||||
</schema>
|
||||
<schema targetNamespace="urn:acquisition" xmlns="http://www.w3.org/2001/XMLSchema">
|
||||
<import namespace="http://schemas.xmlsoap.org/soap/encoding/" />
|
||||
<complexType name="AcquisitionCommonData">
|
||||
<sequence>
|
||||
<element name="budgets" nillable="true" type="xsd:string" />
|
||||
<element name="campusCode" nillable="true" type="xsd:string" />
|
||||
<element name="concurrentUsersNote" nillable="true" type="xsd:string" />
|
||||
<element name="creationData" nillable="true" type="tns1:CreationData" />
|
||||
<element name="id" nillable="true" type="xsd:long" />
|
||||
<element name="instituteCode" nillable="true" type="xsd:string" />
|
||||
</sequence>
|
||||
</complexType>
|
||||
<complexType name="AcquisitionData">
|
||||
<sequence>
|
||||
<element name="ILSSubscriptionNo" nillable="true" type="xsd:string" />
|
||||
<element name="acquisitionCode" nillable="true" type="xsd:string" />
|
||||
<element name="acquisitionCommonData" nillable="true"
|
||||
type="tns2:AcquisitionCommonData" />
|
||||
<element name="acquisitionMethod" nillable="true" type="xsd:string" />
|
||||
<element name="acquisitionNumber" nillable="true" type="xsd:string" />
|
||||
<element name="acquisitionStatus" nillable="true" type="xsd:string" />
|
||||
<element name="acquisitionStatusDate" nillable="true" type="xsd:dateTime" />
|
||||
<element name="advanceNoticeDate" nillable="true" type="xsd:dateTime" />
|
||||
<element name="autoRenewal" nillable="true" type="xsd:boolean" />
|
||||
<element name="consortialAgreement" type="xsd:boolean" />
|
||||
<element name="discountOnPrice" nillable="true" type="xsd:int" />
|
||||
<element name="id" nillable="true" type="xsd:long" />
|
||||
<element name="instanceCode" nillable="true" type="xsd:string" />
|
||||
<element name="materialType" nillable="true" type="xsd:string" />
|
||||
<element name="noteForILS" nillable="true" type="xsd:string" />
|
||||
<element name="noteForVendor" nillable="true" type="xsd:string" />
|
||||
<element name="noticePeriodCode" nillable="true" type="xsd:string" />
|
||||
<element name="numberOfCopies" nillable="true" type="xsd:int" />
|
||||
<element name="orderDate" nillable="true" type="xsd:dateTime" />
|
||||
<element name="orderForm" nillable="true" type="xsd:string" />
|
||||
<element name="orderSendMethod" nillable="true" type="xsd:string" />
|
||||
<element name="pooledConcurrentUsers" nillable="true" type="xsd:int" />
|
||||
<element name="price" nillable="true" type="xsd:double" />
|
||||
<element name="pricingCap" nillable="true" type="xsd:int" />
|
||||
<element name="pricingCapFrom" nillable="true" type="xsd:dateTime" />
|
||||
<element name="pricingCapTo" nillable="true" type="xsd:dateTime" />
|
||||
<element name="pricingModel" nillable="true" type="xsd:string" />
|
||||
<element name="printCancellationNote" nillable="true" type="xsd:string" />
|
||||
<element name="printCancellationRestriction" type="xsd:boolean" />
|
||||
<element name="printPurchaseOrderNo" nillable="true" type="xsd:string" />
|
||||
<element name="purchaseOrderNo" nillable="true" type="xsd:string" />
|
||||
<element name="renewallOrCancellationDate" nillable="true" type="xsd:dateTime" />
|
||||
<element name="renewallOrCancellationDescisionNote" nillable="true"
|
||||
type="xsd:string" />
|
||||
<element name="renewallOrCancellationNoteForILS" nillable="true"
|
||||
type="xsd:string" />
|
||||
<element name="renewallOrCancellationNoteForVendor" nillable="true"
|
||||
type="xsd:string" />
|
||||
<element name="subscriptionNotification" nillable="true" type="xsd:int" />
|
||||
<element name="subscriptionPeriodCode" nillable="true" type="xsd:string" />
|
||||
<element name="subscriptionType" nillable="true" type="xsd:string" />
|
||||
<element name="subscriptionTypeNote" nillable="true" type="xsd:string" />
|
||||
<element name="vendorAdvancedNotice" nillable="true" type="xsd:int" />
|
||||
<element name="vendorAdvancedNoticeVal" nillable="true" type="xsd:string" />
|
||||
<element name="vendorCode" nillable="true" type="xsd:string" />
|
||||
<element name="vendorName" nillable="true" type="xsd:string" />
|
||||
<element name="vendorSubscriptionCode" nillable="true" type="xsd:string" />
|
||||
</sequence>
|
||||
</complexType>
|
||||
</schema>
|
||||
<schema targetNamespace="http://example.com/soap/services/ETest/impl"
|
||||
xmlns="http://www.w3.org/2001/XMLSchema">
|
||||
<import namespace="http://schemas.xmlsoap.org/soap/encoding/" />
|
||||
<complexType name="ArrayOf_tns2_AcquisitionData">
|
||||
<complexContent>
|
||||
<restriction base="soapenc:Array">
|
||||
<attribute ref="soapenc:arrayType" wsdl:arrayType="tns2:AcquisitionData[]" />
|
||||
</restriction>
|
||||
</complexContent>
|
||||
</complexType>
|
||||
</schema>
|
||||
</wsdl:types>
|
||||
<wsdl:message name="getETestResponse">
|
||||
<wsdl:part name="getETestReturn" type="tns1:EProductInformation" />
|
||||
</wsdl:message>
|
||||
<wsdl:message name="getFixedETestResponse">
|
||||
<wsdl:part name="getFixedETestReturn" type="tns1:EProductInformation" />
|
||||
</wsdl:message>
|
||||
<wsdl:message name="getFixedETestRequest"></wsdl:message>
|
||||
<wsdl:message name="getETestRequest">
|
||||
<wsdl:part name="indexName" type="xsd:string" />
|
||||
<wsdl:part name="indexValue" type="xsd:string" />
|
||||
<wsdl:part name="withStatus" type="xsd:string" />
|
||||
</wsdl:message>
|
||||
<wsdl:portType name="ETestWeb">
|
||||
<wsdl:operation name="getETest" parameterOrder="indexName indexValue withStatus">
|
||||
<wsdl:input message="impl:getETestRequest" name="getETestRequest" />
|
||||
<wsdl:output message="impl:getETestResponse" name="getETestResponse" />
|
||||
</wsdl:operation>
|
||||
<wsdl:operation name="getFixedETest">
|
||||
<wsdl:input message="impl:getFixedETestRequest" name="getFixedETestRequest" />
|
||||
<wsdl:output message="impl:getFixedETestResponse"
|
||||
name="getFixedETestResponse" />
|
||||
</wsdl:operation>
|
||||
</wsdl:portType>
|
||||
|
||||
<wsdl:binding name="ETestSoapBinding" type="impl:ETestWeb">
|
||||
<wsdlsoap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http" />
|
||||
<wsdl:operation name="getETest">
|
||||
<wsdlsoap:operation soapAction="" />
|
||||
<wsdl:input name="getETestRequest">
|
||||
<wsdlsoap:body encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
|
||||
namespace="http://example.com/soap/services/ETest" use="encoded" />
|
||||
</wsdl:input>
|
||||
<wsdl:output name="getETestResponse">
|
||||
<wsdlsoap:body encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
|
||||
namespace="http://example.com/soap/services/ETest" use="encoded" />
|
||||
</wsdl:output>
|
||||
</wsdl:operation>
|
||||
<wsdl:operation name="getFixedETest">
|
||||
<wsdlsoap:operation soapAction="" />
|
||||
<wsdl:input name="getFixedETestRequest">
|
||||
<wsdlsoap:body encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
|
||||
namespace="http://example.com/soap/services/ETest" use="encoded" />
|
||||
</wsdl:input>
|
||||
<wsdl:output name="getFixedETestResponse">
|
||||
<wsdlsoap:body encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
|
||||
namespace="http://example.com/soap/services/ETest" use="encoded" />
|
||||
</wsdl:output>
|
||||
</wsdl:operation>
|
||||
</wsdl:binding>
|
||||
|
||||
<wsdl:service name="ETestWebService">
|
||||
<wsdl:port binding="impl:ETestSoapBinding" name="ETest">
|
||||
<wsdlsoap:address location="http://example.com/soap/services/ETest" />
|
||||
</wsdl:port>
|
||||
</wsdl:service>
|
||||
</wsdl:definitions>
|
||||
};
|
||||
}
|
||||
69
t/006_client.t
Normal file
69
t/006_client.t
Normal file
@@ -0,0 +1,69 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Pod::Simple::Text;
|
||||
use Test::More qw/no_plan/; # TODO: change to tests => N;
|
||||
use lib '../lib';
|
||||
use XML::SAX::ParserFactory;
|
||||
|
||||
eval {
|
||||
require Test::XML;
|
||||
import Test::XML
|
||||
};
|
||||
|
||||
use diagnostics;
|
||||
|
||||
use Cwd;
|
||||
|
||||
my $path = cwd;
|
||||
$path =~s|\/t\/?$||; # allow running from t/ and above (Build test)
|
||||
|
||||
use_ok(qw/SOAP::WSDL/);
|
||||
|
||||
my $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file:///' . $path .'/t/acceptance/wsdl/006_sax_client.wsdl',
|
||||
readable => 1,
|
||||
)->wsdlinit();
|
||||
|
||||
$soap->servicename('MessageGateway');
|
||||
|
||||
ok( $soap->no_dispatch( 1 ) , "Set no_dispatch" );
|
||||
ok( $soap->explain() );
|
||||
|
||||
|
||||
my $pod = Pod::Simple::Text->new();
|
||||
my $output;
|
||||
$pod->output_string( \$output );
|
||||
$pod->parse_string_document( $soap->explain() );
|
||||
|
||||
# print $output;
|
||||
|
||||
SKIP: {
|
||||
skip_without_test_xml();
|
||||
is_xml( $soap->call( 'EnqueueMessage' , EnqueueMessage => {
|
||||
'MMessage' => {
|
||||
'MRecipientURI' => 'mailto:test@example.com' ,
|
||||
'MMessageContent' => 'TestContent for Message' ,
|
||||
}
|
||||
}
|
||||
)
|
||||
, q{<SOAP-ENV:Envelope
|
||||
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:tns="http://www.example.org/MessageGateway2/"
|
||||
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
|
||||
<SOAP-ENV:Body ><EnqueueMessage xmlns="http://www.example.org/MessageGateway2/"><MMessage>
|
||||
<MRecipientURI>mailto:test@example.com</MRecipientURI>
|
||||
<MMessageContent>TestContent for Message</MMessageContent>
|
||||
</MMessage></EnqueueMessage></SOAP-ENV:Body></SOAP-ENV:Envelope>}
|
||||
, "content comparison with optional elements");
|
||||
}
|
||||
|
||||
sub skip_without_test_xml {
|
||||
my $number = shift || 1;
|
||||
skip("Test::XML not available", $number) if (not $Test::XML::VERSION);
|
||||
}
|
||||
|
||||
__END__
|
||||
|
||||
36
t/007_envelope.t
Normal file
36
t/007_envelope.t
Normal file
@@ -0,0 +1,36 @@
|
||||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More qw/no_plan/;
|
||||
use lib '../lib';
|
||||
|
||||
eval {
|
||||
require Test::XML;
|
||||
import Test::XML;
|
||||
};
|
||||
|
||||
use_ok qw/SOAP::WSDL::Envelope/;
|
||||
|
||||
my $opt = {
|
||||
readable => 1,
|
||||
namespace => {
|
||||
},
|
||||
};
|
||||
my $xml;
|
||||
ok( $xml = SOAP::WSDL::Envelope->serialize(
|
||||
undef, undef, $opt
|
||||
),
|
||||
"serialize empty envelope"
|
||||
);
|
||||
|
||||
SKIP: {
|
||||
skip 'Cannot test XML content without Test::XML', 1
|
||||
if (not $Test::XML::VERSION);
|
||||
is_xml( $xml, q{<SOAP-ENV:Envelope
|
||||
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
|
||||
<SOAP-ENV:Body >
|
||||
</SOAP-ENV:Body>
|
||||
</SOAP-ENV:Envelope>}
|
||||
, 'Content comparison' );
|
||||
}
|
||||
30
t/008_client_wsdl_complexType.t
Normal file
30
t/008_client_wsdl_complexType.t
Normal file
@@ -0,0 +1,30 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More qw/no_plan/; # TODO: change to tests => N;
|
||||
use lib '../lib';
|
||||
|
||||
use Cwd;
|
||||
|
||||
my $path = cwd;
|
||||
$path =~s|\/t\/?$||; # allow running from t/ and above (Build test)
|
||||
|
||||
use_ok(qw/SOAP::WSDL/);
|
||||
|
||||
my $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file:///' . $path .'/t/acceptance/wsdl/008_complexType.wsdl'
|
||||
)->wsdlinit();
|
||||
|
||||
my $wsdl = $soap->{ _WSDL }->{ wsdl_definitions };
|
||||
my $schema = $wsdl->first_types();
|
||||
my $type = $schema->find_type('Test' , 'testComplexTypeAll');
|
||||
my $element = $type->get_element()->[0];
|
||||
|
||||
is $element->get_minOccurs() , 0, "minOccurs default for all";
|
||||
is $element->get_maxOccurs() , 1, "maxOccurs default for all";
|
||||
|
||||
$type = $schema->find_type('Test' , 'testComplexTypeSequence');
|
||||
$element = $type->get_element()->[0];
|
||||
|
||||
is $element->get_minOccurs() , 1, "minOccurs default for sequence";
|
||||
is $element->get_maxOccurs() , 1, "maxOccurs default for sequence";
|
||||
97
t/009_data_classes.t
Normal file
97
t/009_data_classes.t
Normal file
@@ -0,0 +1,97 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use Test::More tests => 5;
|
||||
use lib 't/lib';
|
||||
use lib '../lib';
|
||||
use lib 'lib';
|
||||
use Benchmark;
|
||||
use XML::Simple;
|
||||
use SOAP::WSDL::SAX::WSDLHandler;
|
||||
use Cwd;
|
||||
use XML::LibXML::SAX;
|
||||
use_ok(qw/SOAP::WSDL::SAX::MessageHandler/);
|
||||
|
||||
use SOAP::WSDL;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
my $path = cwd;
|
||||
$path =~s|\/t\/?$||; # allow running from t/ and above (Build test)
|
||||
|
||||
$XML::Simple::PREFERRED_PARSER = 'XML::Parser';
|
||||
|
||||
my $filter;
|
||||
ok($filter = SOAP::WSDL::SAX::MessageHandler->new( {
|
||||
class_resolver => FakeResolver->new(),
|
||||
} ), "Object creation");
|
||||
|
||||
my $parser = XML::LibXML->new();
|
||||
$parser->set_handler( $filter );
|
||||
|
||||
$parser->parse_string( xml() );
|
||||
|
||||
# print $filter->get_data();
|
||||
# print $filter->get_data()->get_MMessage()->_DUMP();
|
||||
|
||||
if($filter->get_data()->get_MMessage()->get_MDeliveryReportRecipientURI()) {
|
||||
pass "bool context overloading";
|
||||
}
|
||||
else
|
||||
{
|
||||
fail "bool context overloading"
|
||||
}
|
||||
|
||||
my $soap = SOAP::WSDL->new(
|
||||
readable => 1,
|
||||
wsdl => 'file:///' . $path .'/t/acceptance/wsdl/006_sax_client.wsdl',
|
||||
)->wsdlinit();
|
||||
|
||||
$soap->servicename('MessageGateway');
|
||||
|
||||
ok( $soap->no_dispatch( 1 ) , "Set no_dispatch" );
|
||||
ok( $soap->readable( 0 ) , "Set readable");
|
||||
|
||||
timethese 100, {
|
||||
'ClassParser' => sub { $parser->parse_string( xml() ); },
|
||||
'XML::Simple' => sub { return XMLin( xml() ) },
|
||||
};
|
||||
|
||||
sub xml {
|
||||
q{<SOAP-ENV:Envelope
|
||||
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:tns="http://www.example.org/MessageGateway2/"
|
||||
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
|
||||
<SOAP-ENV:Body ><EnqueueMessage><MMessage>
|
||||
<MRecipientURI>mailto:test@example.com</MRecipientURI>
|
||||
<MMessageContent>TestContent for Message</MMessageContent>
|
||||
<MMessageContent>TestContent for Message 2</MMessageContent>
|
||||
<MSenderAddress>martin.kutter@example.com</MSenderAddress>
|
||||
<MDeliveryReportRecipientURI>mailto:test@example.com</MDeliveryReportRecipientURI>
|
||||
</MMessage></EnqueueMessage></SOAP-ENV:Body></SOAP-ENV:Envelope>};
|
||||
}
|
||||
|
||||
# data classes reside in t/lib/Typelib/
|
||||
BEGIN {
|
||||
package FakeResolver;
|
||||
{
|
||||
my %class_list = (
|
||||
'EnqueueMessage' => 'Typelib::TEnqueueMessage',
|
||||
'EnqueueMessage/MMessage' => 'Typelib::TMessage',
|
||||
'EnqueueMessage/MMessage/MRecipientURI' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||
'EnqueueMessage/MMessage/MMessageContent' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'EnqueueMessage/MMessage/MSenderAddress' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'EnqueueMessage/MMessage/MMessageContent' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'EnqueueMessage/MMessage/MDeliveryReportRecipientURI' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||
);
|
||||
|
||||
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";
|
||||
};
|
||||
};
|
||||
|
||||
|
||||
};
|
||||
36
t/011_simpleType.t
Normal file
36
t/011_simpleType.t
Normal file
@@ -0,0 +1,36 @@
|
||||
#!/usr/bin/perl
|
||||
use Test::More qw(no_plan);
|
||||
use strict;
|
||||
use lib 'lib/';
|
||||
use lib 't/lib/';
|
||||
use lib '../lib/';
|
||||
|
||||
use_ok qw(MySimpleType);
|
||||
|
||||
# simple type derived from builtin via restriction
|
||||
my $obj = MySimpleType->new({ value => 'test'});
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
|
||||
, 'inherited class';
|
||||
is $obj, 'test', 'stringification';
|
||||
|
||||
# simple type derived from builtin via list
|
||||
$obj = MySimpleListType->new({ value => [ 'test', 'test2' ]});
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
|
||||
, 'inherited class';
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::list')
|
||||
, 'inherited class';
|
||||
is $obj, 'test test2', 'stringification';
|
||||
|
||||
# simple type derived from atomic simple type (restriction)
|
||||
$obj = MyAtomicSimpleType->new({ value => 'test' });
|
||||
ok $obj->isa('MySimpleType') , 'inherited class';
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::SimpleType::restriction')
|
||||
, 'inherited class';
|
||||
is $obj, 'test', 'stringification';
|
||||
|
||||
# simple type derived from atomic simple type (list)
|
||||
$obj = MyAtomicSimpleListType->new({ value => [ 'test', 'test2' ] });
|
||||
ok $obj->isa('MySimpleListType') , 'inherited class';
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::SimpleType::restriction')
|
||||
, 'inherited class';
|
||||
is $obj, 'test test2', 'stringification';
|
||||
65
t/012_element.t
Normal file
65
t/012_element.t
Normal file
@@ -0,0 +1,65 @@
|
||||
#!/usr/bin/perl
|
||||
use Test::More qw(no_plan);
|
||||
use strict;
|
||||
use lib 'lib/';
|
||||
use lib '../lib/';
|
||||
use lib 't/lib';
|
||||
|
||||
use_ok qw(SOAP::WSDL::XSD::Typelib::Element);
|
||||
use_ok qw( MyElement );
|
||||
# simple type derived from builtin via restriction
|
||||
my $obj = MyElement->new({ value => 'test'});
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
|
||||
, 'inherited class';
|
||||
is $obj, '<MyElementName xmlns="urn:Test" >test</MyElementName>', 'stringification';
|
||||
|
||||
$obj = MyAtomicComplexTypeElement->new({ test=> 'Test', test2 => 'Test2'});
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType')
|
||||
, 'inherited class';
|
||||
|
||||
ok $obj->get_test->isa('SOAP::WSDL::XSD::Typelib::Builtin::string')
|
||||
, 'element isa';
|
||||
|
||||
is $obj, '<MyAtomicComplexTypeElement xmlns="urn:Test" ><MyTestElement >Test</MyTestElement>'
|
||||
. '<MyTestElement2 >Test2</MyTestElement2></MyAtomicComplexTypeElement>'
|
||||
, 'stringification';
|
||||
|
||||
$obj = MyElement->new({ value => undef});
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
|
||||
, 'inherited class';
|
||||
|
||||
# is $obj, '<MyElementName xmlns="urn:Test" xsi:nil="true" />', 'nillable stringification';
|
||||
|
||||
$obj = MyAtomicComplexTypeElement->new({ test=> 'Test', test2 => [ 'Test2', 'Test3' ]});
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType')
|
||||
, 'inherited class';
|
||||
is $obj, '<MyAtomicComplexTypeElement xmlns="urn:Test" ><MyTestElement >Test</MyTestElement>'
|
||||
. '<MyTestElement2 >Test2</MyTestElement2>'
|
||||
. '<MyTestElement2 >Test3</MyTestElement2>'
|
||||
. '</MyAtomicComplexTypeElement>'
|
||||
, 'multi value stringification';
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
# simple type derived from builtin via list
|
||||
$obj = MySimpleListType->new({ value => [ 'test', 'test2' ]});
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
|
||||
, 'inherited class';
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::list')
|
||||
, 'inherited class';
|
||||
is $obj, 'test test2', 'stringification';
|
||||
|
||||
# simple type derived from atomic simple type (restriction)
|
||||
$obj = MyAtomicSimpleType->new({ value => 'test' });
|
||||
ok $obj->isa('MySimpleType') , 'inherited class';
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::SimpleType::restriction')
|
||||
, 'inherited class';
|
||||
is $obj, 'test', 'stringification';
|
||||
|
||||
# simple type derived from atomic simple type (list)
|
||||
$obj = MyAtomicSimpleListType->new({ value => [ 'test', 'test2' ] });
|
||||
ok $obj->isa('MySimpleListType') , 'inherited class';
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::SimpleType::restriction')
|
||||
, 'inherited class';
|
||||
is $obj, 'test test2', 'stringification';
|
||||
44
t/013_complexType.t
Normal file
44
t/013_complexType.t
Normal file
@@ -0,0 +1,44 @@
|
||||
#!/usr/bin/perl
|
||||
use Test::More qw(no_plan);
|
||||
use strict;
|
||||
use lib 'lib/';
|
||||
use lib '../lib/';
|
||||
use lib 't/lib';
|
||||
|
||||
use_ok qw(SOAP::WSDL::XSD::Typelib::ComplexType);
|
||||
use_ok qw( MyComplexType );
|
||||
# simple type derived from builtin via restriction
|
||||
my $obj = MyComplexType->new({ MyTestName => 'test' });
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType')
|
||||
, 'inherited class';
|
||||
is $obj, '<MyElementName >test</MyElementName>', 'stringification';
|
||||
|
||||
$obj = MyComplexType->new({ MyTestName => [ 'test', 'test2' ] });
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType')
|
||||
, 'inherited class';
|
||||
is $obj, '<MyElementName >test</MyElementName><MyElementName >test2</MyElementName>',
|
||||
'stringification';
|
||||
|
||||
# try on the fly factory
|
||||
@MyComplexType2::ISA = ('SOAP::WSDL::XSD::Typelib::ComplexType');
|
||||
{
|
||||
use Class::Std::Storable;
|
||||
my %MyTestName_of;
|
||||
|
||||
MyComplexType2->_factory(
|
||||
[ qw(MyTestName) ], # order
|
||||
{ MyTestName => \%MyTestName_of }, # attribute lookup map
|
||||
{ MyTestName => 'MyElement' } # class name lookup map
|
||||
);
|
||||
}
|
||||
|
||||
$obj = MyComplexType2->new({ MyTestName => [ 'test', 'test2' ] });
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType')
|
||||
, 'inherited class (on the fly-factory object)';
|
||||
is $obj, '<MyElementName >test</MyElementName><MyElementName >test2</MyElementName>',
|
||||
'stringification (on the fly-factory object)';
|
||||
# print Dumper $obj->get_MyTestName();
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
362
t/014_sax_typelib.t
Normal file
362
t/014_sax_typelib.t
Normal file
@@ -0,0 +1,362 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 5;
|
||||
use lib '../lib';
|
||||
use XML::SAX::ParserFactory;
|
||||
|
||||
use diagnostics;
|
||||
|
||||
eval {
|
||||
require Test::XML;
|
||||
import Test::XML;
|
||||
};
|
||||
|
||||
use_ok(qw/SOAP::WSDL::SAX::WSDLHandler/);
|
||||
|
||||
my $filter;
|
||||
|
||||
ok($filter = SOAP::WSDL::SAX::WSDLHandler->new(), "Object creation");
|
||||
|
||||
use XML::LibXML;
|
||||
my $parser = XML::LibXML->new();
|
||||
$parser->set_handler( $filter );
|
||||
|
||||
eval { $parser->parse_string( xml() ) };
|
||||
if ($@)
|
||||
{
|
||||
fail("parsing WSDL");
|
||||
die "Can't test without parsed WSDL: $@";
|
||||
}
|
||||
else
|
||||
{
|
||||
pass("parsing XML");
|
||||
}
|
||||
|
||||
my $wsdl;
|
||||
ok( $wsdl = $filter->get_data() , "get object tree");
|
||||
|
||||
for my $element (@{ $wsdl->first_types()->get_schema()->[1]->get_type() } ) {
|
||||
# print Dumper $element;
|
||||
my $output;
|
||||
$element->toClass({ prefix => 'MessageGateway', wsdl => $wsdl,
|
||||
output => \$output
|
||||
});
|
||||
eval "$output";
|
||||
}
|
||||
|
||||
if ($@) {
|
||||
fail "evalling generated class";
|
||||
}
|
||||
else
|
||||
{
|
||||
pass "evalling generated class";
|
||||
}
|
||||
|
||||
exit;
|
||||
|
||||
sub xml {
|
||||
return q{<?xml version="1.0" encoding="UTF-8"?>
|
||||
<wsdl:definitions name="MessageGateway"
|
||||
targetNamespace="http://www.example.org/MessageGateway2/"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:tns="http://www.example.org/MessageGateway2/"
|
||||
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/">
|
||||
<wsdl:types>
|
||||
<xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
xmlns:tns="http://www.example.org/MessageGateway2/"
|
||||
targetNamespace="http://www.example.org/MessageGateway2/">
|
||||
|
||||
<xsd:element name="EnqueueMessage" type="tns:TEnqueueMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Enqueue message request element</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
<xsd:complexType name="TMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
A type containing all elements of a message to enqueue.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MRecipientURI" type="xsd:anyURI" minOccurs="1"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
|
||||
<xsd:documentation>
|
||||
The recipient in URI notaitions. Valid URI schemas are: mailto:, sms:,
|
||||
phone:. Not all URI schemas need to be implemented at the current
|
||||
implementation stage.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MSenderAddress" type="xsd:string" minOccurs="0"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
E-Mail sender address. Ignored for all but mailto: recipient URIs.
|
||||
</xsd:documentation>
|
||||
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MMessageContent" type="xsd:string" minOccurs="1"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Message Content.</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MSubject" type="xsd:string" minOccurs="0" maxOccurs="1">
|
||||
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Message Subject. Ignored for all but mailto: URIs
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MDeliveryReportRecipientURI" type="xsd:anyURI" minOccurs="0"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
|
||||
URI to send a delivery report to. May be of one of the following schemes:
|
||||
mailto:, http:, https:. Reports to mailto: URIs are sent as plaintext,
|
||||
reports to http(s) URIs are sent as SOAP requests following the
|
||||
MessageGatewayClient service definition.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MKeepalive" type="tns:TKeepalive" minOccurs="0"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Container for keepalive information. May be missing.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="TKeepalive">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Type containing keeplive information.</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
|
||||
<xsd:element name="MKeepaliveTimeout" type="xsd:double">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Keepalive timeout. The keepalive timeout spezifies how long the sending of
|
||||
a message will be delayed waiting for keepalive updates. If a keepalive
|
||||
update is received during this period, the timeout will be reset. If not,
|
||||
the message will be sent after the timeout has expired.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MKeepaliveErrorPolicy" minOccurs="0" maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
|
||||
<xsd:documentation>
|
||||
Policy to comply to in case of system errors. Valid values are "suppress"
|
||||
and "report". If the policy is set to "suppress", keepalive messages will
|
||||
not be sent to their recipients in case of partial system failure, even if
|
||||
the keepalive has expired. This may result in "false negatives", i.e.
|
||||
messages may not be sent, even though their keepalive has expired. If the
|
||||
value is "report", keepalive messages will be sent from any cluster node.
|
||||
This may result in "false positive" alerts.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:simpleType>
|
||||
<xsd:restriction base="xsd:string">
|
||||
<xsd:enumeration value="suppress"></xsd:enumeration>
|
||||
<xsd:enumeration value="report"></xsd:enumeration>
|
||||
</xsd:restriction>
|
||||
</xsd:simpleType>
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="TMessageID">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Type containing a message ID.</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MMessageID" type="xsd:string" minOccurs="1" maxOccurs="1"></xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="TKeepliveMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Type containing all elements of a keppalive update / remove request.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MMessageID" type="xsd:string" minOccurs="1" maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
The ID for the message to update / remove
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
<xsd:element name="MAction" minOccurs="1" maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
The action to perform. Valid values are: "remove", "update". On "remove",
|
||||
the message with the ID specified will be removed from the queue, thus it
|
||||
will never be sent, even if it's timeout expires. On "update" the
|
||||
keepalive timeout of the corresponding message will be reset.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:simpleType>
|
||||
<xsd:restriction base="xsd:string">
|
||||
<xsd:enumeration value="remove"></xsd:enumeration>
|
||||
<xsd:enumeration value="update"></xsd:enumeration>
|
||||
</xsd:restriction>
|
||||
</xsd:simpleType>
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
<xsd:element name="KeepaliveMessage" type="tns:TKeepaliveMessageRequest">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Keepalive message request element</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="KeepaliveMessageResponse" type="tns:TMessageID">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Response element for a keepalive request</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="EnqueueMessageResponse" type="tns:TMessageID">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Enqueue message response element</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
|
||||
<xsd:complexType name="TEnqueueMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
A complex type containing one element: The message to enqueue.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MMessage" type="tns:TMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Element containing a message to enqueue.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
|
||||
<xsd:complexType name="TKeepaliveMessageRequest">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
A complex type containing one element: The keepalive message to process.
|
||||
</xsd:documentation>
|
||||
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MKeepaliveMessage" type="tns:TKeepliveMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Element containing a keepalive message to process.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
</xsd:schema>
|
||||
</wsdl:types>
|
||||
<wsdl:message name="EnqueueMessageRequest">
|
||||
<wsdl:part name="parameters" element="tns:EnqueueMessage">
|
||||
<wsdl:documentation>inputparameters for EnqueueMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
|
||||
</wsdl:message>
|
||||
<wsdl:message name="EnqueueMessageResponse">
|
||||
<wsdl:part name="parameters" element="tns:EnqueueMessageResponse">
|
||||
<wsdl:documentation>outputparameters for EnqueueMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
</wsdl:message>
|
||||
<wsdl:message name="KeepaliveMessageRequest">
|
||||
<wsdl:part name="parameters" element="tns:KeepaliveMessage">
|
||||
|
||||
<wsdl:documentation>input parameters for KeepaliveMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
</wsdl:message>
|
||||
<wsdl:message name="KeepaliveMessageResponse">
|
||||
<wsdl:part name="parameters" element="tns:KeepaliveMessageResponse">
|
||||
<wsdl:documentation>output parameters for KeepaliveMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
</wsdl:message>
|
||||
|
||||
<wsdl:portType name="MGWPortType">
|
||||
<wsdl:documentation>
|
||||
generic port type for all methods required for sending messages over the mosaic
|
||||
message gatewa
|
||||
</wsdl:documentation>
|
||||
<wsdl:operation name="EnqueueMessage">
|
||||
<wsdl:documentation>
|
||||
This method is used to enqueue a normal (immediate send) or a delayed message with
|
||||
keepalive functionality.
|
||||
</wsdl:documentation>
|
||||
<wsdl:input message="tns:EnqueueMessageRequest"></wsdl:input>
|
||||
<wsdl:output message="tns:EnqueueMessageResponse"></wsdl:output>
|
||||
|
||||
</wsdl:operation>
|
||||
<wsdl:operation name="KeepaliveMessage">
|
||||
<wsdl:documentation>
|
||||
This method is used to update or remove a
|
||||
keepalive message.
|
||||
</wsdl:documentation>
|
||||
<wsdl:input message="tns:KeepaliveMessageRequest"></wsdl:input>
|
||||
<wsdl:output message="tns:KeepaliveMessageResponse"></wsdl:output>
|
||||
</wsdl:operation>
|
||||
</wsdl:portType>
|
||||
|
||||
<wsdl:binding name="MGWBinding" type="tns:MGWPortType">
|
||||
<wsdl:documentation>Generic binding for all (SOAP) port</wsdl:documentation>
|
||||
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http" />
|
||||
<wsdl:operation name="EnqueueMessage">
|
||||
<soap:operation soapAction="http://www.example.org/MessageGateway2/EnqueueMessage" />
|
||||
<wsdl:input>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:input>
|
||||
<wsdl:output>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:output>
|
||||
</wsdl:operation>
|
||||
<wsdl:operation name="KeepaliveMessage">
|
||||
<soap:operation
|
||||
soapAction="http://www.example.org/MessageGateway2/KeepaliveMessage" />
|
||||
<wsdl:input>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:input>
|
||||
|
||||
<wsdl:output>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:output>
|
||||
</wsdl:operation>
|
||||
</wsdl:binding>
|
||||
<wsdl:service name="MessageGateway">
|
||||
<wsdl:documentation>
|
||||
Web Service for sending messages over the mosaic message gatewa
|
||||
</wsdl:documentation>
|
||||
|
||||
<wsdl:port name="HTTPPort" binding="tns:MGWBinding">
|
||||
<wsdl:documentation>HTTP(S) port for the mosaic message gatewa</wsdl:documentation>
|
||||
<soap:address location="https://www.example.org/MessageGateway/" />
|
||||
</wsdl:port>
|
||||
</wsdl:service>
|
||||
</wsdl:definitions>};
|
||||
}
|
||||
346
t/015_to_typemap.t
Normal file
346
t/015_to_typemap.t
Normal file
@@ -0,0 +1,346 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 5;
|
||||
use lib '../lib';
|
||||
use XML::SAX::ParserFactory;
|
||||
|
||||
use diagnostics;
|
||||
|
||||
eval {
|
||||
require Test::XML;
|
||||
import Test::XML;
|
||||
};
|
||||
|
||||
use_ok(qw/SOAP::WSDL::SAX::WSDLHandler/);
|
||||
|
||||
my $filter;
|
||||
|
||||
ok($filter = SOAP::WSDL::SAX::WSDLHandler->new(), "Object creation");
|
||||
|
||||
use XML::LibXML;
|
||||
my $parser = XML::LibXML->new();
|
||||
$parser->set_handler( $filter );
|
||||
|
||||
eval { $parser->parse_string( xml() ) };
|
||||
if ($@)
|
||||
{
|
||||
fail("parsing WSDL");
|
||||
die "Can't test without parsed WSDL: $@";
|
||||
}
|
||||
else
|
||||
{
|
||||
pass("parsing XML");
|
||||
}
|
||||
|
||||
my $wsdl;
|
||||
ok( $wsdl = $filter->get_data() , "get object tree");
|
||||
|
||||
ok $wsdl->to_typemap( { prefix => 'CP::EAI::Typelib::' } ), 'typemap';
|
||||
exit;
|
||||
|
||||
sub xml {
|
||||
return q{<?xml version="1.0" encoding="UTF-8"?>
|
||||
<wsdl:definitions name="MessageGateway"
|
||||
targetNamespace="http://www.example.org/MessageGateway2/"
|
||||
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
|
||||
xmlns:tns="http://www.example.org/MessageGateway2/"
|
||||
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/">
|
||||
<wsdl:types>
|
||||
<xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema"
|
||||
xmlns:tns="http://www.example.org/MessageGateway2/"
|
||||
targetNamespace="http://www.example.org/MessageGateway2/">
|
||||
|
||||
<xsd:element name="EnqueueMessage" type="tns:TEnqueueMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Enqueue message request element</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
<xsd:complexType name="TMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
A type containing all elements of a message to enqueue.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MRecipientURI" type="xsd:anyURI" minOccurs="1"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
|
||||
<xsd:documentation>
|
||||
The recipient in URI notaitions. Valid URI schemas are: mailto:, sms:,
|
||||
phone:. Not all URI schemas need to be implemented at the current
|
||||
implementation stage.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MSenderAddress" type="xsd:string" minOccurs="0"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
E-Mail sender address. Ignored for all but mailto: recipient URIs.
|
||||
</xsd:documentation>
|
||||
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MMessageContent" type="xsd:string" minOccurs="1"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Message Content.</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MSubject" type="xsd:string" minOccurs="0" maxOccurs="1">
|
||||
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Message Subject. Ignored for all but mailto: URIs
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MDeliveryReportRecipientURI" type="xsd:anyURI" minOccurs="0"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
|
||||
URI to send a delivery report to. May be of one of the following schemes:
|
||||
mailto:, http:, https:. Reports to mailto: URIs are sent as plaintext,
|
||||
reports to http(s) URIs are sent as SOAP requests following the
|
||||
MessageGatewayClient service definition.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MKeepalive" type="tns:TKeepalive" minOccurs="0"
|
||||
maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Container for keepalive information. May be missing.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="TKeepalive">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Type containing keeplive information.</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
|
||||
<xsd:element name="MKeepaliveTimeout" type="xsd:double">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Keepalive timeout. The keepalive timeout spezifies how long the sending of
|
||||
a message will be delayed waiting for keepalive updates. If a keepalive
|
||||
update is received during this period, the timeout will be reset. If not,
|
||||
the message will be sent after the timeout has expired.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="MKeepaliveErrorPolicy" minOccurs="0" maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
|
||||
<xsd:documentation>
|
||||
Policy to comply to in case of system errors. Valid values are "suppress"
|
||||
and "report". If the policy is set to "suppress", keepalive messages will
|
||||
not be sent to their recipients in case of partial system failure, even if
|
||||
the keepalive has expired. This may result in "false negatives", i.e.
|
||||
messages may not be sent, even though their keepalive has expired. If the
|
||||
value is "report", keepalive messages will be sent from any cluster node.
|
||||
This may result in "false positive" alerts.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:simpleType>
|
||||
<xsd:restriction base="xsd:string">
|
||||
<xsd:enumeration value="suppress"></xsd:enumeration>
|
||||
<xsd:enumeration value="report"></xsd:enumeration>
|
||||
</xsd:restriction>
|
||||
</xsd:simpleType>
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="TMessageID">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Type containing a message ID.</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MMessageID" type="xsd:string" minOccurs="1" maxOccurs="1"></xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
<xsd:complexType name="TKeepliveMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Type containing all elements of a keppalive update / remove request.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MMessageID" type="xsd:string" minOccurs="1" maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
The ID for the message to update / remove
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
<xsd:element name="MAction" minOccurs="1" maxOccurs="1">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
The action to perform. Valid values are: "remove", "update". On "remove",
|
||||
the message with the ID specified will be removed from the queue, thus it
|
||||
will never be sent, even if it's timeout expires. On "update" the
|
||||
keepalive timeout of the corresponding message will be reset.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:simpleType>
|
||||
<xsd:restriction base="xsd:string">
|
||||
<xsd:enumeration value="remove"></xsd:enumeration>
|
||||
<xsd:enumeration value="update"></xsd:enumeration>
|
||||
</xsd:restriction>
|
||||
</xsd:simpleType>
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
<xsd:element name="KeepaliveMessage" type="tns:TKeepaliveMessageRequest">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Keepalive message request element</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="KeepaliveMessageResponse" type="tns:TMessageID">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Response element for a keepalive request</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
<xsd:element name="EnqueueMessageResponse" type="tns:TMessageID">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>Enqueue message response element</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
|
||||
<xsd:complexType name="TEnqueueMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
A complex type containing one element: The message to enqueue.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MMessage" type="tns:TMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Element containing a message to enqueue.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
|
||||
</xsd:element>
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
|
||||
|
||||
<xsd:complexType name="TKeepaliveMessageRequest">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
A complex type containing one element: The keepalive message to process.
|
||||
</xsd:documentation>
|
||||
|
||||
</xsd:annotation>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="MKeepaliveMessage" type="tns:TKeepliveMessage">
|
||||
<xsd:annotation>
|
||||
<xsd:documentation>
|
||||
Element containing a keepalive message to process.
|
||||
</xsd:documentation>
|
||||
</xsd:annotation>
|
||||
</xsd:element>
|
||||
|
||||
</xsd:sequence>
|
||||
</xsd:complexType>
|
||||
</xsd:schema>
|
||||
</wsdl:types>
|
||||
<wsdl:message name="EnqueueMessageRequest">
|
||||
<wsdl:part name="parameters" element="tns:EnqueueMessage">
|
||||
<wsdl:documentation>inputparameters for EnqueueMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
|
||||
</wsdl:message>
|
||||
<wsdl:message name="EnqueueMessageResponse">
|
||||
<wsdl:part name="parameters" element="tns:EnqueueMessageResponse">
|
||||
<wsdl:documentation>outputparameters for EnqueueMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
</wsdl:message>
|
||||
<wsdl:message name="KeepaliveMessageRequest">
|
||||
<wsdl:part name="parameters" element="tns:KeepaliveMessage">
|
||||
|
||||
<wsdl:documentation>input parameters for KeepaliveMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
</wsdl:message>
|
||||
<wsdl:message name="KeepaliveMessageResponse">
|
||||
<wsdl:part name="parameters" element="tns:KeepaliveMessageResponse">
|
||||
<wsdl:documentation>output parameters for KeepaliveMessag</wsdl:documentation>
|
||||
</wsdl:part>
|
||||
</wsdl:message>
|
||||
|
||||
<wsdl:portType name="MGWPortType">
|
||||
<wsdl:documentation>
|
||||
generic port type for all methods required for sending messages over the mosaic
|
||||
message gatewa
|
||||
</wsdl:documentation>
|
||||
<wsdl:operation name="EnqueueMessage">
|
||||
<wsdl:documentation>
|
||||
This method is used to enqueue a normal (immediate send) or a delayed message with
|
||||
keepalive functionality.
|
||||
</wsdl:documentation>
|
||||
<wsdl:input message="tns:EnqueueMessageRequest"></wsdl:input>
|
||||
<wsdl:output message="tns:EnqueueMessageResponse"></wsdl:output>
|
||||
|
||||
</wsdl:operation>
|
||||
<wsdl:operation name="KeepaliveMessage">
|
||||
<wsdl:documentation>
|
||||
This method is used to update or remove a
|
||||
keepalive message.
|
||||
</wsdl:documentation>
|
||||
<wsdl:input message="tns:KeepaliveMessageRequest"></wsdl:input>
|
||||
<wsdl:output message="tns:KeepaliveMessageResponse"></wsdl:output>
|
||||
</wsdl:operation>
|
||||
</wsdl:portType>
|
||||
|
||||
<wsdl:binding name="MGWBinding" type="tns:MGWPortType">
|
||||
<wsdl:documentation>Generic binding for all (SOAP) port</wsdl:documentation>
|
||||
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http" />
|
||||
<wsdl:operation name="EnqueueMessage">
|
||||
<soap:operation soapAction="http://www.example.org/MessageGateway2/EnqueueMessage" />
|
||||
<wsdl:input>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:input>
|
||||
<wsdl:output>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:output>
|
||||
</wsdl:operation>
|
||||
<wsdl:operation name="KeepaliveMessage">
|
||||
<soap:operation
|
||||
soapAction="http://www.example.org/MessageGateway2/KeepaliveMessage" />
|
||||
<wsdl:input>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:input>
|
||||
|
||||
<wsdl:output>
|
||||
<soap:body use="literal" />
|
||||
</wsdl:output>
|
||||
</wsdl:operation>
|
||||
</wsdl:binding>
|
||||
<wsdl:service name="MessageGateway">
|
||||
<wsdl:documentation>
|
||||
Web Service for sending messages over the mosaic message gatewa
|
||||
</wsdl:documentation>
|
||||
|
||||
<wsdl:port name="HTTPPort" binding="tns:MGWBinding">
|
||||
<wsdl:documentation>HTTP(S) port for the mosaic message gatewa</wsdl:documentation>
|
||||
<soap:address location="https://www.example.org/MessageGateway/" />
|
||||
</wsdl:port>
|
||||
</wsdl:service>
|
||||
</wsdl:definitions>};
|
||||
}
|
||||
60
t/016_client_object.t
Normal file
60
t/016_client_object.t
Normal file
@@ -0,0 +1,60 @@
|
||||
#!/usr/bin/perl
|
||||
use Test::More tests => 9;
|
||||
use strict;
|
||||
use diagnostics;
|
||||
use lib 'lib/';
|
||||
use lib '../lib/';
|
||||
use lib 't/lib';
|
||||
|
||||
use_ok qw(SOAP::WSDL::XSD::Typelib::Element);
|
||||
use_ok qw( MyElement );
|
||||
use_ok qw( SOAP::WSDL::Client );
|
||||
# simple type derived from builtin via restriction
|
||||
|
||||
my $obj = MyAtomicComplexTypeElement->new({ test=> 'Test', test2 => 'Test2'});
|
||||
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType')
|
||||
, 'inherited class';
|
||||
|
||||
# print $obj->get_test;
|
||||
|
||||
ok $obj->get_test->isa('SOAP::WSDL::XSD::Typelib::Builtin::string')
|
||||
, 'element isa';
|
||||
|
||||
is $obj, '<MyAtomicComplexTypeElement xmlns="urn:Test" ><MyTestElement >Test</MyTestElement>'
|
||||
. '<MyTestElement2 >Test2</MyTestElement2></MyAtomicComplexTypeElement>'
|
||||
, 'stringification';
|
||||
|
||||
my $soap = SOAP::WSDL::Client->new( {
|
||||
class_resolver => 'FakeResolver',
|
||||
} )
|
||||
->proxy('http://bla')
|
||||
->no_dispatch(1);
|
||||
|
||||
is $soap->call('Test', $obj), q{<SOAP-ENV:Envelope }
|
||||
. q{xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" }
|
||||
. q{xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >}
|
||||
. q{<SOAP-ENV:Body><MyAtomicComplexTypeElement xmlns="urn:Test" >}
|
||||
. q{<MyTestElement >Test</MyTestElement>}
|
||||
. q{<MyTestElement2 >Test2</MyTestElement2>}
|
||||
. q{</MyAtomicComplexTypeElement></SOAP-ENV:Body></SOAP-ENV:Envelope>}
|
||||
, 'SOAP Envelope generation with objects';
|
||||
|
||||
my $result = $soap->proxy('http://bla')
|
||||
->no_dispatch(0)
|
||||
->call('Test', $obj);
|
||||
ok $result->isa('SOAP::WSDL::SOAP::Typelib::Fault11'),
|
||||
'return fault on impossible call';
|
||||
ok ! $result, 'fault is false in boolean context';
|
||||
|
||||
package FakeResolver;
|
||||
|
||||
sub get_class {
|
||||
my %class_list = (
|
||||
'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11',
|
||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyType',
|
||||
);
|
||||
}
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user