From 21b5330a8d23d63208fdd73fb0c81bf2b14c304d Mon Sep 17 00:00:00 2001 From: Martin Kutter Date: Tue, 3 Jul 2007 23:52:14 -0800 Subject: [PATCH] import SOAP-WSDL 2.00_03 from CPAN git-cpan-module: SOAP-WSDL git-cpan-version: 2.00_03 git-cpan-authorid: MKUTTER git-cpan-file: authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_03.tar.gz --- Build.PL | 9 +- MANIFEST | 48 + META.yml | 101 +- lib/SOAP/WSDL.pm | 2109 +++++------------ lib/SOAP/WSDL/Binding.pm | 3 +- lib/SOAP/WSDL/Client.pm | 523 ++-- lib/SOAP/WSDL/Part.pm | 48 +- lib/SOAP/WSDL/SAX/MessageHandler.pm | 40 +- lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm | 2 +- lib/SOAP/WSDL/XSD/ComplexType.pm | 99 +- lib/SOAP/WSDL/XSD/Element.pm | 38 +- lib/SOAP/WSDL/XSD/Primitive.pm | 6 +- lib/SOAP/WSDL/XSD/SimpleType.pm | 95 +- lib/SOAP/WSDL/XSD/Typelib/Builtin.pm | 419 +--- lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm | 27 + lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm | 26 + lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm | 26 + lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm | 32 + lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm | 26 + lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm | 26 + lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm | 33 + lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm | 45 + lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm | 26 + lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm | 45 + .../WSDL/XSD/Typelib/Builtin/anySimpleType.pm | 64 + lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm | 45 + lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm | 48 + .../WSDL/XSD/Typelib/Builtin/base64Binary.pm | 35 + lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm | 67 + lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm | 33 + lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm | 36 + lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm | 37 + lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm | 43 + lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm | 55 + lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm | 36 + lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm | 41 + lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm | 36 + lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm | 36 + .../WSDL/XSD/Typelib/Builtin/gMonthDay.pm | 36 + lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm | 36 + .../WSDL/XSD/Typelib/Builtin/gYearMonth.pm | 34 + .../WSDL/XSD/Typelib/Builtin/hexBinary.pm | 33 + lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm | 31 + lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm | 30 + lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm | 26 + lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm | 41 + lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm | 31 + .../XSD/Typelib/Builtin/negativeInteger.pm | 30 + .../XSD/Typelib/Builtin/nonNegativeInteger.pm | 30 + .../XSD/Typelib/Builtin/nonPositiveInteger.pm | 30 + .../XSD/Typelib/Builtin/normalizedString.pm | 26 + .../XSD/Typelib/Builtin/positiveInteger.pm | 31 + lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm | 31 + lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm | 33 + lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm | 34 + lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm | 26 + .../WSDL/XSD/Typelib/Builtin/unsignedByte.pm | 31 + .../WSDL/XSD/Typelib/Builtin/unsignedInt.pm | 32 + .../WSDL/XSD/Typelib/Builtin/unsignedLong.pm | 31 + .../WSDL/XSD/Typelib/Builtin/unsignedShort.pm | 31 + lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm | 90 +- lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm | 6 +- t/002_sax.t | 5 +- t/003_sax_serializer.t | 18 +- t/004_sax_wsdl.t | 24 +- t/005_sax_contributed_wsdl.t | 2 - t/006_client.t | 19 +- t/008_client_wsdl_complexType.t | 5 +- t/009_data_classes.t | 26 +- t/013_complexType.t | 1 - t/014_sax_typelib.t | 6 +- t/015_to_typemap.t | 6 +- t/016_client_object.t | 37 +- t/020_storable.t | 9 + t/098_pod.t | 27 + t/acceptance/wsdl/02_port.wsdl | 53 +- t/acceptance/wsdl/03_complexType-all.wsdl | 44 +- .../wsdl/03_complexType-sequence.wsdl | 21 +- t/acceptance/wsdl/04_element-simpleType.wsdl | 18 +- t/acceptance/wsdl/04_element.wsdl | 18 +- t/acceptance/wsdl/05_simpleType-list.wsdl | 18 +- .../wsdl/05_simpleType-restriction.wsdl | 18 +- t/acceptance/wsdl/05_simpleType-union.wsdl | 26 +- t/attic/02_port.t | 81 +- t/attic/03_complexType-all.t | 56 +- t/attic/03_complexType-choice.t | 37 +- t/attic/03_complexType-complexContent.t | 37 +- t/attic/03_complexType-group.t | 37 +- t/attic/03_complexType-sequence.t | 16 +- t/attic/03_complexType-simpleContent.t | 37 +- t/attic/04_element-complexType.t | 5 +- t/attic/04_element-simpleType.t | 98 +- t/attic/04_element.t | 82 +- t/attic/05_simpleType-list.t | 89 +- t/attic/05_simpleType-restriction.t | 96 +- t/attic/05_simpleType-union.t | 33 +- t/attic/11_helloworld.NET.t | 23 +- t/lib/MyElement.pm | 5 +- 98 files changed, 3231 insertions(+), 3156 deletions(-) create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm create mode 100644 lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm create mode 100644 t/020_storable.t create mode 100644 t/098_pod.t diff --git a/Build.PL b/Build.PL index 9ea9380..b60301e 100644 --- a/Build.PL +++ b/Build.PL @@ -2,7 +2,7 @@ use Module::Build; Module::Build->new( dist_abstract => 'SOAP with WSDL support', dist_name => 'SOAP-WSDL', - dist_version => '2.00_02', + dist_version => '2.00_03', module_name => 'SOAP::WSDL', license => 'artistic', requires => { @@ -14,7 +14,9 @@ Module::Build->new( 'XML::SAX::Base' => 0, 'XML::SAX::ParserFactory' => 0, }, - buildrequires => { + buildrequires => { + 'Benchmark' => 0, + 'Cwd' => 0, 'Test::More' => 0, 'SOAP::Lite' => 0, 'Class::Std' => 0.0.8, @@ -24,5 +26,8 @@ Module::Build->new( 'XML::LibXML' => 0, 'XML::SAX::Base' => 0, 'XML::SAX::ParserFactory' => 0, + 'Pod::Simple::Text' => 0, + 'XML::SAX::ParserFactory' => 0, + }, )->create_build_script; diff --git a/MANIFEST b/MANIFEST index 3fa5955..352ae4a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -28,6 +28,52 @@ 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 @@ -50,6 +96,8 @@ 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 diff --git a/META.yml b/META.yml index a9ad4c8..f12a03b 100644 --- a/META.yml +++ b/META.yml @@ -1,8 +1,7 @@ --- name: SOAP-WSDL -version: 2.00_02 +version: 2.00_03 author: - - "Replace the whitespace in the e-mail adresses by '@'." abstract: SOAP with WSDL support license: artistic requires: @@ -20,7 +19,7 @@ meta-spec: provides: SOAP::WSDL: file: lib/SOAP/WSDL.pm - version: 1.21 + version: 2.00_03 SOAP::WSDL::Base: file: lib/SOAP/WSDL/Base.pm SOAP::WSDL::Binding: @@ -75,97 +74,97 @@ provides: 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.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm SOAP::WSDL::XSD::Typelib::Builtin::ID: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm SOAP::WSDL::XSD::Typelib::Builtin::IDREF: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm SOAP::WSDL::XSD::Typelib::Builtin::IDREFS: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm SOAP::WSDL::XSD::Typelib::Builtin::NCName: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm SOAP::WSDL::XSD::Typelib::Builtin::NMTOKENS: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm SOAP::WSDL::XSD::Typelib::Builtin::NOTATION: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm SOAP::WSDL::XSD::Typelib::Builtin::Name: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + 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.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm SOAP::WSDL::XSD::Typelib::Builtin::anyType: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm SOAP::WSDL::XSD::Typelib::Builtin::anyURI: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm SOAP::WSDL::XSD::Typelib::Builtin::base64Binary: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm SOAP::WSDL::XSD::Typelib::Builtin::boolean: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm SOAP::WSDL::XSD::Typelib::Builtin::byte: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm SOAP::WSDL::XSD::Typelib::Builtin::date: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm SOAP::WSDL::XSD::Typelib::Builtin::dateTime: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm SOAP::WSDL::XSD::Typelib::Builtin::decimal: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm SOAP::WSDL::XSD::Typelib::Builtin::double: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm SOAP::WSDL::XSD::Typelib::Builtin::duration: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm SOAP::WSDL::XSD::Typelib::Builtin::float: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm SOAP::WSDL::XSD::Typelib::Builtin::gDay: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm SOAP::WSDL::XSD::Typelib::Builtin::gMonth: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm SOAP::WSDL::XSD::Typelib::Builtin::gYear: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm - SOAP::WSDL::XSD::Typelib::Builtin::hex64Binary: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + 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.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm SOAP::WSDL::XSD::Typelib::Builtin::integer: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm SOAP::WSDL::XSD::Typelib::Builtin::language: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm SOAP::WSDL::XSD::Typelib::Builtin::list: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm SOAP::WSDL::XSD::Typelib::Builtin::long: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm SOAP::WSDL::XSD::Typelib::Builtin::negativeInteger: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm SOAP::WSDL::XSD::Typelib::Builtin::normalizedString: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm - SOAP::WSDL::XSD::Typelib::Builtin::qName: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm SOAP::WSDL::XSD::Typelib::Builtin::short: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm SOAP::WSDL::XSD::Typelib::Builtin::string: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm SOAP::WSDL::XSD::Typelib::Builtin::time: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm SOAP::WSDL::XSD::Typelib::Builtin::token: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort: - file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm + 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: diff --git a/lib/SOAP/WSDL.pm b/lib/SOAP/WSDL.pm index 4c6894b..9b0dc00 100644 --- a/lib/SOAP/WSDL.pm +++ b/lib/SOAP/WSDL.pm @@ -1,1560 +1,575 @@ -#!/usr/bin/perl -w -package SOAP::WSDL; - -use SOAP::Lite; -use vars qw($VERSION @ISA); -use XML::XPath; - -use strict; -use warnings; - -use Data::Dumper; - -@ISA = qw(SOAP::Lite); - -$VERSION = "1.21"; - -sub wsdlinit -{ - my $self = shift; - my %opt = @_; - $self->{ _WSDL }->{ cache } = {}; - $self->{ _WSDL }->{ caching } = $opt{ caching }; - $self->{ _WSDL }->{ cache_directory } = $opt{ cache_directory } - if exists( $opt{ cache_directory } ); - $self->wsdl_checkoccurs( $opt{ checkoccurs } ) - if ( exists( $opt{ checkoccurs } ) ); - - if ( ( $self->{ _WSDL }->{ caching } ) - && ( !$self->{ _WSDL }->{ fileCache } ) ) - { - $self->wsdl_cache_init(); - } - - #makeup xpath document - my $xpath; - - # check cache - if ( $self->{ _WSDL }->{ fileCache } ) - { - - # get xpath from cache - $xpath = $self->{ _WSDL }->{ fileCache }->get( $self->wsdl ); - - # get in-memory cache from cache - if ( $self->{ _WSDL }->{ caching } ) - { - my $cache = - $self->{ _WSDL }->{ fileCache }->get( $self->wsdl . "_cache" ); - $self->{ _WSDL }->{ cache } = $cache || {}; - } ## end if ( $self->{ _WSDL }->... - } ## end if ( $self->{ _WSDL }->... - unless ( $xpath ) - { - $xpath = - XML::XPath->new( - xml => SOAP::Schema->new( schema_url => $self->wsdl )->access ); - } ## end unless ( $xpath ) - - ( $xpath ) - || die "Error processing WSDL: Cannot create XPath object"; - - $self->_wsdl_xpath( $xpath ); - - # Get root element () and get - # default prefix (the root element's one). - my $definitions = undef; - $definitions = $xpath->find( '/*[1]' )->shift; - - my $prefix = $definitions->getPrefix; - $self->_wsdl_wsdlns( $prefix ? $prefix . ':' : '' ); - - # get the targetNamespace - my $tns = $definitions->getAttribute( 'targetNamespace' ) - || die - "Error processing WSDL: cannot get "; - - # look for schema namespace & prefix for targetNamespace - my ( $defaultNS, $schemaNS ) = ( '', '' ); - my @_ns_sub_list = (); - - my $nameSpaces = $definitions->getNamespaces - || die "Error processing WSDL: cannot get namespaces"; - my $nsHash = {}; - foreach my $ns ( @{ $nameSpaces } ) - { - $xpath->set_namespace( $ns->getPrefix, $ns->getData ); - if ( $ns->getData eq $tns ) - { - push @_ns_sub_list, $ns->getPrefix; - next; - } - - #------------------------------------------------------- - # Here we look for the default wsdl namespace which is used *only* - # when we are looking for the arrays restrictions. - # Originally the prefix was used for this, but sometimes the prefix - # can be omitted - #------------------------------------------------------- - $ns->getPrefix eq "#default" and next; - if ( $ns->getData eq "http://schemas.xmlsoap.org/wsdl/" ) - { - $self->_wsdl_wsdlExplicitNS( - $ns->getPrefix ? $ns->getPrefix . ":" : "" ); - } - - # the schema namespace is hardcoded in to the SOAP::Constants package, - # in the Lite.pm module - if ( defined $SOAP::Constants::XML_SCHEMAS{ $ns->getData } - and $SOAP::Constants::XML_SCHEMAS{ $ns->getData } =~ - /SOAP::XMLSchema\d+/ ) - { - $schemaNS = $ns->getPrefix; - } ## end if ( defined $SOAP::Constants::XML_SCHEMAS... - $nsHash->{ $ns->getData } = $ns->getPrefix . ':'; - } ## end foreach my $ns ( @{ $nameSpaces... - - $self->_wsdl_ns( $nsHash ); - $defaultNS = join( '|', @_ns_sub_list ); - - $self->_wsdl_tns( $defaultNS ); - $self->_wsdl_tns_uri( $tns ); - $self->_wsdl_schemans( $schemaNS ); - - #--- - #-- TBD: remove all the hardcoded urls - $self->_wsdl_soapns( - $self->_wsdl_ns->{ 'http://schemas.xmlsoap.org/wsdl/soap/' } ); - - #the default namespaces for types - $self->{ _WSDL }->{ _type_ns } = ""; - $self->_wsdl_schemans - and $self->{ _WSDL }->{ _type_ns } .= $self->_wsdl_schemans . ":|"; - - #TBD: the apache soap special case has to be handled elsewhere - $nsHash->{ 'http://xml.apache.org/xml-soap' } - and $self->{ _WSDL }->{ _type_ns } .= - $nsHash->{ 'http://xml.apache.org/xml-soap' } . "|"; - chop $self->{ _WSDL }->{ _type_ns }; - - # resolve portname and servicename from url if given... - if ( $opt{ 'url' } ) - { - $self->_resolveURL( $opt{ 'url' } ); - } - - # TODO make _get_first_port conditional... - $self->_get_first_port(); - - $self->servicename( $opt{ servicename } ) if ( $opt{ servicename } ); - $self->portname( $opt{ portname } ) if ( $opt{ portname } ); - - # return something useful to ease testing... - return $self; -} ## end sub wsdlinit - -sub _get_first_port -{ - my $self = shift; - my $url = shift; - my $xpath = $self->_wsdl_xpath(); - - my $path = - '/definitions/service' . '/port/' . $self->_wsdl_soapns . 'address'; - - my @ports = $xpath->findnodes( $path ); - - if ( @ports ) - { - my $address = shift @ports; - my $port = $address->getParentNode(); - my $service = $port->getParentNode(); - $self->servicename( $service->getAttribute( 'name' ) ); - $self->portname( $port->getAttribute( 'name' ) ); - } ## end if ( @ports ) - else - { - die "No port definition found"; - } - -} ## end sub _get_first_port - -sub _resolve_url -{ - my $self = shift; - my $url = shift; - my $xpath = $self->_wsdl_xpath(); - - my $path; - if ( $url ) - { - $path = - '/definitions/service' . '/port/' - . $self->_wsdl_soapns - . 'address[@location="' - . $url . '"]'; - } ## end if ( $url ) - else - { - $path = $path = - '/definitions/service' . '/port/' . $self->_wsdl_soapns . 'address'; - } - - my @ports = $xpath->findnodes( $path ); - - if ( @ports ) - { - my $address = shift @ports; - my $port = $address->getParentNode(); - my $service = $port->getParentNode(); - $self->servicename( $service->getAttribute( 'name' ) ); - $self->portname( $port->getAttribute( 'name' ) ); - } ## end if ( @ports ) - else - { - die "No port definition found for URL $url"; - } -} ## end sub _resolve_url - -sub call -{ - my $self = shift; - my $method = shift; - my %data = @_; - - my $path; - my $location; - my $mode = 'input'; - - my $tns = $self->_wsdl_tns; - my $ns = $self->_wsdl_ns; - - my $xpath = $self->_wsdl_xpath; - - ( $xpath ) || do - { - $self->wsdlinit; - $xpath = $self->_wsdl_xpath - || die "Error processing WSDL: no wsdl object"; - }; - - my $portType = ""; - my $binding = ""; - - my $portName = ""; - - $portName = $self->portname(); - $portName or die "Error processing the call: no port found"; - - # TODO factor out and call from wsdlinit - ### from here - - #look for the binding - $path = join( - $self->_wsdl_wsdlns, - ( - "/", "definitions/", - "service[\@name='" . ( $self->servicename ) . "']/", - "port[\@name='" . $portName . "']" - ) - ); - - my $port = $xpath->find( $path )->shift - || die "Error processing WSDL file - no such port ($path)"; - - $binding = $port->findvalue( '@binding' ) - || die - "Error processing WSDL: Cannot find the binding for the service $path"; - - #look for the location - $path .= "/" . $self->_wsdl_soapns . "address"; - - my $address = $xpath->find( $path )->shift - || die "Error processing WSDL file - no such address ($path)"; - - $location = $address->findvalue( '@location' )->value - || die -"Error processing WSDL: Cannot find the port for the location in service $path"; - $self->proxy( $location ); - - # remove the default targetNamespace from messageName - $binding =~ s/^($tns)\:*//; - $binding =~ s/^($tns)\:*//; - - $path = join( - $self->_wsdl_wsdlns, - ( '/', 'definitions/', "binding[\@name='$binding']/\@type" ) - ); - - $portType = $self->_wsdl_findvalue( $path, "dieIfError" ); - $portType =~ s/^(.*?)\://; - - #Now we need to find the operation, in the binding. - #After that we can extract the SoapAction and the - #input name, if defined - - $path = join( - $self->_wsdl_wsdlns, - ( - '/', 'definitions/', "binding[\@name='$binding']/", - "operation[\@name='$method']/", $mode - ) - ); - - #overload: the user has provided a the input name for us - $data{ "wsdl_${mode}_name" } - and $path .= "[\@name='" . $data{ "wsdl_${mode}_name" } . "']"; - - #now we can get the soapaction - my $soapActionPath = - "$path/../" . $self->_wsdl_soapns . "operation/\@soapAction"; - my $soapAction = $self->_wsdl_findvalue( $soapActionPath, "" ); - $soapAction and $self->on_action( sub { sprintf "$soapAction" } ); - - #if defined, the input message name has to be the leading item - #in the SOAP call. If not defined, it has to be the operation - #name. In the case of overloaded calls, it *IS* the parameter passed - #by the calling script. So - my $inputMessageName; - if ( $data{ "wsdl_${mode}_name" } ) - { - $inputMessageName = $data{ "wsdl_${mode}_name" }; - } - else - { - $inputMessageName = $self->_wsdl_findvalue( "$path/\@name", "" ); - } - $inputMessageName or $inputMessageName = $method; - - $path = join( - $self->_wsdl_wsdlns, - ( - '/', 'definitions/', - "binding[\@name='$binding']/", "operation[\@name='$method']/", - "$mode/" - ) - ) - . $self->_wsdl_soapns . "body/"; - - #a call can have an associated, namespace - my $callNamespace = $self->_wsdl_findvalue( "$path\@namespace", "" ); - $callNamespace or $callNamespace = $self->_wsdl_tns_uri; - - #the encoding style is required when handling restricted complextypes - my $encodingStyle = ""; - $encodingStyle = $self->_wsdl_findvalue( "$path\@encodingStyle", "" ); - $encodingStyle - and $self->wsdl_encoding( $self->_wsdl_ns->{ $encodingStyle } ); - - $path = join( - $self->_wsdl_wsdlns, - ( - '/', 'definitions/', - "portType[\@name='$portType']/", - "operation[\@name='$method']/", $mode - ) - ); - - #overload: the calling script has to say wich overloading - #procedure call has to be encoded and forwarded to the server - $data{ "wsdl_${mode}_name" } - and $path .= "[\@name='" . $data{ "wsdl_${mode}_name" } . "']"; - - $path .= "/\@message"; - my $messageName = $self->_wsdl_findvalue( $path, "dieIfError" ); - - $messageName =~ s/^($tns)\:*//; - - $path = join( - $self->_wsdl_wsdlns, - ( '/', 'definitions/', "message[\@name='$messageName']/", 'part' ) - ); - - #An operation without parts is equivalent to a procedure call without parameters - my $parts = $self->_wsdl_find( $path ); - - ### TODO factor out: to here - - my @param = (); - while ( my $part = $parts->shift ) - { - my @enc = $self->encode( $part, \%data ); - push @param, @enc if ( @enc ); - } - - my $methodEncoded = - SOAP::Data->name( $inputMessageName ) - ->attr( { "xmlns" => $callNamespace } ); - unless ( $self->{ _WSDL }->{ no_dispatch } ) - { - return $self->SUPER::call( - $methodEncoded => @param, - @{ $data{ soap_headers } } - ); - } ## end unless ( $self->{ _WSDL }->... - else - { - return $methodEncoded, @param; - } -} ## end sub call - -sub DESTROY -{ - my $self = shift; - $self->wsdl_cache_store(); - return 1; +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_03'; + +BEGIN { + eval { + use XML::LibXML; + }; + if ($@) { + use XML::SAX::ParserFactory; + } +} + +sub AUTOLOAD { + my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2); + die "$method not found"; } -#a sort of autoload for the store-and-return methods -sub _load_method -{ - my $method = shift; - my $param = shift; - no strict "refs"; - *$method = sub { - my $self = shift; - return ( @_ ) ? $self->{ _WSDL }->{ $param } = shift - : $self->{ _WSDL }->{ $param } ? $self->{ _WSDL }->{ $param } - : ""; - }; -} ## end sub _load_method - -&_load_method( "no_dispatch", "no_dispatch" ); -&_load_method( "wsdl", "wsdl" ); -&_load_method( "wsdl_checkoccurs", "checkoccurs" ); -&_load_method( "servicename", "servicename" ); -&_load_method( "portname", "portname" ); -&_load_method( "wsdl_cache_directory", "cache_directory" ); -&_load_method( "wsdl_encoding", "wsdl_encoding" ); -&_load_method( "_wsdl_ns", "namespaces" ); -&_load_method( "_wsdl_xpath", "xpath" ); -&_load_method( "_wsdl_tns", "tns" ); -&_load_method( "_wsdl_tns_uri", "tns_uri" ); -&_load_method( "_wsdl_wsdlns", "wsdlns" ); -&_load_method( "_wsdl_schemans", "schemans" ); -&_load_method( "_wsdl_soapns", "soapns" ); -&_load_method( "_wsdl_wsdlExplicitNS", "wsdl_wsdlExplicitNS" ); - -#each call to make finder returns a wrapped version of the xpath calls. -#find, findvalue, findnodes and so on -#the cache checking part is hidden here -sub _make_finder() -{ - my ( $method, $call ) = @_; - no strict "refs"; - *$method = sub { - my $self = shift; - my ( $path, $dieIfError ) = @_; - my $data = ""; - - $data = $self->{ _WSDL }->{ cache }->{ $path }; - unless ( $data ) - { - $data = $self->_wsdl_xpath->$call( $path ); - $self->{ _WSDL }->{ cache }->{ $path } = $data - if ( $self->{ _WSDL }->{ caching } ); - } ## end unless ( $data ) - if ( !$data ) - { - $dieIfError - and - print( "Error processing WSDL: can't find the path '$path'\n" ), - exit; - } ## end if ( !$data ) - return $data; - }; -} ## end sub _make_finder() - -&_make_finder( "_wsdl_find", "find" ); -&_make_finder( "_wsdl_findvalue", "findvalue" ); -&_make_finder( "_wsdl_findnodes", "findnodes" ); - -sub wsdl_cache_store -{ - my $self = shift; - if ( ( $self->{ _WSDL }->{ cache_directory } ) - && ( $self->{ _WSDL }->{ fileCache } ) ) - { - $self->{ _WSDL }->{ fileCache } - ->set( $self->wsdl, $self->{ _WSDL }->{ xpath } ); - $self->{ _WSDL }->{ fileCache } - ->set( $self->wsdl . "_cache", $self->{ _WSDL }->{ cache } ); - } ## end if ( ( $self->{ _WSDL ... -} ## end sub wsdl_cache_store - -sub wsdl_cache_init -{ - my $self = shift; - my $p = shift || {}; # get custom params - or none... - my $cache = undef; - eval { require Cache::FileCache; }; - if ( $@ ) - { - - # warn about missing Cache::FileCache and set cache hadnle to undef - warn "File caching is enabled, but you do not have the " - . "Cache::FileCache module. Disabling Filesystem caching." - if ( $self->{ _WSDL }->{ cache_directory } ); - $self->{ _WSDL }->{ fileCache } = undef; - } ## end if ( $@ ) - else - { - - # initialize cache from custom parameters if given - $p->{ cache_root } ||= $self->{ _WSDL }->{ cache_directory }; - $cache = Cache::FileCache->new( $p ); - } ## end else [ if ( $@ ) - $self->{ _WSDL }->{ fileCache } = $cache; -} ## end sub wsdl_cache_init - -sub encode -{ - - my $self = shift; - my $part = shift; - my $data = shift; - - my $schemaNS = $self->_wsdl_schemans ? $self->_wsdl_schemans . ':' : ''; - my $defaultNS = $self->{ _WSDL }->{ tns }; - - my %nsHash = reverse %{ $self->_wsdl_ns }; - my %nsURIs = %{ $self->_wsdl_ns }; - - #TBD: Caching hook ? - my $p = { - name => $part->findvalue( '@name' )->value, - type => $part->findvalue( '@type' )->value, - element => $part->findvalue( '@element' )->value, - xmlns => $part->findvalue( '@targetNamespace' )->value, - nillable => $part->findvalue( '@nillable' )->value, - }; - - my $result = undef; - my $order = undef; - my $typeName = undef; - my $typeNS = ""; - my $type = ""; - - my $default = $part->findvalue( '@default' )->value; - if ( $default eq "0" or $default ) - { - $p->{ default } = $default; - } - - if ( ( $p->{ type } ) ) - { - if ( $p->{ type } =~ m!($defaultNS):(.*)! ) - { - $typeName = $2; - - #looking for type restrictions - my $path = join( $self->_wsdl_wsdlns, - '/', 'definitions/', "types/${schemaNS}schema/" ) - . "${schemaNS}simpleType[\@name='$typeName']/" - . "${schemaNS}restriction" . "|" - . join( $self->_wsdl_wsdlns, - '/', 'definitions/', "types/${schemaNS}schema/" ) - . "${schemaNS}complexType[\@name='$typeName']/${schemaNS}complexContent/" - . "${schemaNS}restriction"; - - #usually there is only one restriction - #my $simpleType = $self->{_WSDL}->{xpath}->find($path)->shift; - my $simpleType = $self->_wsdl_find( $path, "" )->shift; - $simpleType - and my $baseType = $simpleType->findvalue( '@base' )->value; - - #TBD: verify if the data matches the restrictions - #-- - #now we have (hopely) the base type - my $wsdl_encoding = $self->wsdl_encoding(); - - if ( defined( $baseType ) - and $baseType eq $wsdl_encoding . "Array" ) - { - - #the type is an array restricted of something - #-- - $type = $baseType; - $type =~ s/^$schemaNS/xsd:/; - - #-- - - #if the basetype is Array then we ask: Array of what? - #only complexTypes can be restricted to an Array - my $path = join( $self->_wsdl_wsdlns, - '/', 'definitions/', "types/${schemaNS}schema/" ) - . "${schemaNS}complexType[\@name='$typeName']/${schemaNS}complexContent/" - . "${schemaNS}restriction/" - . "${schemaNS}attribute"; - - my $simpleType = - $self->{ _WSDL }->{ xpath }->find( $path )->shift; - $simpleType - and $baseType = - $simpleType->findvalue( - '@' . ( $self->_wsdl_wsdlExplicitNS ) . 'arrayType' ) - ->value; - - #and now we have (eventually) the base type - $baseType =~ s/..$//; - } ## end if ( defined( $baseType... - $baseType and $p->{ type } = $baseType; - } ## end if ( $p->{ type } =~ m!($defaultNS):(.*)!... - - #Now, we have p, and p has a type - #and the type of p is (eventually) extracted from some restriction - - #In order to get the correct type, now we have to handle the imported - #namespaces. Some wsdl files have multiple schema declaration. - #And each declaration can have her own imported namespaces. - #Plainly: for each type check we have to check the schemas chain - #in order to get the imported namespaces for *that* schema - - #- _type_ns contains the typical default namespaces - $typeNS = $self->{ _WSDL }->{ _type_ns }; - - $p->{ type } =~ /(.*:)(.*)/; - if ( $1 ne $schemaNS ) - { - - #the type of p don't belongs to some default schema type - #first we look after the schema who owns our type - my $path = join( $self->_wsdl_wsdlns, - '/', 'definitions/', "types/${schemaNS}schema/" ) - . "*[\@name='$2']"; - - my $schema = $self->_wsdl_find( "$path/..", "" )->shift; - my $nodeSet = - $self->_wsdl_find( - "$path/preceding-sibling::${schemaNS}import" ); - while ( my $node = $nodeSet->shift ) - { - no warnings; - $typeNS .= "|" - . $self->_wsdl_ns->{ $node->getAttribute( 'namespace' ) }; - } ## end while ( my $node = $nodeSet... - - # if the schema has a default nameSpace, it has to be added to - # the typeNs list - - my $schemaTargetNS = $schema->findvalue( '@targetNamespace' ); - if ( $schemaTargetNS ) - { - defined $self->_wsdl_ns->{ $schemaTargetNS } - and $typeNS .= "|" . $self->_wsdl_ns->{ $schemaTargetNS }; - } - } ## end if ( $1 ne $schemaNS ) - - if ( $p->{ type } =~ m/^$typeNS/ ) - { #it's a simple type - - #symple types can have default values - if ( !exists $data->{ $p->{ name } } - or !defined $data->{ $p->{ name } } ) - { - if ( defined $p->{ default } ) - { - $data->{ $p->{ name } } = $p->{ default }; - } - } ## end if ( !exists $data->{ ... - - #-- this stuff is supposed to check the occurrences - my $count = -1; - if ( $self->{ _WSDL }->{ checkoccurs } ) - { - # count is ... - # ... read from outwards to inwards... - # ... 0 if the element does not exist - # ... 0 if the element is not defined - # ... scalar @{ $element } if it's a list ref - # ... 1 if it's a scalar. - $count = - exists $data->{ $p->{ name } } - ? defined $data->{ $p->{ name } } - ? ref $data->{ $p->{ name } } eq 'ARRAY' - ? scalar @{ $data->{ $p->{ name } } } - : 1 - : 0 - : 0; - - $order = $part->getParentNode()->getLocalName; - $p->{ minOccurs } = $part->findvalue( '@minOccurs' )->value; - if ( ( !defined( $p->{ minOccurs } ) ) - || ( $p->{ minOccurs } eq "" ) ) - { - # 1 is the default minOccurs for - if ( $order eq 'sequence' ) - { - $p->{ minOccurs } = 1; - } - # 0 is the default minOccurs for - elsif ( $order eq 'all' ) - { - $p->{ minOccurs } = 0; - } - # ...set it to 0 - else - { - $p->{ minOccurs } = 0; - } - } ## end if ( ( !defined( $p->{... - - $p->{ maxOccurs } = $part->findvalue( '@maxOccurs' )->value; - if ( ( !defined( $p->{ maxOccurs } ) ) - || ( $p->{ maxOccurs } eq "" ) ) - { - # 1 is the default maxOccurs for - if ( $order eq 'sequence' ) { $p->{ maxOccurs } = 1 } - # 1 is the default maxOccurs for - elsif ( $order eq 'all' ) { $p->{ maxOccurs } = 1 } - else { $p->{ maxOccurs } = undef } - } ## end if ( ( !defined( $p->{... - - # undef means we don't check it... - $p->{ maxOccurs } = undef - if ( defined( $p->{ maxOccurs } ) - && $p->{ maxOccurs } eq 'unbounded' ); - } ## end if ( $self->{ _WSDL }->... - - # check for ocurrence ? - if ( $self->{ _WSDL }->{ checkoccurs } ) - { - CHECK: - { - # may be empty and is... - last CHECK if ($count == 0 and $p->{ nillable } eq 'true'); - - # above lower bound - if ( $p->{ minOccurs } <= $count ) - { - # no upper bound - last CHECK if (not defined ($p->{ maxOccurs })); - - last CHECK if ($count <= $p->{ maxOccurs }); - } - no warnings; - die "illegal number of elements ($count, min: " - . $p->{ minOccurs } - . ", max: " - . $p->{ maxOccurs } - . ") for element '$p->{ name }' (may be sub-element) "; - }; - } - - # not nillable - # empty value - if ( not $p->{ nillable } and ( - ( !( exists $data->{ $p->{ name } } ) ) - || ( not defined $data->{ $p->{ name } } ) ) ) - { - return (); - }; - - # some value - - # SOAP::Lite uses the "xsd" prefix for specifying schema NS - my $type = $p->{ type }; - $type =~ s/^$schemaNS/xsd:/; - $result = SOAP::Data->new( name => $p->{ name } ); - $result->type( $type ) if ( $self->autotype ); - $result->attr( { xmlns => $p->{ xmlns } } ) if $p->{ xmlns }; - return ( $result->value( $data->{ $p->{ name } } ) ); - - } ## end if ( $p->{ type } =~ m/^$typeNS/... - else - { ### must be a complex type - ### get complex type - my $type = $p->{ type }; - $type =~ s/^($defaultNS)\://; # - $type =~ s/^(.+?\:)?//; - my $path; - { - no warnings; - - $path = '/' - . $self->_wsdl_wsdlns - . 'definitions/' - . $self->_wsdl_wsdlns - . "types/${schemaNS}schema/" - . "${schemaNS}complexType[\@name='$type']" . '|' . '/' - . $self->_wsdl_wsdlns - . 'definitions/' - . $self->_wsdl_wsdlns - . "types/schema[\@xmlns='" - . $nsHash{ $schemaNS } - . "' and \@targetNameSpace = '" - . $nsHash{ $1 } . "' ]/" - . "complexType[\@name='$type']"; - }; - - my $complexType = $self->_wsdl_find( $path, "dieIfError" )->shift; - - ### handles arrays of complex types - ### TBD: check for min /max number of elements - if ( ref $data->{ $p->{ name } } eq 'ARRAY' ) - { - - #$data says: look, in this position I have for you an array of stuff - my @resultArray = (); - foreach my $subdata ( @{ $data->{ $p->{ name } } } ) - { - $result = SOAP::Data->new( name => $p->{ name } ); - $result->type( $type ) if ( $self->autotype ); - $result->attr( { xmlns => $p->{ xmlns } } ) - if $p->{ xmlns }; - my $value = - $self->_encodeComplexType( $complexType, $subdata ); - push @resultArray, $result->value( $value ) - if ( defined( $value ) ); - } ## end foreach my $subdata ( @{ $data... - return ( @resultArray ) ? @resultArray : (); - } ## end if ( ref $data->{ $p->... - else - { - $result = SOAP::Data->new( name => $p->{ name } ); - - #.Net compatibility $result->type( $type ) if ($self->autotype); - $result->attr( { xmlns => $p->{ xmlns } } ) if $p->{ xmlns }; - my $value; - - # - if ( $data->{ $p->{ name } } ) - { #we have some data to encode - $value = - $self->_encodeComplexType( $complexType, - $data->{ $p->{ name } } ); - } ## end if ( $data->{ $p->{ name... - else - { - $p->{ minOccurs } = - $part->findvalue( '@minOccurs' )->value; - if ( $p->{ minOccurs } ne '' and $p->{ minOccurs } > 0 ) - { - - #this element is required, but we have no data to encode - #it's an error - die "illegal number of elements (0, min: " - . $p->{ minOccurs } - . ", for element '$p->{ name }' (may be sub-element) "; - } ## end if ( $p->{ minOccurs }... - } ## end else [ if ( $data->{ $p->{ name... - return () unless ( defined( $value ) ); - return ( $result->value( $value ) ); - } ## end else [ if ( ref $data->{ $p->... - } ## end else [ if ( $p->{ type } =~ m/^$typeNS/... - } ## end if ( ( $p->{ type } ) ... - elsif ( $p->{ element } ) - { - - #if p has no type, then must be an an element (or an error) - #which one? - my $elementPath = $p->{ element }; - - $elementPath =~ s/^$defaultNS\://; - - # there are two ways how schema are usually defined - my $path = '/' - . $self->_wsdl_wsdlns - . 'definitions/' - . $self->_wsdl_wsdlns - . 'types/' - . $schemaNS - . 'schema/' - . $schemaNS - . 'element[@name="' - . $elementPath . '"]/' - . $schemaNS - . 'complexType/' - . 'descendant::' - . $schemaNS - . 'element'; - - my $elements = $self->_wsdl_findnodes( $path, "dieIfError" ); - - my @resultArray = (); - while ( my $e = $elements->shift ) - { - my @enc; - @enc = $self->encode( $e, $data ); - push @resultArray, @enc if ( @enc ); - } ## end while ( my $e = $elements... - return ( @resultArray ) ? @resultArray : (); - } ## end elsif ( $p->{ element } ) - else - { - - #typical case when coping with .Net generated wsdl files - ( $p->{ name } eq "anyType" ) - and print -"Oops, have you defined an ArrayOfAnyType without the Type? Try type=[namespace]:anyType\n"; - die "illegal part definition\n"; - } ## end else [ if ( ( $p->{ type } ) ... - return (); # if we got here, something went wrong... -} ## end sub encode - -sub _encodeComplexType -{ - my $self = shift; - my $complexType = shift; - my $data = shift; - my @result = (); - my $schemaNS = $self->_wsdl_schemans ? $self->_wsdl_schemans . ':' : ''; - my $defaultNS = $self->_wsdl_tns; - my %nsHash = reverse %{ $self->_wsdl_ns }; - - #-- first we encode the local elements .... - my $path = './/' . $schemaNS . 'element'; - my $elements = $complexType->find( $path ); - while ( my $e = $elements->shift ) - { - my @enc; - @enc = $self->encode( $e, $data ); - push @result, @enc if ( @enc ); - } ## end while ( my $e = $elements... - - my $extension = undef; - ### check for extension -#%baseList avoids loops while looking at the extensions chain, just a flag holder - my %baseList = (); - - #... and then we cope with the chain of extensions - while ( $extension = - $complexType->find( './/' . $schemaNS . 'extension' )->shift ) - { - ### pull in extension base - my $base = $extension->findvalue( '@base' ); - $base =~ s/^$defaultNS\://; - $base =~ s/^(.+?\:)//; - - #- - last if ( $baseList{ $base } ); #got a loop - $baseList{ $base } = 1; - - #- - my $path; - { - no warnings; - - # there are two ways how schema are usually defined - $path = '/' - . $self->_wsdl_wsdlns - . 'definitions/' - . $self->_wsdl_wsdlns - . "types/" - . $schemaNS - . "schema/" - . $schemaNS - . "complexType[\@name='$base']" . '|' . '/' - . $self->_wsdl_wsdlns - . 'definitions/' - . $self->_wsdl_wsdlns - . "types/schema[\@xmlns='" - . $nsHash{ $schemaNS } - . "' and \@targetNameSpace = '" - . $nsHash{ $1 } . "' ]/" - . "complexType[\@name='$base']"; - } - - $complexType = $self->_wsdl_find( $path, "dieIfError" )->shift; - - #now we can find the elements - $path = ".//" . $schemaNS . "element|.//element"; - my $elements = $complexType->find( $path ) - || die "Error processing WSDL: '$path' not found"; - - while ( my $e = $elements->shift ) - { - my @enc; - @enc = $self->encode( $e, $data ); - push @result, @enc if ( @enc ); - } ## end while ( my $e = $elements... - } ## end while ( $extension = $complexType... - return ( @result ) ? \SOAP::Data->value( @result ) : (); -} ## end sub _encodeComplexType - -1; - -__END__ - -=pod +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 - -=head1 SYNOPSIS - - use SOAP::WSDL; - - my $soap = SOAP::WSDL->new( wsdl => 'http://server.com/ws.wsdl' ); - $soap->wsdlinit(); - $soap->servicename( 'myservice' ); - $soap->portname( 'myport' ); - - my $som = $soap->call( 'method' => ( - name => 'value' , - name => 'value' ) ); - - # or pass servicename and portname to wsdlinit - $soap->wsdlinit( - servicename => 'myservice', - portname => 'myport', - ); - my $som = $soap->call( 'method' => ( - name => 'value' , - name => 'value' ) ); - - # or let even find SOAP::WSDL the correct port and servicename for your - # URL (may fail - there may be more than one service defined for a URL...) - $soap->wsdlinit( - url => 'http://server.com/' - ); - my $som = $soap->call( 'method' => ( - name => 'value' , - name => 'value' ) ); - - +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 - -There are new ways for initializing - see wsdlinit in L. - -The calling interface has changed between 1.20 and 1.21, so existing code -using this module needs to be changed, too. - -See L below. - -SOAP::WSDL provides decent WSDL support for SOAP::Lite. -It is built as a add-on to SOAP::Lite, and will sit on top of it, -forwarding all the actual request-response to SOAP::Lite - somewhat -like a pre-processor. - -WSDL support means that you don't have to deal with those bitchy namespaces -some web services set on each and every method call parameter. - -It also means an end to that nasty - - SOAP::Data->name( 'Name' )->value( - SOAP::Data->name( 'Sub-Name')->value( 'Subvalue' ) - ); - -encoding of complex data. (Another solution for this problem is just iterating -recursively over your data. But that doesn't work if you need more information -[e.g. namespaces etc] than just your data to encode your parameters). - -And it means that you can use ordinary hashes for your parameters - the -encording order will be derived from the WSDL and not from your (unordered) -data, thus the problem of unordered perl-hashes and WSDL EsequenceE -definitions is solved, too. (Another solution for the ordering problem is -tying your hash to a class that provides ordered hashes - Tie::IxHash is -one of them). - -=head2 Why should I use this ? - -SOAP::WSDL eases life for webservice developers who have to communicate with -lots of different web services using a reasonable big number of method calls. - -If you just want to call a hand full of methods of one web service, take -SOAP::Lite's stubmaker and modify the stuff by hand if it doesn't work right -from the start. The overhead SOAP::WSDL imposes on your calls is not worth -the time saving. - -If you need to access many web services offering zillions of methods to you, -this module should be your choice. It automatically encodes your perl data -structures correctly, based on the service's WSDL description, handling -even those complex types SOAP::Lite can't cope with. - -SOAP::WSDL also eliminates most perl E-E .NET interoperability -problems by qualifying method and parameters as they are specified in the -WSDL definition. - -=head1 USAGE - - my $soap=SOAP::WSDL->new( wsdl => 'http://server.com/ws.wsdl' ); - - # or - my $soap=SOAP::WSDL->new() - $soap->wsdl('http://server.com/ws.wsdl'); - - # or - # without dispatching calls to the WebService - # - # useful for testing - my $soap=SOAP::WSDL->new( wsdl => 'http://server.com/ws.wsdl', - no_dispatch => 1 ); - - # never forget to call this !in order to start the parsing procedure - $soap->wsdlinit(); - - # with caching enabled:don't forget the cache directory - $soap->wsdlinit( caching => 1, cache_directory =>"/tmp/cachedir"); - - # optional, set to a false value if you don't want your - # soap message elements to be typed - $soap->autotype(0); - - - # before calling you *must* specify which service use and which port call - # you must call it after wsdlinit - # you can call it multiple times, one for each call - $soap->servicename('myservice'); - $soap->portname('myport'); - - my $som=$soap->call( 'method' , - name => 'value' , - name => 'value' ); - - - # with the method overloaded (got it from the standard) - my $som=$soap->call( 'method' , - wsdl_input_name => unique_input_message_name - name => 'value' , - name => 'value' ); - - # with headers (see the SOAP documentation) - - #first define your headers - @header = (SOAP::Header->name("FirstHeader")->value("FirstValue"), - SOAP::Header->name("SecontHeader")->value("SecondValue")); - - #and then do the call. please note the backslash - my $som=$soap->call( 'method' , - name => 'value' , - name => 'value' , - "soap_headers",\@header); - - -=head1 How it works - -SOAP::WSDL takes the wsdl file specified and looks up the service and the specified port. -On calling a SOAP method, it looks up the message encoding and wraps all the -stuff around your data accordingly. - -Most pre-processing is done in I, the rest is done in I, which -overrides the same method from SOAP::Lite. - -=head2 wsdlinit - -SOAP::WSDL loads the wsdl file specified by the wsdl parameter / call using -SOAP::Lite's schema method. It sets up a XPath object of that wsdl file, and -subsequently queries it for namespaces, service, and port elements. - -SOAP::WSDL uses the service and the port specified by the calling script via -the servicename/portname or the url parameter. - -If you want to chose different ones, you can specify the service by calling - -$soap->servicename('ServiceToUse'); -$soap->portname('PortToUse'); - -=head2 call - -The call method examines the wsdl file to find out how to encode the SOAP -message for your method. Lookups are done in real-time using XPath, so this -incorporates a small delay to your calls (see L -below. - -The SOAP message will include the types for each element, unless you have -set autotype to a false value by calling - - $soap->autotype(0); - -After wrapping your call into what is appropriate, SOAP::WSDL uses the I -method from SOAP::Lite to dispatch your call. - -call takes the method name as first argument, and the parameters passed to that -method as following arguments. - -B - - $som=$soap->call( "SomeMethod" => "test" => "testvalue" ); - - $som=$soap->call( "SomeMethod" => %args ); - -=head1 Caching - -SOAP::WSDL uses a two-stage caching mechanism to achieve best performance. - -First, there's a pretty simple caching mechanisms for storing XPath query results. -They are just stored in a hash with the XPath path as key (until recently, only -results of "find" or "findnodes" are cached). I did not use the obvious -L or L module here, because these -use L to store complex objects and thus incorporate a performance -loss heavier than using no cache at all. -Second, the XPath object and the XPath results cache are be stored on disk using -the L implementation. - -A filesystem cache is only used if you - - 1) enable caching - 2) set wsdl_cache_directory - -The cache directory must be, of course, read- and writeable. - -XPath result caching doubles performance, but increases memory consumption - if you lack of -memory, you should not enable caching (disabled by default). - -Filesystem caching triples performance for wsdlinit and doubles performance for the first -method call. - -The file system cache is written to disk when the SOAP::WSDL object is destroyed. -It may be written to disk any time by calling the L method - -Using both filesystem and in-memory caching is recommended for best performance and -smallest startup costs. - -=head2 Sharing cache between applications - -Sharing a file system cache among applications accessing the same web service -is generally possible, but may under some circumstances reduce performance, -and under some special circumstances even lead to errors. - -This is due to the cache key algorithm used. - -SOAP::WSDL uses the SOAP endpoint URL to store the XML::XPath object of the -wsdl file. -In the rare case of a web service listening on one particular endpoint (URL) -but using more than one WSDL definition, this may lead to errors when -two or more applications using SOAP::WSDL share a file system cache. - -SOAP::WSDL stores the XPath results in-memory-cache in the filesystem cache, -using the key of the wsdl file with C<_cache> appended. Two applications -sharing the file system cache and accessing different methods of one web -service could overwrite each others in-memory-caches when dumping the XPath -results to disk, resulting in a slight performance drawback (even though this -only happens in the rare case of one app being started before -the other one has had a chance to write its cache to disk). - -=head2 Controlling the file system cache - -If you want full controll over the file system cache, you can use -wsdl_init_cash to initialize it. wsdl_init_cash will take the same parameters -as Cache::FileCache->new(). - -See L and L for details. - -=head2 Notes - -If you plan to write your own caching implementation, you should consider -the following: - -The XPath results cache must not survive the XPath object SOAP::WSDL uses to -store the WSDL file in (this could cause memory holes - see L -for details). - -This never happens during normal usage - but note that you have been warned -before trying to store and re-read SOAP::WSDL's internal cache. - -=head1 Methods - -=head2 Frequently used methods - -=item wsdl - - $soap->wsdl('http://my.web.service.com/wsdl'); - -Use this to specify the WSDL file to use. Must be a valid (and accessible !) -url. - -You must call this before calling L. - -For time saving's sake, this should be a local file - you never know how much -time your WebService needs for delivering a wsdl file. - -=head2 wsdlinit - - $soap->wsdlinit( caching => 1, - cache_directory => '/tmp/cache' ); - -Initializes the WSDL document for usage. - -wsdlinit will die if it can't set up the WSDL file properly, so you might -want to eval{} it. - -On death, $@ will (hopefully) contain some error message like - - Error processing WSDL: no element found - -to give you a hint about what went wrong. - -wsdlinit will accept a hash of parameters with the following keys: - -=over 4 - -=item * caching - -enables caching if true - -=item * cache_directory - -The cache directory to use for FS caching - -=item * url - -URL to derive port and service name from. If url is given, wsdlinit will try -to find a matching service and port in the WSDL definition. - -=item * servicename - -like setting the servicename directly. See below. - -=back - -=head3 call - - $soap->call($method, %data); - -See above. - -call will die if it can't find required elements in the WSDL file or if your data -doesn't meet the WSDL definition's requirements, so you might want to eval{} it. -On death, $@ will (hopefully) contain some error message like - - Error processing WSDL: no element found - -to give you a hint about what went wrong. - -=head2 Configuration methods - -=head3 servicename - - $soap->servicename('Service1'); - -Use this to specify a service by name. -Your wsdl contains definitions for one or more services - hou have to tell -SOAP::WSDL which one to use. - -You can call it before each method call. - -=head3 portname - - $soap->portname('Port1'); - -Your service can have one or many ports attached to it. -Each port has some operation defined in it trough a binding. -You have to tell which port of your service should be used for the -method you are calling. - -You can call it before each method call. - -=head3 wsdl_checkoccurs - -Enables/disables checks for correct number of -occurences of elements in WSDL types. The default is 1 (on). - -Turning off occurance number checking results in a sligt performance gain. - -To turn off checking for correct number of elements, call - - $soap->wsdl_checkoccurs(0); - -=head3 wsdl_encoding - -The encoding style for the SOAP call. - -=head3 cache_directory - -enables filesystem caching (in the directory specified). The directory given must be -existant, read- and writeable. - -=head3 wsdl_cache_directory - - $soap->wsdl_cache_directory( '/tmp/cache' ); - -Sets the directory used for filesystem caching and enables filesystem caching. -Passing the I parameter to wsdlinit has the same effect. - -=head2 Seldomly used methods - -The following methods are mainly used internally in SOAP::WSDL, but may -be useful for debugging and some special purposes (like forcing a cache flush -on disk or custom cache initializations). - -=head3 no_dispatch - -Gets/Sets the I flag. If no_dispatch is set to true value, SOAP::WSDL -will not dispatch your calls to a remote server but return the SOAP::SOM object -containing the call instead. - -=head3 encode - - # this is how call uses encode - # $xpath contains a XPath object of the wsdl document - - my $def=$xpath->find("/definitions")->shift; - my $parts=$def->find("//message[\@name='$messageName']/part"); - - my @param=(); - - while (my $part=$parts->shift) { - my $enc=$self->encode($part, \%data); - push @param, $enc if defined $enc; - } - -Does the actual encoding. Expects a XPath::NodeSet as first, a hashref containing -your data as second parameter. The XPath nodeset must be a node specifying a WSDL -message part. - -You won't need to call I unless you plan to -override I or want to write a new SOAP server implementation. - -=head3 * wsdl_cache_init - -Initialize the WSDL file cache. Normally called from wsdlinit. For custom -cache initailization, you may pass the same parameters as to -Cache::FileCache->new(). - -=head3 wsdl_cache_store - - $soap->wsdl_cache_store(); - -Stores the content of the in-memory-cache (and the XML::XPath representation of -the WSDL file) to disk. This will not have any effect if cache_directory is not set. - - -=head1 Notes - -=head2 Why another SOAP module ? - -SOAP::Lite provides only some rudimentary WSDL support. This lack is not just -something unimplemented, but an offspring of the SOAP::Schema -class design. SOAP::Schema uses some complicated format to store XML Schema information -(mostly a big hashref, containing arrays of SOAP::Data and a SOAP::Parser-derived -object). This data structure makes it pretty hard to improve SOAP::Lite's -WSDL support. - -SOAP::WSDL uses XPath for processing WSDL. XPath is a query language standard for -XML, and usually a good choice for XML transformations or XML template processing -(and what else is WSDL-based en-/decoding ?). Besides, there's an excellent XPath -module (L) available from CPAN, and as SOAP::Lite uses XPath to -access elements in SOAP::SOM objects, this seems like a natural choice. - -Fiddling the kind of WSDL support implemented here into SOAP::Lite would mean -a larger set of changes, so I decided to build something to use as add-on. - -=head2 Memory consumption and performance - -SOAP::WSDL uses around twice the memory (or even more) SOAP::Lite uses for the -same task (but remember: SOAP::WSDL does things for you SOAP::Lite can't). -It imposes a slight delay for initialization, and for every SOAP method call, too. - -On my 1.4 GHz Pentium mobile notebook, the init delay with a simple -WSDL file (containing just one operation and some complex types and elements) -was around 50 ms, the delay for the first call around 25 ms and for subsequent -calls to the same method around 7 ms without and around 6 ms with XPath result caching -(on caching, see above). XML::XPath must do some caching, too - don't know where -else the speedup should come from. - -Calling a method of a more complex WSDL file (defining around 10 methods and -numerous complex types on around 500 lines of XML), the delay for the first -call was around 100 ms for the first and 70 ms for subsequent method calls. -wsdlinit took around 150 ms to process the stuff. With XPath result caching enabled, -all but the first call take around 35 ms. - -Using SOAP::WSDL on an idiotically complex WSDL file with just one method, but around -100 parameters for that method, mostly made up by extensions of complex types -(the heaviest XPath operation) takes around 1.2 s for the first call (0.9 with caching) -and around 830 ms for subsequent calls (arount 570 ms with caching). - -The actual performance loss compared to SOAP::Lite should be around 10 % less -than the values above - SOAP::Lite encodes the data for you, too (or you do -it yourself) - and encoding in SOAP::WSDL is already covered by the pre-call -delay time mentioned above. - -If you have lots of WebService methods and call each of them from time to time, -this delay should not affect your perfomance too much. If you have just one method -and keep calling it ever & ever again, you should cosider hardcoding your data -encoding (maybe even with hardcoded XML templates - yes, this may be a BIG speedup). - - -=head1 CAVEATS - -=head2 API change between 1.20 and 1.21 - -Giovanni S. Fois has implemented a new calling convention, which allows to specify the -port type used by SOAP::WSDL. - -While this allows greater flexibillity (and helps around the still missing bindings support), -the following lines have to be added to existing code: - - $soap->servicename( $servicename); - $soap->portname( $porttype ); - -Both lines must appear after calling - - $soap->wsdlinit(); - -=head2 API change between 1.13 and 1.14 - -The SOAP::WSDL API changed significantly between versions 1.13 and 1.14. -From 1.14 on, B expects the following arguments: method name as scalar first, -method parameters as hash following. - -The B no longer recognizes the I option - to get the same behaviour, -pass C 1> to I or call - - $soap->no_dispatch(1); - -=head2 Unstable interface - -This is alpha software - everything may (and most things will) change. -But you don't have to be afraid too much - at least the I synopsis should -be stable from 1.14 on, and that is the part you'll use most frequently. - -=head1 BUGS - -=over - -=item * Arrays of complex types are not checked for the correct number of elements - -Arrays of complex types are just encoded and not checked for correctness etc. -I don't know if I do this right yet, but output looks good. However, they are not -checked for the correct number of element (does the SOAP spec say how to -specify this ?). - -=item * +trace (and other SOAP::Lite flags) don't work - -This may be an issue with older versions of the base module (before 2.?), or with -activestate's activeperl, which do -not call the base modules I method with the flags supplied to the parent. - -There's a simple workaround: - - use SOAP::WSDL; - import SOAP::Lite +trace; - -=item * nothing else known - -But I'm sure there are some serious bugs lurking around somewhere. - -=back - -=head1 TODO - + +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. + +=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 Allow use of alternative XPath implementations +=item * outputxml -XML::XPath is a great module, but it's not a race-winning one. -XML::LibXML offers a promising-looking XPath interface. SOAP::WSDL should -support both, defaulting to the faster one, and leaving the final choice -to the user. +call() with outputtxml set to true now returns the complete SOAP +envelope, not only the body's content. =back -=head1 CHANGES +=head1 Differences to SOAP::Lite + +=head2 Auto-Dispatching + +SOAP::WSDL does B 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 + + 1 23 + 12 3 + +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 Emartin.kutter fen-net.deE -See CHANGES file. - -=head1 COPYRIGHT - -This library is free software, you can distribute / modify it under the same -terms as perl itself. - -=head1 AUTHORS - -Replace the whitespace in the e-mail adresses by '@'. - - Martin Kutter - Giovanni S. Fois - -=cut +=cut + diff --git a/lib/SOAP/WSDL/Binding.pm b/lib/SOAP/WSDL/Binding.pm index 7ea4ca6..517f01d 100644 --- a/lib/SOAP/WSDL/Binding.pm +++ b/lib/SOAP/WSDL/Binding.pm @@ -61,7 +61,8 @@ EOT $input ? $input->explain($opt) : q{}; }; - $txt .= <<"EOT"; + $txt .= <<"EOT"; + =over =item * $operation_name diff --git a/lib/SOAP/WSDL/Client.pm b/lib/SOAP/WSDL/Client.pm index d3a9d16..b20a03b 100644 --- a/lib/SOAP/WSDL/Client.pm +++ b/lib/SOAP/WSDL/Client.pm @@ -1,276 +1,77 @@ package SOAP::WSDL::Client; use strict; use warnings; -use vars qw/$AUTOLOAD/; use Scalar::Util qw(blessed); use SOAP::WSDL::Envelope; -use SOAP::WSDL::SAX::WSDLHandler; +use SOAP::Lite; +use Class::Std::Storable; +use SOAP::WSDL::SAX::MessageHandler; + +# Package globals for speed... +my $PARSER; +my $MESSAGE_HANDLER; + +my %class_resolver_of :ATTR(:name :default<()>); +my %no_dispatch_of :ATTR(:name :default<()>); +my %outputxml_of :ATTR(:name :default<()>); +my %proxy_of :ATTR(:name :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 { - use XML::LibXML; + eval { + require XML::LibXML; + $PARSER = XML::LibXML->new(); + $MESSAGE_HANDLER = SOAP::WSDL::SAX::MessageHandler->new(); + $PARSER->set_handler( $MESSAGE_HANDLER ); }; if ($@) { - use XML::SAX::ParserFactory; + require XML::SAX::ParserFactory; + $MESSAGE_HANDLER = SOAP::WSDL::SAX::MessageHandler->new({ + base => 'XML::SAX::Base' }); + $PARSER = XML::SAX::ParserFactory->parser( + handler => $MESSAGE_HANDLER ); } } -use base qw/SOAP::Lite/; - -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 $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 => 1, - typelib => $types, - namespace => $ns, - }; - $self->{ _WSDL }->{ explain_options } = { - readable => 1, - wsdl => $wsdl_definitions, - namespace => $ns, - typelib => $types, - }; - - 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 - -=pod - -=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. - -=back - -=cut - -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(); - my $portType = $self->{ _WSDL }->{ portType } - || $self->_wsdl_get_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->get_input()->[0]->get_message(); - # 3. get input message - my $message = $wsdl->find_message( $ns, $localname ); - $method->{ parts } = $message->get_part(); - - # rpc / encoded methods may have a namespace specified. - # look it up and set it... - $method->{ namespace } = $binding_operation ? - $binding_operation->get_input()->[0]->get_namespace() : 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 $data = ref $_[0] ? $_[0] : { @_ }; my $content = q{}; - my $envelope; - my $methodInfo; - - if (blessed $data + 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 + + # 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(); + $soap_action = join '/', $data->get_xmlns(), $method; - $methodInfo = $methodLookup->{ $method }; - my $partListRef = $methodInfo->{ parts }; + } - # set serializer options - # TODO allow custom options here - my $opt = $self->{ _WSDL }->{ serialize_options }; + return $envelope if $self->no_dispatch(); - # 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... + # warn $envelope; # get response via transport layer # TODO remove dependency from SOAP::Lite and use a @@ -283,146 +84,114 @@ sub call { # - 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( + my $soap = SOAP::Lite->new()->proxy( $self->get_proxy() ); + my $response = $soap->transport->send_receive( context => $self, # this is provided for context - endpoint => $self->endpoint(), - action => $methodInfo->{ soap_action }, # SOAPAction from binding + 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() ); - if ($self->outputtree()) { + $MESSAGE_HANDLER->set_class_resolver( $self->get_class_resolver() ); - 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 (! $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 $@; + }; - # 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 $@; - }; + 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 ) }; - # 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(); + # 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" + }); } - # 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; + return $MESSAGE_HANDLER->get_data(); } ## 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 }; -} ## end sub servicename - -sub portname -{ - my $self = shift; - return $self->{ _WSDL }->{ portname } if ( not @_ ); - $self->{ _WSDL }->{ portname } = shift; - - my $ns = $self->{ _WSDL }->{ wsdl_definitions }->targetNamespace(); - - $self->{ _WSDL }->{ port } = - $self->{ _WSDL }->{ service } - ->get_port( $ns, $self->{ _WSDL }->{ portname } ) - or die "No such port: " . $self->{ _WSDL }->{ portname }; -} ## end sub portname +1; =pod -=head1 Auto-Dispatching +=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 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 support auto-dispatching. -This is on purpose: You may easily create interface classes by using +This is on purpose: You may easily create interface classes by using SOAP::WSDL::Client and implementing something like sub mySoapMethod { @@ -430,17 +199,9 @@ SOAP::WSDL::Client and implementing something like $soap_wsdl_client->call( mySoapMethod, @_); } -You may even do this in a class factory - SOAP::WSDL provides the methods +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. - =cut -sub AUTOLOAD -{ - my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2); - die "$method not found"; -} + diff --git a/lib/SOAP/WSDL/Part.pm b/lib/SOAP/WSDL/Part.pm index 917de8a..7eeee39 100644 --- a/lib/SOAP/WSDL/Part.pm +++ b/lib/SOAP/WSDL/Part.pm @@ -10,33 +10,33 @@ my %type_of :ATTR(:name :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 $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 - ); - return $type->serialize( $self->get_name(), $data, $opt ); - } - elsif ( $item_name = $self->get_element() ) - { + 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 - ); - return $element->serialize( undef, $data, $opt ); - } + 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"; } diff --git a/lib/SOAP/WSDL/SAX/MessageHandler.pm b/lib/SOAP/WSDL/SAX/MessageHandler.pm index 2c42527..f8a5373 100644 --- a/lib/SOAP/WSDL/SAX/MessageHandler.pm +++ b/lib/SOAP/WSDL/SAX/MessageHandler.pm @@ -7,7 +7,7 @@ use Class::Std::Storable; use SOAP::WSDL::XSD::Typelib::Builtin; my %characters_of :ATTR(:default<()>); -my %class_resolver_of :ATTR(:default<()> :init_attr); +my %class_resolver_of :ATTR(:default<()> :name); my %current_of :ATTR(:default<()>); my %ignore_of :ATTR(:default<()>); my %list_of :ATTR(:default<()>); @@ -70,7 +70,7 @@ my %data_of :ATTR(:default<()>); } $class_resolver_of{ ident $self } = $args->{ class_resolver } - or die "cannot parse message without type resolver"; + if $args->{ class_resolver }; return bless $self, $class; } @@ -83,17 +83,16 @@ sub start_document { $namespace_of{ $ident } = {}; $ignore_of{ $ident } = [ qw(Envelope Body) ]; # SOAP elements $path_of{ $ident } = []; - $data_of{ $ident } = undef; + $data_of{ $ident } = undef; } sub start_element { # use $_[n] for performance my ($ident, $element) = (ident $_[0], $_[1]); - my $local_name = $element->{ LocalName }; # ignore top level elements if (@{ $ignore_of{ $ident } } - && $local_name eq $ignore_of{ $ident }->[0]) { + && $element->{ LocalName } eq $ignore_of{ $ident }->[0]) { shift @{ $ignore_of{ $ident } }; return; } @@ -101,7 +100,7 @@ sub start_element { # empty characters $characters_of{ $ident } = q{}; - push @{ $path_of{ $ident } }, $local_name; # step down... + push @{ $path_of{ $ident } }, $element->{ LocalName }; # step down... push @{ $list_of{ $ident } }, $current_of{ $ident }; # remember current # resolve class of this element @@ -111,26 +110,26 @@ sub start_element { . " via " . $class_resolver_of{ $ident }; - # Check whether we have a primitive - we implement them as classes - # TODO replace with UNIVERSAL->isa() or maybe index - could be faster - # than m// - # TODO - if (not $class=~m{^SOAP::WSDL::XSD::Typelib::Builtin}xms) { - eval "require $class"; ## no critic qw(ProhibitStringyEval) - die $@ if $@; + # 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 - my $obj = $class->new({ + # set current object + $current_of{ $ident } = $class->new({ map { $_->{ Name } => $_->{ Value } } values %{ $element->{ Attributes } } }); - # set current object - $current_of{ $ident } = $obj; - # remember top level element - $data_of{ $ident } = $obj if not defined $data_of{ $ident }; + defined $data_of{ $ident } + or ($data_of{ $ident } = $current_of{ $ident }); } sub characters { @@ -142,7 +141,8 @@ sub end_element { my ($ident, $element) = (ident $_[0], $_[1]); # This one easily handles ignores for us, too... - return if $list_of{ $ident }->[-1] eq '__STOP__'; + 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 } ); @@ -156,7 +156,7 @@ sub end_element { # step up in path pop @{ $path_of{ $ident } }; - + # step up in object hierarchy... $current_of{ $ident } = pop @{ $list_of{ $ident } }; } diff --git a/lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm b/lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm index 5753653..f4392c5 100644 --- a/lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm +++ b/lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm @@ -29,7 +29,7 @@ __PACKAGE__->_factory( detail => \%detail_of, }, { - faultcode => 'SOAP::WSDL::XSD::Typelib::Builtin::qName', + 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', diff --git a/lib/SOAP/WSDL/XSD/ComplexType.pm b/lib/SOAP/WSDL/XSD/ComplexType.pm index 17c578e..60c710c 100644 --- a/lib/SOAP/WSDL/XSD/ComplexType.pm +++ b/lib/SOAP/WSDL/XSD/ComplexType.pm @@ -5,6 +5,7 @@ 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 :default<()>); my %element_of :ATTR(:name :default<()>); @@ -60,57 +61,63 @@ sub serialize { my ($self, $name, $value, $opt) = @_; - $opt->{ indent } ||= q{}; - my $flavor = $self->get_flavor(); - my $xml = ''; + $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 .= $opt->{ indent } if ($opt->{ readable }); # add indentation - $xml .= "<$name"; - 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'; + $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(); + 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() } + else { + $element_value = $single_value->{ $element->get_name() }; } - $element_value = [ $element_value ] - if not ref $element_value eq 'ARRAY'; + $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 .= ''; - $xml .= "\n" if ($opt->{ readable } ); # add linebreak - return $xml; + $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 .= ''; + $xml .= "\n" if ($opt->{ readable } ); # add linebreak + return $xml; } sub explain @@ -249,6 +256,6 @@ Handling of these child elements is not implemented yet =item * explain may produce erroneous results -=over +=back =cut diff --git a/lib/SOAP/WSDL/XSD/Element.pm b/lib/SOAP/WSDL/XSD/Element.pm index c8ad280..1458ae9 100644 --- a/lib/SOAP/WSDL/XSD/Element.pm +++ b/lib/SOAP/WSDL/XSD/Element.pm @@ -3,6 +3,7 @@ use strict; use warnings; use Class::Std::Storable; use base qw(SOAP::WSDL::Base); +use Data::Dumper; my %simpleType_of :ATTR(:name :default<()>); my %complexType_of :ATTR(:name :default<()>); @@ -44,7 +45,7 @@ sub first_complexType { # serialize type instead... sub serialize { - my ($self, $name, $value, $opt) = @_; + my ($self, $name, $value, $opt) = @_; my $type; my $typelib = $opt->{ typelib }; my %ns_map = reverse %{ $opt->{ namespace } }; @@ -59,13 +60,18 @@ sub serialize # 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 }; + 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 @@ -76,18 +82,18 @@ sub serialize } # 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 ); - } + 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( $self->get_name(), $value, $opt ); + return $type->serialize( $name, $value, $opt ); } # lookup type @@ -98,9 +104,9 @@ sub serialize ); # safety check - die "no type for $prefix:$localname $ns_map{$prefix}" if (not $type); - - return $type->serialize( $self->get_name(), $value, $opt ); + die "no type for $prefix:$localname $ns_map{$prefix}" if (not $type); + + return $type->serialize( $name, $value, $opt ); } sub explain @@ -333,7 +339,7 @@ Handling of the substitutionGroup attribute is not implemented yet =item * explain may produce erroneous results -=over +=back =head1 COPYING diff --git a/lib/SOAP/WSDL/XSD/Primitive.pm b/lib/SOAP/WSDL/XSD/Primitive.pm index 2a1ddfe..10c9112 100644 --- a/lib/SOAP/WSDL/XSD/Primitive.pm +++ b/lib/SOAP/WSDL/XSD/Primitive.pm @@ -9,9 +9,11 @@ sub serialize { my ($self, $name, $value, $opt) = @_; my $xml; - $opt->{ indent } ||= ""; + $opt->{ indent } ||= ""; + $opt->{ attributes } ||= []; + $xml .= $opt->{ indent } if ($opt->{ readable }); - $xml .= '<' . $name; + $xml .= '<' . join ' ', $name, @{ $opt->{ attributes } }; if ( $opt->{ autotype }) { my $ns = $self->get_targetNamespace(); diff --git a/lib/SOAP/WSDL/XSD/SimpleType.pm b/lib/SOAP/WSDL/XSD/SimpleType.pm index 53d55de..d5bd9ca 100644 --- a/lib/SOAP/WSDL/XSD/SimpleType.pm +++ b/lib/SOAP/WSDL/XSD/SimpleType.pm @@ -57,58 +57,59 @@ sub push_enumeration } } -sub serialize -{ - my $self = shift; - my $name = shift; - my $value = shift; - my $opt = shift; - my $ident = ident $self; - $self->_check_value( $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'); - 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); - } + 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 .= '<' . $name; - if ( $opt->{ autotype }) - { - my $ns = $self->get_targetNamespace(); +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() .'"'; - } - $xml .= '>'; - $xml .= $value; - $xml .= '' ; - $xml .= "\n" if ($opt->{ readable }); - return $xml; + || die 'No prefix found for namespace '. $ns; + $xml .= ' type="' . $prefix . ':' . $self->get_name() .'"'; + } + + # nillabel ? + return $xml .'/>' if not defined $value; + + $xml .= join q{}, '>' , $value , ''; + $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 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 { @@ -173,6 +174,6 @@ union simpleType definitions probalbly serialize wrong =item * explain may produce erroneous results -=over +=back =cut diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin.pm index ae6c56a..41e6db9 100644 --- a/lib/SOAP/WSDL/XSD/Typelib/Builtin.pm +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin.pm @@ -2,368 +2,51 @@ package SOAP::WSDL::XSD::Typelib::Builtin; use strict; use warnings; use Class::Std::Storable; - -# derivation classes first... -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); -} - -# Builtin classes -# Every XML schema type inherits from anyType... -package SOAP::WSDL::XSD::Typelib::Builtin::anyType; -use strict; -use warnings; -use Class::Std::Storable; - -sub start_tag { - my ($self, $opt) = @_; - $opt ||= {}; - return '<' . $opt->{name} . ' >' if $opt->{ name }; - return q{} -} -sub end_tag { - my ($self, $opt) = @_; - $opt ||= {}; - return '{name} . ' >' if $opt->{ name }; - return q{} -}; - -sub serialize_qualified :STRINGIFY { - return $_[0]->serialize( { qualified => 1 } ); -} - -# All builtin and all simpleType types inherit from anySimpleType -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(:name :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 }) - , $value_of{ $ident } - , $self->end_tag($opt); -} - -sub as_bool :BOOLIFY { - return $value_of { ident $_[0] }; -} - -package SOAP::WSDL::XSD::Typelib::Builtin::dateTime; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::duration; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::date; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::time; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::gYear; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::gMonth; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::gDay; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::boolean; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -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; -} - -package SOAP::WSDL::XSD::Typelib::Builtin::string; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::normalizedString; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::string); - -package SOAP::WSDL::XSD::Typelib::Builtin::token; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::normalizedString); - -package SOAP::WSDL::XSD::Typelib::Builtin::language; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token); - -package SOAP::WSDL::XSD::Typelib::Builtin::Name; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token); - -package SOAP::WSDL::XSD::Typelib::Builtin::NCName; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::Name); - -package SOAP::WSDL::XSD::Typelib::Builtin::ID; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::NCName); - -package SOAP::WSDL::XSD::Typelib::Builtin::IDREF; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::ID); - -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); - -package SOAP::WSDL::XSD::Typelib::Builtin::ENTITY; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::NCName); - -package SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token); - -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::token); - -package SOAP::WSDL::XSD::Typelib::Builtin::decimal; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -sub as_num :NUMERIFY :BOOLIFY { - return $_[0]->get_value(); -} - -package SOAP::WSDL::XSD::Typelib::Builtin::base64Binary; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::hex64Binary; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::float; -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(); -} - -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(); -} - -package SOAP::WSDL::XSD::Typelib::Builtin::anyURI; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::qName; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::NOTATION; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); - -package SOAP::WSDL::XSD::Typelib::Builtin::integer; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::decimal); - -package SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer); - -package SOAP::WSDL::XSD::Typelib::Builtin::negativeInteger; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger); - -package SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer); - -package SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger); - -package SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger); - -package SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong); - -package SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt); - -package SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort); - -package SOAP::WSDL::XSD::Typelib::Builtin::long; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer); - -package SOAP::WSDL::XSD::Typelib::Builtin::int; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::long); - -package SOAP::WSDL::XSD::Typelib::Builtin::short; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::int); - -package SOAP::WSDL::XSD::Typelib::Builtin::byte; -use strict; -use warnings; -use Class::Std::Storable; -use base qw(SOAP::WSDL::XSD::Typelib::Builtin::short); + +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; @@ -382,7 +65,13 @@ 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. +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 @@ -506,7 +195,9 @@ Replace whitespace by @ in e-mail address. Martin Kutter Emartin.kutter fen-net.deE -=head1 COPYING +=head1 Licenxe + +Copyright 2004-2007 Martin Kutter. This library is free software, you may distribute/modify it under the same terms as perl itself diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm new file mode 100644 index 0000000..3794dd8 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm new file mode 100644 index 0000000..ffcfcad --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm new file mode 100644 index 0000000..50f2253 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm new file mode 100644 index 0000000..6c4f85c --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm new file mode 100644 index 0000000..e29b02b --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm new file mode 100644 index 0000000..1acd5bc --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm new file mode 100644 index 0000000..7661864 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm new file mode 100644 index 0000000..2cff34a --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm @@ -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 :default<()>); +my %minLength_of :ATTR(:name :default<()>); +my %maxLength_of :ATTR(:name :default<()>); +my %pattern_of :ATTR(:name :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm new file mode 100644 index 0000000..847c71a --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm new file mode 100644 index 0000000..22bd506 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm @@ -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 :default<()>); +my %minLength_of :ATTR(:name :default<()>); +my %maxLength_of :ATTR(:name :default<()>); +my %pattern_of :ATTR(:name :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); + +1; + +__END__ + +=pod + +=head1 NAME + +SOAP::WSDL::XSD::Typelib::Builtin::QName - qualified Name object + +=head1 DESCRIPTION + +QName represents XML qualified names. The �value space� 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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm new file mode 100644 index 0000000..287cb80 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm @@ -0,0 +1,64 @@ +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 :init_arg :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] }; +} + +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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm new file mode 100644 index 0000000..abb15d3 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm @@ -0,0 +1,45 @@ +package SOAP::WSDL::XSD::Typelib::Builtin::anyType; +use strict; +use warnings; +use Class::Std::Storable; + +# 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 } + ? "{name} >" + : q{}; +}; + +sub serialize_qualified :STRINGIFY { + return $_[0]->serialize( { qualified => 1 } ); +} + +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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm new file mode 100644 index 0000000..b380ba2 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm @@ -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 :default<()>); +my %minLength_of :ATTR(:name :default<()>); +my %maxLength_of :ATTR(:name :default<()>); +my %pattern_of :ATTR(:name :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm new file mode 100644 index 0000000..e5c6dd5 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm @@ -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 :default<()>); +my %minLength_of :ATTR(:name :default<()>); +my %maxLength_of :ATTR(:name :default<()>); +my %pattern_of :ATTR(:name :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm new file mode 100644 index 0000000..ae84165 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm @@ -0,0 +1,67 @@ +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 :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); + +my %value_of :ATTR(:get :init_attr :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; +} + +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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm new file mode 100644 index 0000000..860270b --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm new file mode 100644 index 0000000..a975f80 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm @@ -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 :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm new file mode 100644 index 0000000..8811404 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm @@ -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 :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut + diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm new file mode 100644 index 0000000..0e0bc01 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm @@ -0,0 +1,43 @@ +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 :default<()>); +my %fractionDigits_of :ATTR(:name :default<()>); +my %pattern_of :ATTR(:name :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :default<()>); + +sub as_num :NUMERIFY :BOOLIFY { + return $_[0]->get_value(); +} + + +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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm new file mode 100644 index 0000000..68cd0cc --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm @@ -0,0 +1,55 @@ +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(); +} + + +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 �value space� of double consists of the values m � 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 �value space� described above, the �value space� of double +also contains the following special values: positive and negative zero, positive and +negative infinity and not-a-number. The �order-relation� 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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm new file mode 100644 index 0000000..a69dd5f --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm @@ -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 :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm new file mode 100644 index 0000000..b2e4b7f --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm @@ -0,0 +1,41 @@ +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 :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :default<()>); + + +sub as_num :NUMERIFY { + return $_[0]->get_value(); +} + +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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm new file mode 100644 index 0000000..64b2eb5 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm @@ -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 :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm new file mode 100644 index 0000000..fba7a91 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm @@ -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 :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm new file mode 100644 index 0000000..1dfbb1c --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm @@ -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 :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm new file mode 100644 index 0000000..721a2e4 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm @@ -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 :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm new file mode 100644 index 0000000..6eadb6f --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm @@ -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 :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm new file mode 100644 index 0000000..8e0318a --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm @@ -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 :default<()>); +my %minLength_of :ATTR(:name :default<()>); +my %maxLength_of :ATTR(:name :default<()>); +my %pattern_of :ATTR(:name :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm new file mode 100644 index 0000000..54ee652 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm new file mode 100644 index 0000000..191c1a9 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm @@ -0,0 +1,30 @@ +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(); +} + +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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm new file mode 100644 index 0000000..28e0647 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm new file mode 100644 index 0000000..d9f9c25 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm new file mode 100644 index 0000000..9ea63c5 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm new file mode 100644 index 0000000..842213e --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm new file mode 100644 index 0000000..8c5cc7b --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm new file mode 100644 index 0000000..bd0ef4a --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm new file mode 100644 index 0000000..90a04be --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm new file mode 100644 index 0000000..e48fdd9 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm new file mode 100644 index 0000000..495871b --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm new file mode 100644 index 0000000..31d2cc6 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm @@ -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 :default<()>); +my %minLength_of :ATTR(:name :default<()>); +my %maxLength_of :ATTR(:name :default<()>); +my %pattern_of :ATTR(:name :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm new file mode 100644 index 0000000..0b859c6 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm @@ -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 :default<()>); +my %enumeration_of :ATTR(:name :default<()>); +my %whiteSpace_of :ATTR(:name :default<()>); +my %maxInclusive_of :ATTR(:name :default<()>); +my %maxExclusive_of :ATTR(:name :default<()>); +my %minInclusive_of :ATTR(:name :default<()>); +my %minExclusive_of :ATTR(:name :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 Emartin.kutter fen-net.deE + +=cut diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm new file mode 100644 index 0000000..1cb8284 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm new file mode 100644 index 0000000..f3a0ed2 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm new file mode 100644 index 0000000..eae2bc1 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm new file mode 100644 index 0000000..bc23420 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm new file mode 100644 index 0000000..957ecf1 --- /dev/null +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm @@ -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 Emartin.kutter fen-net.deE + +=cut \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm b/lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm index 464c963..ee1370b 100644 --- a/lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm +++ b/lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm @@ -27,22 +27,35 @@ sub _factory { { my $type = $CLASSES_OF{ $class }->{ $name } or die "No class given for $name"; - eval "require $type" if not eval { $type->isa('UNIVERSAL') }; - croak $@ if $@; + + $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 vlues + + # 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 } ] - : $type->new({ 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 { @@ -63,33 +76,22 @@ sub _factory { return push @{ $attribute_ref->{ $ident } }, $value; }; } - - # we need our own destructor - on the fly generated classes - # don't necessarily go through Clas::Std::Storable's DEMOLISH - # calls. -# my $destructor_ref = *{ "$class\::DESTROY" }; -# no warnings qw(redefine); -# *{ "$class\::DESTROY" } = sub { -# my $self = shift; -# my $class = shift; -# for (@{ $ELEMENTS_FROM{ $class } }) { -# delete $_->{ ident $self }; -# } - # call original destructor. -# $destructor_ref->( $self, @_) if ref ($destructor_ref); -# }; -# } sub START { my ($self, $ident, $args_of) = @_; my $class = ref $self; - for my $name (keys %{ $ATTRIBUTES_OF{ $class } } ) { - my $method = "set_$name"; - $self->$method( $args_of->{ $name } ) - if $args_of->{ $name }; - } -} + + # iterate over keys of arguments + # and call set appropriate field in clase + map { ($ATTRIBUTES_OF{ $class }->{ $_ }) ? + do { + my $method = "set_$_"; + $self->$method( $args_of->{ $_ } ); + } + : croak "unknown field $_" + } keys %$args_of; +}; sub _get_elements { my $self = shift; @@ -104,28 +106,22 @@ sub _get_elements { # But what about choice, group, extension ? # sub _serialize { - my $self = shift; - my $ident = ident $self; - my $class = ref $self; - + 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 }; + my $element = $ATTRIBUTES_OF{ $class }->{ $_ }->{ $ident }; $element = [ $element ] if not ref $element eq 'ARRAY'; - my $name = $_; - - map { - # skip empty elements - complexTypes may have empty elements - # (minOccurs 0). - if (not $_) { - q{} - } + my $name = $_; + + map { # serialize element elements with their own serializer # but name them like they're named here. - elsif ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) { + if ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) { $_->serialize( { name => $_ } ); } # serialize complextype elments (of other types) with their @@ -141,11 +137,11 @@ sub _serialize { sub serialize { my ($self, $opt) = @_; - my $class = ref $self; $opt ||= {}; + # do we have a empty element ? return $self->start_tag({ %$opt, empty => 1 }) - if not @{ $ELEMENTS_FROM{ $class } }; + if not @{ $ELEMENTS_FROM{ ref $self } }; return join q{}, $self->start_tag($opt), $self->_serialize(), $self->end_tag(); } diff --git a/lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm b/lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm index a3f0132..74cc0e0 100644 --- a/lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm +++ b/lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm @@ -95,10 +95,12 @@ 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 +=head1 BUGS AND LIMITATIONS -=over * +=over =item * Thread safety diff --git a/t/002_sax.t b/t/002_sax.t index e4c0efc..c048b45 100644 --- a/t/002_sax.t +++ b/t/002_sax.t @@ -3,8 +3,6 @@ use strict; use warnings; use diagnostics; use Test::More tests => 17; # qw/no_plan/; # TODO: change to tests => N; -use Test::Differences; -use Data::Dumper; use lib '../lib'; use XML::SAX::ParserFactory; @@ -133,7 +131,8 @@ SKIP: { } ok($xml = $wsdl->find_message('urn:myNamespace', 'testRequest') ->get_part()->[0]->serialize( - undef, { length => { size => -13, unit => 'BLA' } , int => 3 }, + undef, + { test => { length => { size => -13, unit => 'BLA' } , int => 3 } }, $serializer_options ), "serialize part" ); diff --git a/t/003_sax_serializer.t b/t/003_sax_serializer.t index 4db8c57..356091d 100644 --- a/t/003_sax_serializer.t +++ b/t/003_sax_serializer.t @@ -1,8 +1,6 @@ -use Test::More qw/no_plan/; # TODO: change to tests => N; -use Test::Differences; +use Test::More tests => 11; use Data::Dumper; use lib '../lib'; -use Benchmark; use XML::LibXML; use_ok(qw/SOAP::WSDL::SAX::WSDLHandler/); @@ -59,7 +57,7 @@ $opt->{ readable } = 0; is( $schema->find_type( 'myNamespace', 'length3')->serialize( 'TestComplex', { size => -13, unit => 'BLA' } , $opt ), - q{} + q{} . q{-13} . q{BLA} , "serialize complex type" ); @@ -67,7 +65,7 @@ is( $schema->find_type( 'myNamespace', 'length3')->serialize( is( $schema->find_element( 'myNamespace', 'TestElementComplexType')->serialize( undef, { size => -13, unit => 'BLA' } , $opt ), - q{} + q{} . q{-13} . q{BLA}, "element with complex type" @@ -77,8 +75,8 @@ is( $schema->find_type( 'myNamespace', 'complex')->serialize( 'complexComplex', { 'length' => { size => -13, unit => 'BLA' }, 'int' => 1 }, $opt ), - q{} - . q{} + q{} + . q{} . q{-13} . q{BLA} . q{1}, @@ -86,10 +84,10 @@ is( $schema->find_type( 'myNamespace', 'complex')->serialize( ); is( $wsdl->find_message('myNamespace', 'testRequest')->first_part()->serialize( - undef, { length => { size => -13, unit => 'BLA' } , int => 3 }, + undef, { test => { length => { size => -13, unit => 'BLA' } , int => 3 } }, $opt ), - q{} - . q{} + q{} + . q{} . q{-13} . q{BLA} . q{3} diff --git a/t/004_sax_wsdl.t b/t/004_sax_wsdl.t index 65e1c4c..2b279a4 100644 --- a/t/004_sax_wsdl.t +++ b/t/004_sax_wsdl.t @@ -1,13 +1,9 @@ #!/usr/bin/perl -w use strict; use warnings; -use Test::More qw/no_plan/; # TODO: change to tests => N; -use Test::Differences; -# use Devel::Profiler; -use Data::Dumper; +use Test::More tests => 5; use lib '../lib'; use XML::SAX::ParserFactory; -use Benchmark; use diagnostics; @@ -22,17 +18,10 @@ my $filter; ok($filter = SOAP::WSDL::SAX::WSDLHandler->new(), "Object creation"); -#my $parser = XML::SAX::ParserFactory->parser( -# Handler => $filter -#); - use XML::LibXML; my $parser = XML::LibXML->new(); $parser->set_handler( $filter ); -#timethis 10, sub { $parser->parse_string( xml() ) }; -#__END__ - eval { $parser->parse_string( xml() ) }; if ($@) { @@ -60,7 +49,7 @@ my $opt = { indent => "", }; -my $data = { +my $data = { EnqueueMessage => { MMessage => { MRecipientURI => 'anyURI', MSenderAddress => 'a string', @@ -72,7 +61,10 @@ my $data = { MKeepaliveErrorPolicy => ' ( suppress | report ) ', } } +} + }; + SKIP: { skip_without_test_xml(); is_xml( $wsdl->find_message( @@ -89,7 +81,7 @@ sub skip_without_test_xml { sub xml_message { return -q{ +q{ anyURI a string @@ -116,10 +108,10 @@ sub xml { xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"> - + Enqueue message request element diff --git a/t/005_sax_contributed_wsdl.t b/t/005_sax_contributed_wsdl.t index 60b1220..f341128 100644 --- a/t/005_sax_contributed_wsdl.t +++ b/t/005_sax_contributed_wsdl.t @@ -2,11 +2,9 @@ use strict; use warnings; use Test::More qw/no_plan/; # TODO: change to tests => N; -use Test::Differences; use Data::Dumper; use lib '../lib'; use XML::LibXML; -use Benchmark; use diagnostics; diff --git a/t/006_client.t b/t/006_client.t index 02c2058..2a27789 100644 --- a/t/006_client.t +++ b/t/006_client.t @@ -3,8 +3,6 @@ use strict; use warnings; use Pod::Simple::Text; use Test::More qw/no_plan/; # TODO: change to tests => N; -use Test::Differences; -use Data::Dumper; use lib '../lib'; use XML::SAX::ParserFactory; @@ -20,16 +18,16 @@ use Cwd; my $path = cwd; $path =~s|\/t\/?$||; # allow running from t/ and above (Build test) -use_ok(qw/SOAP::WSDL::Client/); +use_ok(qw/SOAP::WSDL/); -my $soap = SOAP::WSDL::Client->new( +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->readable( 1 ) , "Set readable"); ok( $soap->explain() ); @@ -42,10 +40,11 @@ $pod->parse_string_document( $soap->explain() ); SKIP: { skip_without_test_xml(); - is_xml( $soap->call( 'EnqueueMessage' , - 'MMessage' => { - 'MRecipientURI' => 'mailto:test@example.com' , - 'MMessageContent' => 'TestContent for Message' , + is_xml( $soap->call( 'EnqueueMessage' , EnqueueMessage => { + 'MMessage' => { + 'MRecipientURI' => 'mailto:test@example.com' , + 'MMessageContent' => 'TestContent for Message' , + } } ) , q{ - + mailto:test@example.com TestContent for Message } diff --git a/t/008_client_wsdl_complexType.t b/t/008_client_wsdl_complexType.t index fa77c9b..071afd9 100644 --- a/t/008_client_wsdl_complexType.t +++ b/t/008_client_wsdl_complexType.t @@ -3,16 +3,15 @@ use strict; use warnings; use Test::More qw/no_plan/; # TODO: change to tests => N; use lib '../lib'; -use diagnostics; use Cwd; my $path = cwd; $path =~s|\/t\/?$||; # allow running from t/ and above (Build test) -use_ok(qw/SOAP::WSDL::Client/); +use_ok(qw/SOAP::WSDL/); -my $soap = SOAP::WSDL::Client->new( +my $soap = SOAP::WSDL->new( wsdl => 'file:///' . $path .'/t/acceptance/wsdl/008_complexType.wsdl' )->wsdlinit(); diff --git a/t/009_data_classes.t b/t/009_data_classes.t index b819226..3bc95b4 100644 --- a/t/009_data_classes.t +++ b/t/009_data_classes.t @@ -1,13 +1,6 @@ #!/usr/bin/perl -w -use Test::More qw/no_plan/; # TODO: change to tests => N; -#use Devel::Profiler bad_pkgs => [ -# qw(UNIVERSAL Time::HiRes B Carp Exporter Cwd Config CORE DynaLoader -# XSLoader AutoLoader -# Class::Std SOAP::Lite) ]; - -use Scalar::Util; -use strict; -use Test::Differences; +use strict; +use Test::More tests => 5; use lib 't/lib'; use lib '../lib'; use lib 'lib'; @@ -18,7 +11,7 @@ use Cwd; use XML::LibXML::SAX; use_ok(qw/SOAP::WSDL::SAX::MessageHandler/); -use SOAP::WSDL::Client; +use SOAP::WSDL; use SOAP::WSDL::XSD::Typelib::Builtin; my $path = cwd; $path =~s|\/t\/?$||; # allow running from t/ and above (Build test) @@ -46,7 +39,8 @@ else fail "bool context overloading" } -my $soap = SOAP::WSDL::Client->new( +my $soap = SOAP::WSDL->new( + readable => 1, wsdl => 'file:///' . $path .'/t/acceptance/wsdl/006_sax_client.wsdl', )->wsdlinit(); @@ -55,17 +49,9 @@ $soap->servicename('MessageGateway'); ok( $soap->no_dispatch( 1 ) , "Set no_dispatch" ); ok( $soap->readable( 0 ) , "Set readable"); -# print $soap->call( 'EnqueueMessage' -# , MMessage => $filter->get_data()->get_MMessage() ); - -timethese 1000, { +timethese 100, { 'ClassParser' => sub { $parser->parse_string( xml() ); }, -# 'HashParser' => sub { $hash_parser->parse_string( xml() ); }, 'XML::Simple' => sub { return XMLin( xml() ) }, -# 'SOAP::WSDL::Client->call' => sub { -# $soap->call( 'EnqueueMessage' -# , MMessage => $filter->get_data()->get_MMessage() ); -# } }; sub xml { diff --git a/t/013_complexType.t b/t/013_complexType.t index 4b4a0f7..fea23ba 100644 --- a/t/013_complexType.t +++ b/t/013_complexType.t @@ -4,7 +4,6 @@ use strict; use lib 'lib/'; use lib '../lib/'; use lib 't/lib'; -use Data::Dumper; use_ok qw(SOAP::WSDL::XSD::Typelib::ComplexType); use_ok qw( MyComplexType ); diff --git a/t/014_sax_typelib.t b/t/014_sax_typelib.t index f73a213..bc8ec8d 100644 --- a/t/014_sax_typelib.t +++ b/t/014_sax_typelib.t @@ -1,13 +1,9 @@ #!/usr/bin/perl -w use strict; use warnings; -use Test::More qw/no_plan/; # TODO: change to tests => N; -use Test::Differences; -# use Devel::Profiler; -use Data::Dumper; +use Test::More tests => 5; use lib '../lib'; use XML::SAX::ParserFactory; -use Benchmark; use diagnostics; diff --git a/t/015_to_typemap.t b/t/015_to_typemap.t index bde20db..f5a4a34 100644 --- a/t/015_to_typemap.t +++ b/t/015_to_typemap.t @@ -1,13 +1,9 @@ #!/usr/bin/perl -w use strict; use warnings; -use Test::More qw/no_plan/; # TODO: change to tests => N; -use Test::Differences; -# use Devel::Profiler; -use Data::Dumper; +use Test::More tests => 5; use lib '../lib'; use XML::SAX::ParserFactory; -use Benchmark; use diagnostics; diff --git a/t/016_client_object.t b/t/016_client_object.t index 4f25af5..47b92e0 100644 --- a/t/016_client_object.t +++ b/t/016_client_object.t @@ -1,6 +1,7 @@ #!/usr/bin/perl -use Test::More qw(no_plan); +use Test::More tests => 9; use strict; +use diagnostics; use lib 'lib/'; use lib '../lib/'; use lib 't/lib'; @@ -13,17 +14,21 @@ use_ok qw( SOAP::WSDL::Client ); 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'; + , 'element isa'; is $obj, 'Test' . 'Test2' , 'stringification'; -my $soap = SOAP::WSDL::Client->new(); -$soap->proxy('http://bla'); -$soap->no_dispatch(1); +my $soap = SOAP::WSDL::Client->new( { + class_resolver => 'FakeResolver', +} ) + ->proxy('http://bla') + ->no_dispatch(1); is $soap->call('Test', $obj), q{call('Test', $obj), q{Test} . q{Test2} . q{} - , 'SOAP Envelope generation with objects'; \ No newline at end of file + , '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', + ); +} + diff --git a/t/020_storable.t b/t/020_storable.t new file mode 100644 index 0000000..ab7d36f --- /dev/null +++ b/t/020_storable.t @@ -0,0 +1,9 @@ +use Test::More tests => 1; +use lib '../lib'; +eval "require SOAP::WSDL::XSD::Typelib::Builtin"; +use Storable; + +my $long = SOAP::WSDL::XSD::Typelib::Builtin::long->new( { value => 9 }); +my $clone = Storable::thaw( Storable::freeze( $long ) ); + +is $clone->serialize, 9 , 'clone via freeze/thaw'; \ No newline at end of file diff --git a/t/098_pod.t b/t/098_pod.t new file mode 100644 index 0000000..f52784f --- /dev/null +++ b/t/098_pod.t @@ -0,0 +1,27 @@ +use Test::More; +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; + +use Cwd; + +my $dir = cwd; + +if ( $dir =~ /t$/ ) +{ + @directories = ('../lib/'); +} +else +{ + @directories = (); +} + +my @files = all_pod_files( + @directories +); + +plan tests => scalar(@files); + +foreach my $module (@files) +{ + pod_file_ok( $module ) +} \ No newline at end of file diff --git a/t/acceptance/wsdl/02_port.wsdl b/t/acceptance/wsdl/02_port.wsdl index 4bb3564..8781fa1 100644 --- a/t/acceptance/wsdl/02_port.wsdl +++ b/t/acceptance/wsdl/02_port.wsdl @@ -1,7 +1,7 @@ - - - + + @@ -42,22 +42,23 @@ Test-Methode - - + + - + Test-Methode - - + + - + + @@ -67,8 +68,10 @@ + - + + @@ -78,26 +81,28 @@ + - + + - - - - - - - - + + + + + + + + - + - + - + diff --git a/t/acceptance/wsdl/03_complexType-all.wsdl b/t/acceptance/wsdl/03_complexType-all.wsdl index ad970ba..a23ee54 100644 --- a/t/acceptance/wsdl/03_complexType-all.wsdl +++ b/t/acceptance/wsdl/03_complexType-all.wsdl @@ -1,24 +1,24 @@ - - - - - - - ComplexType Test - - - - - - - + + + + + + ComplexType Test + + + + + + + @@ -34,11 +34,11 @@ - - + + - + @@ -53,8 +53,8 @@ - - + + @@ -62,7 +62,7 @@ - + diff --git a/t/acceptance/wsdl/03_complexType-sequence.wsdl b/t/acceptance/wsdl/03_complexType-sequence.wsdl index e6718d0..7ce3493 100644 --- a/t/acceptance/wsdl/03_complexType-sequence.wsdl +++ b/t/acceptance/wsdl/03_complexType-sequence.wsdl @@ -58,8 +58,9 @@ - - + + + @@ -67,21 +68,26 @@ - + + - + + - + + - + + + @@ -90,7 +96,8 @@ - + + diff --git a/t/acceptance/wsdl/04_element-simpleType.wsdl b/t/acceptance/wsdl/04_element-simpleType.wsdl index 35063c3..9d68e2c 100644 --- a/t/acceptance/wsdl/04_element-simpleType.wsdl +++ b/t/acceptance/wsdl/04_element-simpleType.wsdl @@ -1,13 +1,13 @@ - - + @@ -32,12 +32,13 @@ Test-Methode - - + + - + + @@ -47,9 +48,10 @@ + - + diff --git a/t/acceptance/wsdl/04_element.wsdl b/t/acceptance/wsdl/04_element.wsdl index aa9f791..b82269d 100644 --- a/t/acceptance/wsdl/04_element.wsdl +++ b/t/acceptance/wsdl/04_element.wsdl @@ -1,13 +1,13 @@ - - + @@ -24,12 +24,13 @@ Test-Methode - - + + - + + @@ -39,9 +40,10 @@ + - + diff --git a/t/acceptance/wsdl/05_simpleType-list.wsdl b/t/acceptance/wsdl/05_simpleType-list.wsdl index 32ea3ac..bafc8c0 100644 --- a/t/acceptance/wsdl/05_simpleType-list.wsdl +++ b/t/acceptance/wsdl/05_simpleType-list.wsdl @@ -1,13 +1,13 @@ - + @@ -44,13 +44,14 @@ Test-Methode - - + + - - + + + @@ -59,9 +60,10 @@ + - + diff --git a/t/acceptance/wsdl/05_simpleType-restriction.wsdl b/t/acceptance/wsdl/05_simpleType-restriction.wsdl index 4c95098..2033964 100644 --- a/t/acceptance/wsdl/05_simpleType-restriction.wsdl +++ b/t/acceptance/wsdl/05_simpleType-restriction.wsdl @@ -1,13 +1,13 @@ - - + @@ -33,12 +33,13 @@ Test-Methode - - + + - + + @@ -48,9 +49,10 @@ + - + diff --git a/t/acceptance/wsdl/05_simpleType-union.wsdl b/t/acceptance/wsdl/05_simpleType-union.wsdl index da28d79..16226b1 100644 --- a/t/acceptance/wsdl/05_simpleType-union.wsdl +++ b/t/acceptance/wsdl/05_simpleType-union.wsdl @@ -1,13 +1,13 @@ - + @@ -58,22 +58,23 @@ Test-Methode - - + + Test-Methode - - + + - - + + + @@ -82,7 +83,9 @@ - + + + @@ -90,9 +93,10 @@ + - + diff --git a/t/attic/02_port.t b/t/attic/02_port.t index 934e670..dfb493c 100644 --- a/t/attic/02_port.t +++ b/t/attic/02_port.t @@ -1,38 +1,47 @@ -use Test::More tests => 9; -use Cwd; -use File::Basename; +use Test::More tests => 10; +use strict; +use warnings; +use diagnostics; +use Cwd; +use File::Basename; +use Data::Dumper; +use lib '../lib'; + +use_ok(qw/SOAP::WSDL/); + +# chdir to my location +my $cwd = cwd; +my $path = dirname( $0 ); +my $soap = undef; +my $name = basename( $0 ); +$name =~s/\.(t|pl)$//; +chdir $path; + +$path = cwd; + +$path =~s{/attic}{}xms; + +#2 +ok( $soap = SOAP::WSDL->new( + wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl' +), 'Instantiated object' ); + +ok( $soap->wsdlinit(), 'parsed WSDL' ); + +ok( ($soap->servicename('testService') ), 'set service' ); +ok( ($soap->portname('testPort') ) ,'set portname'); + +ok( ($soap->portname() eq 'testPort' ), +"Found first port definition" ); + +ok( ($soap->portname('testPort2') ), +"Found second port definition (based on URL)" ); + +ok( ($soap->portname('testPort3') ), +"Found third port definition (based on Name)" ); + +ok( $soap->wsdlinit( servicename => 'testService', portname => 'testPort'), 'parsed WSDL' ); + +$soap->_wsdl_init_methods(); -use lib '../lib'; - -use_ok(qw/SOAP::WSDL/); - -# chdir to my location -my $cwd = cwd; -my $path = dirname( $0 ); -my $soap = undef; -my $name = basename( $0 ); -$name =~s/\.(t|pl)$//; -chdir $path; - -$path = cwd; - -#2 -ok( $soap = SOAP::WSDL->new( - wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl' -), 'Instantiated object' ); -ok( ($soap->servicename('testService') eq 'testService' ) ); -ok( ($soap->portname('testPort') eq 'testPort' ) ); -ok( $soap->wsdlinit(), 'parsed WSDL' ); - -ok( ($soap->portname() eq 'testPort' ), -"Found first port definition" ); - -ok( ($soap->portname('testPort2') eq 'testPort2' ), -"Found second port definition (based on URL)" ); -ok( $soap->wsdlinit(), 'parsed WSDL' ); -ok( ($soap->portname('testPort3') eq 'testPort3' ), -"Found third port definition (based on Name)" ); - - -ok( $soap->wsdlinit( servicename => 'testService', portname => 'testPort'), 'parsed WSDL' ); ok( ($soap->portname() eq 'testPort' ), 'found port passed to wsdlinit'); \ No newline at end of file diff --git a/t/attic/03_complexType-all.t b/t/attic/03_complexType-all.t index 052157c..5c2b679 100644 --- a/t/attic/03_complexType-all.t +++ b/t/attic/03_complexType-all.t @@ -1,32 +1,32 @@ -BEGIN +use Test::More tests => 8; +use strict; +use warnings; +use lib '../lib'; +use lib 't/lib'; +use lib 'lib'; +use Cwd; +use File::Basename; + +our $SKIP; +eval "use Test::SOAPMessage"; +if ($@) { - chdir 't/' if (-d 't/'); - use Test::More tests => 7;; - use lib '../lib'; - use lib 't/lib'; - use lib 'lib'; - use Cwd; - use File::Basename; - - our $SKIP; - eval "use Test::SOAPMessage"; - if ($@) - { - $SKIP = "Test::Differences required for testing. $@"; - } + $SKIP = "Test::Differences required for testing. "; } - my $path = cwd(); my $name = $0; $name =~s/\.t$//; $name =~s/^t\///; +$path =~s{/attic}{}xms; + use_ok(qw/SOAP::WSDL/); print "# SOAP::WSDL Version: $SOAP::WSDL::VERSION\n"; my $xml; +my $soap; #2 ok( $soap = SOAP::WSDL->new( @@ -36,21 +36,14 @@ ok( $soap = SOAP::WSDL->new( #3 -ok( $soap->wsdlinit( - checkoccurs => 1, -), 'parsed WSDL' ); -$soap->no_dispatch(1); +ok $soap->wsdlinit( checkoccurs => 1, ), 'parse WSDL'; +ok $soap->no_dispatch(1), 'set no dispatch'; -ok ($xml = $soap->serializer->method( $soap->call('test', - testAll => { - Test1 => 'Test 1', - Test2 => 'Test 2', - } -) ), 'Serialized complexType' ); +ok ($xml = $soap->call('test', + Test1 => 'Test 1', + Test2 => 'Test 2', +), 'Serialized complexType' ); -# oprint $xml; - -#exit; open (my $fh, $path . '/acceptance/results/' . $name . '.xml') || die "Cannot open acceptance results file"; @@ -58,13 +51,15 @@ my $testXML = <$fh>; close $fh; SKIP: { - print $SKIP; skip( $SKIP, 1 ) if ($SKIP); eval { soap_eq_or_diff( $xml, $testXML, 'Got expected result') }; }; # $soap->wsdl_checkoccurs(1); +TODO: { + local $TODO = "not implemented yet"; + eval { $xml = $soap->serializer->method( @@ -92,3 +87,4 @@ eval { }; ok($@, 'Died on illegal number of elements (not enough)'); +} \ No newline at end of file diff --git a/t/attic/03_complexType-choice.t b/t/attic/03_complexType-choice.t index 9ff1b8c..d450f38 100644 --- a/t/attic/03_complexType-choice.t +++ b/t/attic/03_complexType-choice.t @@ -1,19 +1,22 @@ -BEGIN -{ - chdir 't/' if (-d 't/'); - use Test::More tests => 7;; - use lib '../lib'; - use lib 't/lib'; - use lib 'lib'; - use Cwd; - use File::Basename; +use Test::More tests => 2; +use lib '../lib'; +use lib 't/lib'; +use lib 'lib'; +use Cwd; +use File::Basename; - our $SKIP; - eval "use Test::SOAPMessage"; - if ($@) - { - $SKIP = "Test::Differences required for testing. $@"; - } -} +our $SKIP; +eval "use Test::SOAPMessage"; +if ($@) { + $SKIP = "Test::Differences required for testing. $@"; + } -use_ok qw/SOAP::WSDL/; \ No newline at end of file +use_ok qw/SOAP::WSDL/; + +my $soap = SOAP::WSDL->new(); + + +TODO: { + local $TODO="implement support"; + fail "serialize choice element"; +} \ No newline at end of file diff --git a/t/attic/03_complexType-complexContent.t b/t/attic/03_complexType-complexContent.t index 9ff1b8c..9559c2e 100644 --- a/t/attic/03_complexType-complexContent.t +++ b/t/attic/03_complexType-complexContent.t @@ -1,19 +1,22 @@ -BEGIN -{ - chdir 't/' if (-d 't/'); - use Test::More tests => 7;; - use lib '../lib'; - use lib 't/lib'; - use lib 'lib'; - use Cwd; - use File::Basename; +use Test::More tests => 2; +use lib '../lib'; +use lib 't/lib'; +use lib 'lib'; +use Cwd; +use File::Basename; - our $SKIP; - eval "use Test::SOAPMessage"; - if ($@) - { - $SKIP = "Test::Differences required for testing. $@"; - } -} +our $SKIP; +eval "use Test::SOAPMessage"; +if ($@) { + $SKIP = "Test::Differences required for testing. $@"; + } -use_ok qw/SOAP::WSDL/; \ No newline at end of file +use_ok qw/SOAP::WSDL/; + +my $soap = SOAP::WSDL->new(); + + +TODO: { + local $TODO="implement support"; + fail "serialize complexContent element"; +} \ No newline at end of file diff --git a/t/attic/03_complexType-group.t b/t/attic/03_complexType-group.t index 9ff1b8c..742370a 100644 --- a/t/attic/03_complexType-group.t +++ b/t/attic/03_complexType-group.t @@ -1,19 +1,22 @@ -BEGIN -{ - chdir 't/' if (-d 't/'); - use Test::More tests => 7;; - use lib '../lib'; - use lib 't/lib'; - use lib 'lib'; - use Cwd; - use File::Basename; +use Test::More tests => 2; +use lib '../lib'; +use lib 't/lib'; +use lib 'lib'; +use Cwd; +use File::Basename; - our $SKIP; - eval "use Test::SOAPMessage"; - if ($@) - { - $SKIP = "Test::Differences required for testing. $@"; - } -} +our $SKIP; +eval "use Test::SOAPMessage"; +if ($@) { + $SKIP = "Test::Differences required for testing. $@"; + } -use_ok qw/SOAP::WSDL/; \ No newline at end of file +use_ok qw/SOAP::WSDL/; + +my $soap = SOAP::WSDL->new(); + + +TODO: { + local $TODO="implement support"; + fail "serialize group element"; +} \ No newline at end of file diff --git a/t/attic/03_complexType-sequence.t b/t/attic/03_complexType-sequence.t index f20cfcb..c141f7e 100644 --- a/t/attic/03_complexType-sequence.t +++ b/t/attic/03_complexType-sequence.t @@ -24,6 +24,8 @@ my $path = cwd(); my $name = $0; $name =~s/\.t$//; +$path=~s{/attic}{}xms; + #2 ok( $soap = SOAP::WSDL->new( wsdl => 'file://' . $path . '/acceptance/wsdl/' . $name . '.wsdl' @@ -34,16 +36,16 @@ ok( $soap->wsdlinit( checkoccurs => 1, ), 'parsed WSDL' ); $soap->no_dispatch(1); -$soap->serializer()->namespace('SOAP-ENV'); -$soap->serializer()->encodingspace('SOAP-ENC'); +$soap->serializer()->envprefix('SOAP-ENV'); +$soap->serializer()->encprefix('SOAP-ENC'); #4 -ok ($xml = $soap->serializer->method( $soap->call('test', +ok $xml = $soap->call('test', testSequence => { Test1 => 'Test 1', Test2 => 'Test 2', } -) ), 'Serialized complexType' ); +), 'Serialized complexType'; #5 open (my $fh, $path . '/acceptance/results/' . $name . '.xml') @@ -53,7 +55,7 @@ close $fh; SKIP: { - skip( 1, $SKIP ) if ($SKIP); + skip( $SKIP, 1 ) if ($SKIP); soap_eq_or_diff( $xml, $testXML, 'Got expected result'); } #6 @@ -86,7 +88,3 @@ eval ok( ($@), "Died on illegal number of elements" ); - - -# chdir back to where we came from -chdir $cwd; \ No newline at end of file diff --git a/t/attic/03_complexType-simpleContent.t b/t/attic/03_complexType-simpleContent.t index 9ff1b8c..bd1d0bc 100644 --- a/t/attic/03_complexType-simpleContent.t +++ b/t/attic/03_complexType-simpleContent.t @@ -1,19 +1,22 @@ -BEGIN -{ - chdir 't/' if (-d 't/'); - use Test::More tests => 7;; - use lib '../lib'; - use lib 't/lib'; - use lib 'lib'; - use Cwd; - use File::Basename; +use Test::More tests => 2; +use lib '../lib'; +use lib 't/lib'; +use lib 'lib'; +use Cwd; +use File::Basename; - our $SKIP; - eval "use Test::SOAPMessage"; - if ($@) - { - $SKIP = "Test::Differences required for testing. $@"; - } -} +our $SKIP; +eval "use Test::SOAPMessage"; +if ($@) { + $SKIP = "Test::Differences required for testing. $@"; + } -use_ok qw/SOAP::WSDL/; \ No newline at end of file +use_ok qw/SOAP::WSDL/; + +my $soap = SOAP::WSDL->new(); + + +TODO: { + local $TODO="implement support"; + fail "serialize simpleContent element"; +} \ No newline at end of file diff --git a/t/attic/04_element-complexType.t b/t/attic/04_element-complexType.t index 682d0d4..657303b 100644 --- a/t/attic/04_element-complexType.t +++ b/t/attic/04_element-complexType.t @@ -1,5 +1,4 @@ - -use Test::More tests => 1; +use Test::More skip_all => 'TODO: implement tests'; use lib '../lib'; -use_ok qw/SOAP::WSDL/; \ No newline at end of file + diff --git a/t/attic/04_element-simpleType.t b/t/attic/04_element-simpleType.t index d1392f2..3ddeb67 100644 --- a/t/attic/04_element-simpleType.t +++ b/t/attic/04_element-simpleType.t @@ -1,23 +1,17 @@ -BEGIN -{ - chdir 't/' if (-d 't/'); +use Test::More; +use strict; +use warnings; +plan qw/no_plan/; +use lib '../lib'; +use lib 't/lib'; +use lib 'lib'; +use Cwd; +use File::Basename; - use Test::More; - plan qw/no_plan/; -# plan "skip_all", "Not yet supported"; -# use Test::More tests => 7;; - use lib '../lib'; - use lib 't/lib'; - use lib 'lib'; - use Cwd; - use File::Basename; - - our $SKIP; - eval "use Test::SOAPMessage"; - if ($@) - { - $SKIP = "Test::Differences required for testing."; - } +our $SKIP; +eval "use Test::SOAPMessage"; +if ($@) { + $SKIP = "Test::Differences required for testing."; } @@ -25,15 +19,13 @@ use_ok(qw/SOAP::WSDL/); my $xml; -# chdir to my location -my $cwd = cwd; -my $path = dirname( $0 ); my $soap = undef; my $name = basename( $0 ); $name =~s/\.(t|pl)$//; -chdir $path; -$path = cwd; +my $path = cwd; + +$path =~s{/attic}{}xms; #2 ok( $soap = SOAP::WSDL->new( @@ -41,53 +33,35 @@ ok( $soap = SOAP::WSDL->new( ), 'Instantiated object' ); #3 +$soap->readable(1); ok( $soap->wsdlinit(), 'parsed WSDL' ); $soap->no_dispatch(1); -$soap->serializer()->namespace('SOAP-ENV'); -$soap->serializer()->encodingspace('SOAP-ENC'); -ok ( $xml = $soap->serializer->method( $soap->call('test', - testAll => 1 ) - ), +ok ( $xml = $soap->call('test', testElement1 => 1 ) , 'Serialized (simpler) element' ); # print $xml, "\n"; - open (my $fh, $path . '/acceptance/results/' . $name . '.xml') - || die 'Cannot open acceptance file ' - . $path . '/acceptance/results/' . $name . '.xml'; - my $testXML = <$fh>; - close $fh; +open (my $fh, $path . '/acceptance/results/' . $name . '.xml') + || die 'Cannot open acceptance file ' + . $path . '/acceptance/results/' . $name . '.xml'; +my $testXML = <$fh>; +close $fh; SKIP: { - skip($SKIP, 1) if ($SKIP); - soap_eq_or_diff( $xml, $testXML, 'Got expected result'); -}; + skip($SKIP, 1) if ($SKIP); + soap_eq_or_diff( $xml, $testXML, 'Got expected result'); +} +TODO: { + local $TODO="implement min/maxOccurs checks"; + + eval { $soap->call('test', testAll => [ 2, 3 ] ); }; + + like $@, qr{illegal\snumber\sof\selements}, "Died on illegal number of elements (too many)"; + + eval { $soap->call('test', testAll => undef ) }; + ok $@, 'Died on illegal number of elements (not enough)'; +} - eval - { - $xml = $soap->serializer->method( - $soap->call('test', - testAll => [ 2, 3 ] - ) - ); - }; - - # print $@; - - ok( ($@ =~m/illegal\snumber\sof\selements/), - "Died on illegal number of elements (too many)" - ); - - eval { - $xml = $soap->serializer->method( - $soap->call('test', - testAll => undef - ) - ) - }; - ok($@, 'Died on illegal number of elements (not enough)'); - -chdir $cwd; \ No newline at end of file diff --git a/t/attic/04_element.t b/t/attic/04_element.t index 59f64a8..089329b 100644 --- a/t/attic/04_element.t +++ b/t/attic/04_element.t @@ -1,74 +1,72 @@ -BEGIN -{ - chdir 't/' if (-d 't/'); +use Test::More tests => 7;; +use strict; +use warnings; +use lib '../lib'; +use lib 't/lib'; +use lib 'lib'; +use Cwd; +use File::Basename; - use Test::More tests => 7;; - use lib '../lib'; - use lib 't/lib'; - use lib 'lib'; - use Cwd; - use File::Basename; - - our $SKIP; - eval "use Test::SOAPMessage"; - if ($@) - { - $SKIP = "Test::Differences required for testing."; - } +our $SKIP; +eval "use Test::SOAPMessage"; +if ($@) { + $SKIP = "Test::Differences required for testing."; } use_ok(qw/SOAP::WSDL/); +my $soap; my $xml; my $path = cwd(); my $name = $0; $name =~s/\.t$//; +$path =~s{/attic}{}xsm; + #2 ok( $soap = SOAP::WSDL->new( wsdl => 'file://' . $path . '/acceptance/wsdl/' . $name . '.wsdl' ), 'Instantiated object' ); #3 +$soap->readable(1); ok( $soap->wsdlinit(), 'parsed WSDL' ); $soap->no_dispatch(1); -$soap->serializer()->namespace('SOAP-ENV'); -$soap->serializer()->encodingspace('SOAP-ENC'); -ok ($xml = $soap->serializer->method( $soap->call('test', - testAll => 'Test' -) ), 'Serialized (simpler) element' ); +ok ($xml = $soap->call('test', + testElement1 => 'Test' +), 'Serialized (simple) element' ); open (my $fh, $path . '/acceptance/results/' . $name . '.xml') || die "Cannot open acceptance results file"; my $testXML = <$fh>; close $fh; -SKIP: -{ - skip( $SKIP, 1 ) if ($SKIP); - soap_eq_or_diff( $xml, $testXML, 'Got expected result'); +SKIP: { + if ($SKIP){ + print $xml; + skip( $SKIP, 1 ); + } + + soap_eq_or_diff( $xml, $testXML, 'Got expected result'); }; -eval -{ - $xml = $soap->serializer->method( - $soap->call('test', +TODO: { + local $TODO="implement min/maxOccurs checks"; + + eval { + $xml = $soap->call('test', testAll => [ 'Test 2', 'Test 3' ] - ) - ); -}; + ); + }; -ok( ($@ =~m/illegal\snumber\sof\selements/), + ok( ($@ =~m/illegal\snumber\sof\selements/), "Died on illegal number of elements (too many)" -); + ); -eval { - $xml = $soap->serializer->method( - $soap->call('test', - testAll => undef - ) - ) -}; -ok($@, 'Died on illegal number of elements (not enough)'); + eval { + $xml = $soap->call('test', testAll => undef ); + }; + ok($@, 'Died on illegal number of elements (not enough)'); +} diff --git a/t/attic/05_simpleType-list.t b/t/attic/05_simpleType-list.t index a972355..7c699dd 100644 --- a/t/attic/05_simpleType-list.t +++ b/t/attic/05_simpleType-list.t @@ -1,98 +1,53 @@ -use Test::More tests => 10; +use Test::More tests => 8; +use strict; use lib '../lib'; use lib 'lib'; use lib 't/lib'; use Cwd; use File::Basename; -use Test::SOAPMessage; -use diagnostics; - use_ok(qw/SOAP::WSDL/); -unless ($SOAP::WSDL::MISSING) { }; - -my ($xml, $xml2); +my ($soap, $xml, $xml2); # chdir to my location -my $cwd = cwd; -my $path = dirname( $0 ); -my $soap = undef; my $name = basename( $0 ); $name =~s/\.(t|pl)$//; -chdir $path; -$path = cwd; +my $path = cwd; +$path =~s{/attic}{}xms; #2 ok( $soap = SOAP::WSDL->new( wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl' ), 'Instantiated object' ); +$soap->readable(1); + #3 ok( $soap->wsdlinit(), 'parsed WSDL' ); $soap->no_dispatch(1); #4 -ok ( $xml = $soap->serializer->method( $soap->call('test', - testAll => [ 1, 2 ] ) - ), - 'Serialized (simple) call (list)' ); +ok $xml = $soap->call('test', testAll => [ 1, 2 ] ), 'Serialize list call'; -#print $xml, "\n"; - -SKIP: { - - open (my $fh, $path . '/acceptance/results/' . $name . '.xml') - || skip("Cannot open acceptance results file", 1); - my $testXML = <$fh>; - close $fh; - #5 - soap_eq_or_diff( $xml, $testXML, 'Got expected result'); -} +print $xml, "\n"; +#5 +ok ( $xml2 = $soap->call('test', testAll => "1 2" ) , 'Serialized scalar call' ); #6 -ok ( $xml2 = $soap->serializer->method( $soap->call('test', - testAll => "1 2" ) - ), - 'Serialized (simple) call (scalar)' ); -#7 ok( $xml eq $xml2, 'Got expected result'); -#8 -ok ( - $xml = $soap->serializer->method( - $soap->call('test', - testAll => 2 - ) - ), "Serialized simple call (scalar value)" -); - -#9 -eval { - $xml = $soap->serializer->method( - $soap->call('test', - testAll => undef - ) - ) -}; -ok($@, 'Died on illegal number of elements (not enough)'); - - -#10 -SKIP: -{ - skip ("maxLength test not implemented", 1) - if ( $SOAP::WSDL::MISSING->{ simpleType }->{ list }->{ maxLength } ); - eval { - $xml = $soap->serializer->method( - $soap->call('test', - testAll => [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 0 ] - ) - ) - }; - ok($@, 'Died on illegal number of elements (more than maxLength)'); - +#7 +TODO: { + local $TODO = "implement minLength check"; + eval { $xml = $soap->call('test', testAll => undef ) }; + ok($@, 'Died on illegal number of elements (not enough)'); } -chdir $cwd; \ No newline at end of file +#8 +TODO: { + local $TODO = "maxLength test not implemented"; + eval { $xml = $soap->call('test', testAll => [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 0 ] ) }; + ok($@, 'Died on illegal number of elements (more than maxLength)'); +} diff --git a/t/attic/05_simpleType-restriction.t b/t/attic/05_simpleType-restriction.t index a9c05d9..42b2c39 100644 --- a/t/attic/05_simpleType-restriction.t +++ b/t/attic/05_simpleType-restriction.t @@ -1,105 +1,57 @@ -use Test::More tests => 9; +use Test::More tests => 8; +use strict; +use warnings; use diagnostics; - use Cwd; use File::Basename; - use lib '../lib'; use lib 'lib'; use lib 't/lib'; -use Test::SOAPMessage; - use_ok(qw/SOAP::WSDL/); my $xml; -# chdir to my location -my $cwd = cwd; -my $path = dirname( $0 ); -my $soap = undef; my $name = basename( $0 ); $name =~s/\.(t|pl)$//; -chdir $path; -$path = cwd; +my $path = cwd; +$path =~s{/attic}{}xms; +my $soap; #2 ok( $soap = SOAP::WSDL->new( wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl' ), 'Instantiated object' ); #3 +$soap->readable(1); ok( $soap->wsdlinit(), 'parsed WSDL' ); $soap->no_dispatch(1); $soap->autotype(0); + #4 -ok ( $xml = $soap->serializer->method( $soap->call('test', - testAll => 1 ) - ), - 'Serialized (simple) call (list)' ); +ok $xml = $soap->call('test', testAll => [ 1, 2 ] ) , 'Serialize list call'; -print $xml, "\n"; +# print $xml, "\n"; - -SKIP: { - skip 'broken', 1; - open (my $fh, $path . '/acceptance/results/' . $name . '.xml') - || skip("Cannot open acceptance results file ". $name . '.xml', 1); - my $testXML = <$fh>; - close $fh; - chomp $testXML; - chomp $xml; +TODO: { + local $TODO = "implement minLength/maxLength checks"; + eval { $soap->call('test', testAll => [ 1, 2, 3 ] ) }; + ok($@, 'Died on illegal number of elements (too many)'); - soap_eq_or_diff( $xml, $testXML, 'Got expected result'); + eval { $soap->call('test', testAll => [] ) }; + ok($@, 'Died on illegal number of elements (not enough)'); } -# 6 -eval { - $xml = $soap->serializer->method( - $soap->call('test', - testAll => [ 1, 2 ] - ) - ) -}; -ok($@, 'Died on illegal number of elements (not enough)'); - -eval { - $xml = $soap->serializer->method( - $soap->call('test', - testAll => undef - ) - ) -}; -ok($@, 'Died on illegal number of elements (not enough)'); - -SKIP: -{ - skip( "minValue check not implemented ", 1) - if ($SOAP::WSDL::MISSING->{ simpleType }->{ restriction }->{ minValue }); - eval { - $xml = $soap->serializer->method( - $soap->call('test', - testAll => 0 - ) - ) - }; - ok($@, 'Died on illegal value'); +TODO: { + local $TODO = "minValue check not implemented "; + eval { $xml = $soap->call('test', testAll => 0 ) }; + ok($@, 'Died on illegal value'); } -SKIP: -{ - skip( "maxValue check not implemented ", 1) - if ($SOAP::WSDL::MISSING->{ simpleType }->{ restriction }->{ maxValue }); - eval { - $xml = $soap->serializer->method( - $soap->call('test', - testAll => 100 - ) - ) - }; - ok($@, 'Died on illegal value'); +TODO: { + local $TODO = "maxValue check not implemented "; + eval { $xml = $soap->call('test', testAll => 100 ) }; + ok($@, 'Died on illegal value'); } - - -chdir $cwd; \ No newline at end of file diff --git a/t/attic/05_simpleType-union.t b/t/attic/05_simpleType-union.t index dd66f47..338ea90 100644 --- a/t/attic/05_simpleType-union.t +++ b/t/attic/05_simpleType-union.t @@ -1,41 +1,36 @@ -use Test::More tests => 9; +use Test::More skip_all => 'Not supported yet'; +use strict; +use warnings; use Cwd; use File::Basename; use lib '../lib'; -use_ok(qw/SOAP::WSDL/); +use_ok qw/SOAP::WSDL/; my $xml; - -# chdir to my location -my $cwd = cwd; -my $path = dirname( $0 ); my $soap = undef; my $name = basename( $0 ); $name =~s/\.(t|pl)$//; -chdir $path; -$path = cwd; +my $path = cwd; + +$path =~s{/attic}{}xms; #2 -ok( $soap = SOAP::WSDL->new( +ok $soap = SOAP::WSDL->new( wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl' -), 'Instantiated object' ); +), 'Instantiated object'; #3 -ok( $soap->wsdlinit(), 'parsed WSDL' ); +$soap->readable(1); +ok $soap->wsdlinit(), 'parsed WSDL'; $soap->no_dispatch(1); -$soap->serializer()->namespace('SOAP-ENV'); -$soap->serializer()->encodingspace('SOAP-ENC'); #4 -ok ( $xml = $soap->serializer->method( $soap->call('test', - testAll => 1 ) - ), - 'Serialized (simple) call (list)' ); +ok $xml = $soap->call('test', testAll => 1 ) , 'Serialized call'; -# print $xml, "\n"; +print $xml, "\n"; SKIP: { @@ -81,5 +76,3 @@ eval { ) }; ok($@, 'Died on illegal number of elements (not enough)'); - -chdir $cwd; \ No newline at end of file diff --git a/t/attic/11_helloworld.NET.t b/t/attic/11_helloworld.NET.t index f8ac2cd..7ec8c17 100644 --- a/t/attic/11_helloworld.NET.t +++ b/t/attic/11_helloworld.NET.t @@ -28,19 +28,6 @@ print "Acceptance test against sample output with simple WSDL\n"; my $data = { name => 'test', givenName => 'test', -# test => { -# name => 'TESTNAME', -# givenName => 'GIVENNAME', -# }, -# test1 => { -# name => 'TESTNAME', -# givenName => 'GIVENNAME', -# extend => 'EXTEND', -# }, -# test2 => { -# name => 'TESTNAME', -# givenName => 'GIVENNAME', -# } }; my $t0 = [gettimeofday]; @@ -54,6 +41,8 @@ chdir $path; $path = cwd; +$path =~s{/attic}{}xms; + ok( $soap=SOAP::WSDL->new( wsdl => 'file:///'.$path.'/acceptance/wsdl/11_helloworld.wsdl', @@ -71,9 +60,9 @@ print "WSDL init (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ; $t0 = [gettimeofday]; do { - my $xml = $soap->serializer->method( $soap->call(sayHello => %{ $data }) ); + my $xml = $soap->call('sayHello', 'sayHello' => %{ $data }); - open (FILE, "acceptance/results/11_helloworld.xml") + open (FILE, "../acceptance/results/11_helloworld.xml") || open (FILE, "t/acceptance/results/11_helloworld.xml") || die "can't open acceptance file"; my $xml_test=; close FILE; @@ -94,9 +83,9 @@ do { $t0 = [gettimeofday]; do { - my $xml = $soap->serializer->method( $soap->call(sayHello => %{ $data }) ); + my $xml = $soap->call(sayHello => %{ $data }); - open (FILE, "acceptance/results/11_helloworld.xml") + open (FILE, "../acceptance/results/11_helloworld.xml") || open FILE, ("t/acceptance/results/11_helloworld.xml") || die "can't open acceptance file"; my $xml_test=; close FILE; diff --git a/t/lib/MyElement.pm b/t/lib/MyElement.pm index 678e40e..653263e 100644 --- a/t/lib/MyElement.pm +++ b/t/lib/MyElement.pm @@ -20,7 +20,7 @@ package MyTestElement; use strict; use Class::Std::Storable; use SOAP::WSDL::XSD::Typelib::Element; -use SOAP::WSDL::XSD::Typelib::Builtin; +use SOAP::WSDL::XSD::Typelib::Builtin::string; use base ( 'SOAP::WSDL::XSD::Typelib::Element', 'SOAP::WSDL::XSD::Typelib::Builtin::string', @@ -28,8 +28,9 @@ use base ( sub START { my ($self, $ident, $args_of) =@_; - $self->__set_name('MyTestElement'); } + +__PACKAGE__->__set_name('MyTestElement'); sub get_xmlns { 'urn:Test' };