Compare commits

...

5 Commits

Author SHA1 Message Date
Martin Kutter
3de318be40 import SOAP-WSDL 2.00.06 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00.06
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00.06.tar.gz
2009-12-12 19:48:54 -08:00
Martin Kutter
c2ac24dd0f import SOAP-WSDL 2.00.05 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00.05
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00.05.tar.gz
2009-12-12 19:48:45 -08:00
Martin Kutter
c3e3d1908e import SOAP-WSDL 2.00.04 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00.04
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00.04.tar.gz
2009-12-12 19:48:44 -08:00
Martin Kutter
e58a27e2ad 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
2009-12-12 19:48:40 -08:00
Martin Kutter
915ee03cbe import SOAP-WSDL 2.00.02 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00.02
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00.02.tar.gz
2009-12-12 19:48:35 -08:00
202 changed files with 4539 additions and 3158 deletions

View File

@@ -5,7 +5,7 @@ $build = Module::Build->new(
create_makefile_pl => 'small',
dist_abstract => 'SOAP with WSDL support',
dist_name => 'SOAP-WSDL',
dist_version => '2.00.01',
dist_version => '2.00.06',
module_name => 'SOAP::WSDL',
license => 'artistic',
requires => {
@@ -22,7 +22,7 @@ $build = Module::Build->new(
'Getopt::Long' => 0,
'List::Util' => 0,
'LWP::UserAgent' => 0,
'Template' => 0,
'Template' => q(2.18),
'Term::ReadKey' => 0,
'URI' => 0,
'XML::Parser::Expat' => 0,
@@ -41,7 +41,7 @@ $build = Module::Build->new(
'File::Spec' => 0,
'Storable' => 0,
'Test::More' => 0,
'Template' => 0,
'Template' => q(2.18),
'XML::Parser::Expat' => 0,
},
recursive_test_files => 1,

105
Changes
View File

@@ -1,4 +1,4 @@
Release notes for SOAP::WSDL 2.00.01
Release notes for SOAP::WSDL 2.00.06
-------
I'm proud to present a new release of SOAP::WSDL.
@@ -27,7 +27,7 @@ Features:
* SOAP::Lite like look and feel
o Where possible, SOAP::WSDL mimics SOAP::Lite's API to allow easy migration
* XML schema based class library for creating data objects
* High-performance XML parser
* High-performance SOAP Message parser
* Plugin support. SOAP::WSDL can be extended through plugins in various aspects.
The following plugins are supported:
o Transport plugins via SOAP::WSDL::Factory::Transport
@@ -36,6 +36,107 @@ Features:
The following changes have been made:
2.00.06 - Dec 03 2008
The following bugs have been fixed (the numbers in square brackets are the
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
The numbers with # are CPAN RT IDs (http://rt.cpan.org/).
* #40658 wsdl2perl - prefix option
The prefix option is now changed to behave more practical
* #40802 wsdl2perl problems with special url
The "fixed" attribute caused an error.
* #40650 Deserialization on inherited types
The inherited complexType variety (sequence/all/choice...) did not get
propagated to derived complexTypes. Thus, derived complexTypes which did
not add elements lost all inherited elements.
* #40108 Test failure on Cygwin
Fixes a test failure on Cygwin due to a malformed file:// URL
* #40021 charset: utf-8
Removed duplicate charset in HTTP requests issued by
SOAP::WSDL::Transport::HTTP. Replaced the utf8 by utf-8 in HTTP requests
* #39715 Error with complexType extension base without child elements
A rather subtle error caused by a wrong init value (undef) for the list
of child elements in a complexType sequence.
* [ 2005693 ] <maxLength fixed ="true"> causes error
* [ 2023797 ] type extensions not handled correctly
ComplexType objects now test their elements with ->isa, not with ref
* [ 2021755 ] Generating nested complexType extensions throws errors
2.00.05 - Jul 13 2008
The following bugs have been fixed (the numbers in square brackets are the
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
The numbers with # are CPAN RT IDs (http://rt.cpan.org/).
* [ 2014482 ] Big-O memory hole when parsing WSDL
SOAP::WSDL still leaks memory when using SOAP::Lite's transport backend
This is to be fixed in 0.710.08 in SOAP::Lite
* #36865 wsdl2perl.pl fails on Expat error
Resolved by dropping a note for Solaris in README
* [ 2005693 ] <maxLength fixed ="true"> causes error
The >fixed< attribute is now recognized (but has no effect yet)
The following uncategorized improvements have been made:
* added missing Class::Std::Storable::Fast import flags to
SOAP::WSDL::XSD::Typelib::Builtin::IDREFS
* some code cleanup
2.00.04
The following bugs have been fixed (the numbers in square brackets are the
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
The numbers with # are CPAN RT IDs (http://rt.cpan.org/).
* [ 1972059 ] Can't set timeout via SOAP::WSDL
* [ 1961409 ] Error with unqualified references in imported schema
* #35873: SOAP::WSDL -- Can't locate object method "set_Action" via package "SOAP::WSDL::OpMessage"
* [ 1969427 ] Mod_Perl.t broken when mod_perl is unavailable
* #35610 Test fails when Test::Without::Module is installed
The following uncategorized improvements have been made:
* Changed the environment variable for author tests to "RELEASE_TESTING",
as defined by the Oslo QA Hackathon 2008
(see http://perl-qa.hexten.net/wiki/index.php/Oslo_QA_Hackathon_2008_:Achievements)
* Enhanced documentation
* Fixed a wrong error message
* Cleaned up test suite (removed duplicate tests)
2.00.03 - May 18 2008
The following bugs have been fixed (the numbers in square brackets are the
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
The numbers with # are CPAN RT IDs (http://rt.cpan.org/).
* [ 1966575 ] 2.00.02 produced bad code with complexType extensions
2.00.02 - May 16 2008
The following features were added (the numbers in square brackets are the
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
* [ 1941134 ] Server for mod_perl2. Thanks to Noah Robin for contributing.
(I actually forgot to include it in 2.00.01)
The following bugs have been fixed (the numbers in square brackets are the
tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
The numbers with # are CPAN RT IDs (http://rt.cpan.org/).
* [ 1963613 ] ComplexTypes die on ->can('FOOBAR');
* [ 1943667 ] Error parsing complexType/extension
* [ 1960650 ] multi-level inheritance of complexTypes fails
* [ 1960319 ] ComplexType as_hash_ref returns objects on maximum depth
* [ 1943673 ] Relative schemaLocation="" URLs not resolved in <import>
* [ 1953598 ] Cannot set server and attribute prefixes with wsdl2perl
* [ 1941080 ] 017_generator.t (test 2) fails with Template-Toolkit 2.15
* [ 1949209 ] spelling/grammar in Mod_Perl2.pm
* [ 1950670 ] on_action removed in SOAP::WSDL >= 2.00
* #35346 element ref="" not handled properly
The following uncategorized improvements have been made:
2.00.01
The following features were added (the numbers in square brackets are the

141
LICENSE
View File

@@ -2,6 +2,145 @@ SOAP::WSDL is dual licensed under the same terms as
Perl itself.
This means at your choice, either the Perl Artistic License, or
the GNU GPL version 1 or higher.
the GNU GPL version 1 or - at your choice - any higher version.
The GNU GPL can be obtained from
http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt
Newer versions can be found at http://www.gnu.org/licenses/gpl.html
The Artistic License can be obtained from
http://dev.perl.org/licenses/artistic.html and is included below.
ARTISTIC LICENSE
================
The "Artistic License"
Preamble
The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.
Definitions:
"Package" refers to the collection of files distributed by the
Copyright Holder, and derivatives of that collection of files
created through textual modification.
"Standard Version" refers to such a Package if it has not been
modified, or has been modified in accordance with the wishes
of the Copyright Holder as specified below.
"Copyright Holder" is whoever is named in the copyright or
copyrights for the package.
"You" is you, if you're thinking about copying or distributing
this Package.
"Reasonable copying fee" is whatever you can justify on the
basis of media cost, duplication charges, time of people involved,
and so on. (You will not be required to justify it to the
Copyright Holder, but only to the computing community at large
as a market that must bear the fee.)
"Freely Available" means that no fee is charged for the item
itself, though there may be fees involved in handling the item.
It also means that recipients of the item may redistribute it
under the same conditions they received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A Package
modified in such a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this
Package. You may not charge a fee for this Package itself. However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End

View File

@@ -1,12 +1,15 @@
benchmark/01_expat.t
benchmark/hello.pl
benchmark/MEMORY_FOOTPRINT
benchmark/person.pl
benchmark/person.xml
benchmark/person_profile.pl
benchmark/person_single.pl
benchmark/README
benchmark/XSD/01_anyType.t
benchmark/XSD/02_anySimpleType.t
benchmark/XSD/03_string.t
benchmark/XSD/strftime.pl
bin/wsdl2perl.pl
Build.PL
Changes
@@ -157,7 +160,9 @@ lib/SOAP/WSDL/Generator/Visitor.pm
lib/SOAP/WSDL/Generator/Visitor/Typelib.pm
lib/SOAP/WSDL/Generator/Visitor/Typemap.pm
lib/SOAP/WSDL/Manual.pod
lib/SOAP/WSDL/Manual/Cookbook.pod
lib/SOAP/WSDL/Manual/Deserializer.pod
lib/SOAP/WSDL/Manual/FAQ.pod
lib/SOAP/WSDL/Manual/Glossary.pod
lib/SOAP/WSDL/Manual/Parser.pod
lib/SOAP/WSDL/Manual/Serializer.pod
@@ -172,6 +177,7 @@ lib/SOAP/WSDL/PortType.pm
lib/SOAP/WSDL/Serializer/XSD.pm
lib/SOAP/WSDL/Server.pm
lib/SOAP/WSDL/Server/CGI.pm
lib/SOAP/WSDL/Server/Mod_Perl2.pm
lib/SOAP/WSDL/Service.pm
lib/SOAP/WSDL/SOAP/Address.pm
lib/SOAP/WSDL/SOAP/Body.pm
@@ -264,21 +270,16 @@ MANIFEST This list of files
META.yml
MIGRATING
README
SOAP-WSDL-2.00_32.tar
t/001_use.t
t/002_parse_wsdl.t
t/003_wsdl_based_serializer.t
t/004_parse_wsdl.t
t/006_client.t
t/007_envelope.t
t/008_client_wsdl_complexType.t
t/009_data_classes.t
t/011_simpleType.t
t/012_element.t
t/013_complexType.t
t/016_client_object.t
t/017_generator.t
t/020_storable.t
t/094_cpan_meta.t
t/095_copying.t
t/096_characters.t
t/097_kwalitee.t
@@ -315,6 +316,7 @@ t/acceptance/wsdl/email_account.wsdl
t/acceptance/wsdl/generator_test.wsdl
t/acceptance/wsdl/generator_test_dot_names.wsdl
t/acceptance/wsdl/generator_unsupported_test.wsdl
t/acceptance/wsdl/helloWorld_header.wsdl
t/acceptance/wsdl/import.xsd
t/acceptance/wsdl/import_loop.xsd
t/acceptance/wsdl/message_gateway.wsdl
@@ -322,9 +324,14 @@ t/acceptance/wsdl/nested_complextype.wsdl
t/acceptance/wsdl/WSDLParser-import.wsdl
t/acceptance/wsdl/WSDLParser-imported.wsdl
t/acceptance/wsdl/WSDLParser.wsdl
t/acceptance/wsdl/WSDLParser/import_cascade.xsd
t/acceptance/wsdl/WSDLParser/import_no_location.wsdl
t/acceptance/wsdl/WSDLParser/import_xsd_cascade.wsdl
t/acceptance/wsdl/WSDLParser/imported.xsd
t/acceptance/wsdl/WSDLParser/xsd_import_no_location.wsdl
t/acceptance/wsdl/WSDLParser_import_loop.wsdl
t/contributed.wsdl
t/Expat/03_wsdl.t
t/lib/Mod_Perl2Test.pm
t/lib/MyComplexType.pm
t/lib/MyElement.pm
t/lib/MySimpleType.pm
@@ -336,7 +343,6 @@ t/lib/Typelib/Base.pm
t/lib/Typelib/TEnqueueMessage.pm
t/lib/Typelib/TMessage.pm
t/SOAP/WSDL.t
t/SOAP/WSDL/01_use.t
t/SOAP/WSDL/02_port.t
t/SOAP/WSDL/03_complexType-all.t
t/SOAP/WSDL/03_complexType-choice.t
@@ -354,6 +360,7 @@ t/SOAP/WSDL/05_simpleType-union.t
t/SOAP/WSDL/06_keep_alive.t
t/SOAP/WSDL/11_helloworld.NET.t
t/SOAP/WSDL/12_binding.t
t/SOAP/WSDL/Base.t
t/SOAP/WSDL/Client.t
t/SOAP/WSDL/Client/Base.t
t/SOAP/WSDL/Definitions.t
@@ -366,11 +373,12 @@ t/SOAP/WSDL/Expat/WSDLParser.t
t/SOAP/WSDL/Factory/Deserializer.t
t/SOAP/WSDL/Factory/Serializer.t
t/SOAP/WSDL/Factory/Transport.t
t/SOAP/WSDL/Generator/attr.pl
t/SOAP/WSDL/Generator/Template.t
t/SOAP/WSDL/Generator/Template/XSD/Import.t
t/SOAP/WSDL/Generator/Visitor.t
t/SOAP/WSDL/Generator/Visitor/Typemap.t
t/SOAP/WSDL/Generator/XSD.t
t/SOAP/WSDL/Generator/XSD_custom_resolver.t
t/SOAP/WSDL/Generator/XSD_dot_names.t
t/SOAP/WSDL/Generator/XSD_nested_complextype.t
t/SOAP/WSDL/Generator/XSD_unsupported.t
@@ -379,10 +387,11 @@ t/SOAP/WSDL/PortType.t
t/SOAP/WSDL/Serializer/XSD.t
t/SOAP/WSDL/Server.t
t/SOAP/WSDL/Server/CGI.t
t/SOAP/WSDL/Server/Mod_Perl2.t
t/SOAP/WSDL/Transport/01_Test.t
t/SOAP/WSDL/Transport/02_HTTP.t
t/SOAP/WSDL/Transport/acceptance/test2.xml
t/SOAP/WSDL/Transport/acceptance/test3.xml
t/SOAP/WSDL/Transport/HTTP.t
t/SOAP/WSDL/Typelib/Fault11.t
t/SOAP/WSDL/Types.t
t/SOAP/WSDL/XSD/Attribute.t
@@ -394,7 +403,6 @@ t/SOAP/WSDL/XSD/Enumeration.t
t/SOAP/WSDL/XSD/Schema.t
t/SOAP/WSDL/XSD/SimpleType.t
t/SOAP/WSDL/XSD/Typelib/Attribute.t
t/SOAP/WSDL/XSD/Typelib/Builtin/01_constructors.t
t/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.t
t/SOAP/WSDL/XSD/Typelib/Builtin/anyType.t
t/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.t
@@ -405,8 +413,14 @@ t/SOAP/WSDL/XSD/Typelib/Builtin/date.t
t/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.t
t/SOAP/WSDL/XSD/Typelib/Builtin/decimal.t
t/SOAP/WSDL/XSD/Typelib/Builtin/double.t
t/SOAP/WSDL/XSD/Typelib/Builtin/duration.t
t/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.t
t/SOAP/WSDL/XSD/Typelib/Builtin/float.t
t/SOAP/WSDL/XSD/Typelib/Builtin/gDay.t
t/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.t
t/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.t
t/SOAP/WSDL/XSD/Typelib/Builtin/gYear.t
t/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.t
t/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.t
t/SOAP/WSDL/XSD/Typelib/Builtin/ID.t
t/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.t
@@ -426,6 +440,7 @@ t/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.t
t/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.t
t/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.t
t/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.t
t/SOAP/WSDL/XSD/Typelib/Builtin/QName.t
t/SOAP/WSDL/XSD/Typelib/Builtin/short.t
t/SOAP/WSDL/XSD/Typelib/Builtin/string.t
t/SOAP/WSDL/XSD/Typelib/Builtin/time.t
@@ -443,4 +458,5 @@ t/SOAP/WSDL_NO_MESSAGE.wsdl
t/SOAP/WSDL_NO_PORTTYPE.wsdl
t/test.wsdl
TEST_COVERAGE
test_html.pl
TODO

170
META.yml
View File

@@ -1,6 +1,6 @@
---
name: SOAP-WSDL
version: 2.00.01
version: 2.00.06
author:
- 'Martin Kutter <martin.kutter@fen-net.de>'
abstract: SOAP with WSDL support
@@ -17,7 +17,7 @@ requires:
Getopt::Long: 0
LWP::UserAgent: 0
List::Util: 0
Template: 0
Template: 2.18
Term::ReadKey: 0
URI: 0
XML::Parser::Expat: 0
@@ -35,220 +35,226 @@ build_requires:
List::Util: 0
Module::Build: 0
Storable: 0
Template: 0
Template: 2.18
Test::More: 0
XML::Parser::Expat: 0
provides:
SOAP::WSDL:
file: lib/SOAP/WSDL.pm
version: 2.00.01
version: 2.00.06
SOAP::WSDL::Base:
file: lib/SOAP/WSDL/Base.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Binding:
file: lib/SOAP/WSDL/Binding.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Client:
file: lib/SOAP/WSDL/Client.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Client::Base:
file: lib/SOAP/WSDL/Client/Base.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Definitions:
file: lib/SOAP/WSDL/Definitions.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Deserializer::Hash:
file: lib/SOAP/WSDL/Deserializer/Hash.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Deserializer::SOM:
file: lib/SOAP/WSDL/Deserializer/SOM.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Deserializer::XSD:
file: lib/SOAP/WSDL/Deserializer/XSD.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Expat::Base:
file: lib/SOAP/WSDL/Expat/Base.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Expat::Message2Hash:
file: lib/SOAP/WSDL/Expat/Message2Hash.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Expat::MessageParser:
file: lib/SOAP/WSDL/Expat/MessageParser.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Expat::MessageStreamParser:
file: lib/SOAP/WSDL/Expat/MessageStreamParser.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Expat::WSDLParser:
file: lib/SOAP/WSDL/Expat/WSDLParser.pm
version: 2.00.05
SOAP::WSDL::Factory::Deserializer:
file: lib/SOAP/WSDL/Factory/Deserializer.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Factory::Generator:
file: lib/SOAP/WSDL/Factory/Generator.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Factory::Serializer:
file: lib/SOAP/WSDL/Factory/Serializer.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Factory::Transport:
file: lib/SOAP/WSDL/Factory/Transport.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Generator::Iterator::WSDL11:
file: lib/SOAP/WSDL/Generator/Iterator/WSDL11.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Generator::PrefixResolver:
file: lib/SOAP/WSDL/Generator/PrefixResolver.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Generator::Template:
file: lib/SOAP/WSDL/Generator/Template.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Generator::Template::Plugin::XSD:
file: lib/SOAP/WSDL/Generator/Template/Plugin/XSD.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Generator::Template::XSD:
file: lib/SOAP/WSDL/Generator/Template/XSD.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Generator::Visitor:
file: lib/SOAP/WSDL/Generator/Visitor.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Generator::Visitor::Typelib:
file: lib/SOAP/WSDL/Generator/Visitor/Typelib.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Generator::Visitor::Typemap:
file: lib/SOAP/WSDL/Generator/Visitor/Typemap.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Message:
file: lib/SOAP/WSDL/Message.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::OpMessage:
file: lib/SOAP/WSDL/OpMessage.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Operation:
file: lib/SOAP/WSDL/Operation.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Part:
file: lib/SOAP/WSDL/Part.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Port:
file: lib/SOAP/WSDL/Port.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::PortType:
file: lib/SOAP/WSDL/PortType.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::SOAP::Address:
file: lib/SOAP/WSDL/SOAP/Address.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::SOAP::Body:
file: lib/SOAP/WSDL/SOAP/Body.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::SOAP::Header:
file: lib/SOAP/WSDL/SOAP/Header.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::SOAP::HeaderFault:
file: lib/SOAP/WSDL/SOAP/HeaderFault.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::SOAP::Operation:
file: lib/SOAP/WSDL/SOAP/Operation.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::SOAP::Typelib::Fault11:
file: lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Serializer::XSD:
file: lib/SOAP/WSDL/Serializer/XSD.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Server:
file: lib/SOAP/WSDL/Server.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Server::CGI:
file: lib/SOAP/WSDL/Server/CGI.pm
version: 2.00.01
version: 2.00.06
SOAP::WSDL::Server::Mod_Perl2:
file: lib/SOAP/WSDL/Server/Mod_Perl2.pm
version: 2.00.05
SOAP::WSDL::Service:
file: lib/SOAP/WSDL/Service.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Transport::HTTP:
file: lib/SOAP/WSDL/Transport/HTTP.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Transport::Loopback:
file: lib/SOAP/WSDL/Transport/Loopback.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Transport::Test:
file: lib/SOAP/WSDL/Transport/Test.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::TypeLookup:
file: lib/SOAP/WSDL/TypeLookup.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::Types:
file: lib/SOAP/WSDL/Types.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Annotation:
file: lib/SOAP/WSDL/XSD/Annotation.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Attribute:
file: lib/SOAP/WSDL/XSD/Attribute.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::AttributeGroup:
file: lib/SOAP/WSDL/XSD/AttributeGroup.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Builtin:
file: lib/SOAP/WSDL/XSD/Builtin.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::ComplexType:
file: lib/SOAP/WSDL/XSD/ComplexType.pm
version: 2.00.01
version: 2.00.06
SOAP::WSDL::XSD::Element:
file: lib/SOAP/WSDL/XSD/Element.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Enumeration:
file: lib/SOAP/WSDL/XSD/Enumeration.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::FractionDigits:
file: lib/SOAP/WSDL/XSD/FractionDigits.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Group:
file: lib/SOAP/WSDL/XSD/Group.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Length:
file: lib/SOAP/WSDL/XSD/Length.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::MaxExclusive:
file: lib/SOAP/WSDL/XSD/MaxExclusive.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::MaxInclusive:
file: lib/SOAP/WSDL/XSD/MaxInclusive.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::MaxLength:
file: lib/SOAP/WSDL/XSD/MaxLength.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::MinExclusive:
file: lib/SOAP/WSDL/XSD/MinExclusive.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::MinInclusive:
file: lib/SOAP/WSDL/XSD/MinInclusive.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::MinLength:
file: lib/SOAP/WSDL/XSD/MinLength.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Pattern:
file: lib/SOAP/WSDL/XSD/Pattern.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Schema:
file: lib/SOAP/WSDL/XSD/Schema.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Schema::Builtin:
file: lib/SOAP/WSDL/XSD/Schema/Builtin.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::SimpleType:
file: lib/SOAP/WSDL/XSD/SimpleType.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::TotalDigits:
file: lib/SOAP/WSDL/XSD/TotalDigits.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Typelib::Attribute:
file: lib/SOAP/WSDL/XSD/Typelib/Attribute.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Typelib::AttributeSet:
file: lib/SOAP/WSDL/XSD/Typelib/AttributeSet.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Typelib::Builtin:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Typelib::Builtin::ENTITY:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
SOAP::WSDL::XSD::Typelib::Builtin::ID:
@@ -273,14 +279,14 @@ provides:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm
SOAP::WSDL::XSD::Typelib::Builtin::anyType:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm
version: 2.00_29
version: 2.00.05
SOAP::WSDL::XSD::Typelib::Builtin::anyURI:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm
SOAP::WSDL::XSD::Typelib::Builtin::base64Binary:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
SOAP::WSDL::XSD::Typelib::Builtin::boolean:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
version: 2.00_23
version: 2.00.05
SOAP::WSDL::XSD::Typelib::Builtin::byte:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
SOAP::WSDL::XSD::Typelib::Builtin::date:
@@ -333,7 +339,7 @@ provides:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
SOAP::WSDL::XSD::Typelib::Builtin::time:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
version: 2.00_25
version: 2.00.05
SOAP::WSDL::XSD::Typelib::Builtin::token:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte:
@@ -346,20 +352,20 @@ provides:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
SOAP::WSDL::XSD::Typelib::ComplexType:
file: lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Typelib::Element:
file: lib/SOAP/WSDL/XSD/Typelib/Element.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Typelib::SimpleType:
file: lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::Typelib::SimpleType::restriction:
file: lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
version: 2.00.01
version: 2.00.05
SOAP::WSDL::XSD::WhiteSpace:
file: lib/SOAP/WSDL/XSD/WhiteSpace.pm
version: 2.00.01
generated_by: Module::Build version 0.2808
version: 2.00.05
generated_by: Module::Build version 0.3
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
version: 1.2

View File

@@ -1,4 +1,5 @@
# Note: this file was auto-generated by Module::Build::Compat version 0.03
# Note: this file was auto-generated by Module::Build::Compat version 0.30
require 5.8.0;
use Module::Build::Compat 0.02;
Module::Build::Compat->run_build_pl(args => \@ARGV);

11
README
View File

@@ -41,4 +41,13 @@ If you don't have Module::Build installed, you may also use
make install
Note that Module::Build is the recommended installer - make will not run
all tests provided with SOAP-WSDL.
all tests provided with SOAP-WSDL.
SOLARIS INSTALLATION NOTES
--------------------------
According to a CPAN RT report http://rt.cpan.org/Ticket/Display.html?id=36865
it may be necessary to check (and possibly update) the expat libraries
required by XML::Parser.
SOAP::WSDL's metadata includes XML::Parser, but it seems that the expat
libraries XML::Parser depends on may slip through missing or outdated.

Binary file not shown.

View File

@@ -6,12 +6,18 @@
# Note that this shell script requires Devel::CoverX::Covered - if you
# don't have it, comment out the line noted below
#
cd t/
cover -delete
find . -type f -name '*.t' | xargs -n 1 /usr/bin/perl -MDevel::Cover=-silent,1,-summary,0 -I../lib
perl -Ilib -It/lib -MTAP::Harness -MFile::Find::Rule -e '
local $ENV{TEST_VERBOSE} = 1;
TAP::Harness->new({
merge => 1,
lib => [ q{t/lib}, q{lib} ],
switches => [ q{-MDevel::Cover=-ignore,.,-select,^lib/.+,-coverage,statement,-coverage,subroutine,-coverage,condition,-coverage,branch} ],
})->runtests( sort { $a cmp $b } File::Find::Rule->file()->name( q{*.t} )->in( q{t/} ) );
'
# Devel::CoverX::Covered
covered runs
# covered runs
cover -ignore_re \.t$ -ignore_re ^lib -coverage="statement" -coverage=condition -coverage=subroutine -coverage="branch"
cover -coverage="statement" -coverage=condition -coverage=subroutine -coverage="branch"

View File

@@ -0,0 +1,59 @@
Memory footprints for example/ scripts comparing SOAP::WSDL, SOAP::Lite and
XML::Compile::SOAP
Results with perl-5.8.8 on Ubuntu 8.04 (x86):
PID %CPU %MEM VSZ RSS COMMAND
10183 12.0 1.1 14292 11492 perl -I../lib hello.pl
10554 7.2 0.9 12636 9828 perl hello_lite.pl
10224 17.5 1.6 20780 17012 perl hello_compile.pl
10287 25.0 1.1 14680 11776 perl -I../lib person.pl
10313 24.0 1.6 21068 17312 perl person_compile.pl
Summary of my perl5 (revision 5 version 8 subversion 8) configuration:
Platform:
osname=linux, osvers=2.6.15.7, archname=i486-linux-gnu-thread-multi
uname='linux palmer 2.6.15.7 #1 smp thu sep 7 19:42:20 utc 2006 i686 gnulinux '
config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i486-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.8 -Dsitearch=/usr/local/lib/perl/5.8.8 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.8 -Dd_dosuid -des'
hint=recommended, useposix=true, d_sigaction=define
usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include'
ccversion='', gccversion='4.2.3 20071123 (prerelease) (Ubuntu 4.2.2-3ubuntu4)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
perllibs=-ldl -lm -lpthread -lc -lcrypt
libc=/lib/libc-2.6.1.so, so=so, useshrplib=true, libperl=libperl.so.5.8.8
gnulibc_version='2.6.1'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'
Characteristics of this binary (from libperl):
Compile-time options: MULTIPLICITY PERL_IMPLICIT_CONTEXT
PERL_MALLOC_WRAP THREADS_HAVE_PIDS USE_ITHREADS
USE_LARGE_FILES USE_PERLIO USE_REENTRANT_API
Built under linux
Compiled at Nov 27 2007 10:44:36
@INC:
/etc/perl
/usr/local/lib/perl/5.8.8
/usr/local/share/perl/5.8.8
/usr/lib/perl5
/usr/share/perl5
/usr/lib/perl/5.8
/usr/share/perl/5.8
/usr/local/lib/site_perl
.

77
benchmark/README Normal file
View File

@@ -0,0 +1,77 @@
The benchmark directory includes a bunch of benchmarks. The most notable
ones are listed below.
Comparison benchmarks for SOAP::Lite, SOAP::WSDL, SOAP::WSDL_XS, and
XML::Compile::WSDP need all of these installed for the benchmark to
work (building and adding to the lib path suffices). All comparison benchmarks
only account for the client part of the respective modules - the server part
is not benchmarked.
SOAP::WSDL_XS can be obtained from the project's subversion repository at
https://soap-wsdl.svn.sourceforge.net/svnroot/SOAP-WSDL/SOAP-WSDL_XS/trunk
Some benchmarks expect to find the SOAP servers "cgi-bin/person.pl" and
"cgi-bin/hello.pl" from the examples directory at
http://localhost:81/soap-wsdl-test/person.pl and
http://localhost:81/soap-wsdl-test/hello.pl
If the web services are not set up properly, you're benchmarking error
creation times.
To set up a SOAP server using apache, add the following to your apache config:
# usually in main config
Listen 127.0.0.1:81
# maybe in a
#<VirtualHost 127.0.0.1:81> container
#
ScriptAlias /soap-wsdl-test/ /PATH_TO/SOAP-WSDL/example/cgi-bin/
<Directory "/PATH_TO/SOAP-WSDL/example/cgi-bin">
AllowOverride None
Order allow,deny
Allow from all
</Directory>
Using mod_perl is highly recommended to cut down benchmarking time.
COMPARISON BENCHMARKS
=====================
01_expat.t
----------
Benchmarks XML parsing speed between XML::Simple with XML::Parser as backend,
SOAP::Lite, SOAP::WSDL outputting objects, SOAP::WSDL outputting hash refs,
XML::LibXML with a simple DOM walker outputting hash refs, XML::LibXML
outputting the DOM and SOAP::WSDL_XS.
No web server required.
This benchmark sheds light on how much performance is - in theory - reachable
by each approach: The XML::LibXML (Hash) benchmark converts the DOM into
a nested hash using a recursive function. This is - basically - how
XML::Compile works. XML::Simple uses XML::Parser's streaming
API. SOAP::WSDL uses XML::Parser::Expat, XML::Parser's low-level backend,
to create objects or - in the (Hash) variant - nested hashes similar to
those created by XML::Simple.
SOAP::WSDL_XS uses a libexpat-based XS parser to create perl objects, and
XML::LibXML (DOM) creates a C level libxml2 DOM accessible from perl.
person.pl:
----------
Sends a empty requests and receives a response of ca. 10kB.
Modeled after a common enterprise setup: "Give me a list of person data sets".
For this benchmark, XML parsing speed is important. XML generation speed is
only weighted in the last two runs, and weights around 1/10 of parsing speed.
hello.pl:
---------
Sends a request containing name and given name and politely replies
"Hello <given name> <name>".
An example for very short requests and responses.
For this example, handling and generating small requests/responses, and
transport speed is important. As the XML transmitted is relatively small, the
transport layer's overhead is important.

24
benchmark/XSD/strftime.pl Normal file
View File

@@ -0,0 +1,24 @@
use Benchmark qw(cmpthese);
use POSIX ();
use Date::Format ();
my @time_from = localtime;
print "Comparing POSIX::strftime and Date::Format::strftime '%Y-%m-%dT%H:%M:%S%z'\n\n";
print 'POSIX: ', POSIX::strftime('%Y-%m-%dT%H:%M:%S%z', @time_from), "\n";
print 'Date::Format: ', Date::Format::strftime('%Y-%m-%dT%H:%M:%S%z', @time_from), "\n";
cmpthese 100000, {
POSIX => sub { POSIX::strftime('%Y-%m-%dT%H:%M:%S%z', @time_from) },
'Date::Format' => sub { Date::Format::strftime('%Y-%m-%dT%H:%M:%S%z', @time_from) },
};
__END__
results with perl-5.8.8 on Ubuntu 8.04 on a Thinkpad T42 (1.7GHz Dothan):
Rate Date::Format POSIX
Date::Format 10684/s -- -93%
POSIX 153846/s 1340% --

View File

@@ -82,17 +82,17 @@ my $person = {
my $compile = XML::Compile::WSDL11->new('../example/wsdl/Person.wsdl',
sloppy_integers => 1,
check_values => 0,
check_values => 0,
validation => 0,
ignore_facets => 1,
);
#
# Call all variants once to allow their first-time tasks to be done
#
my $call = $compile->compileClient('ListPerson');
$call->({ in => undef});
# Initialize SOAP::Lite
my $deserializer = SOAP::Deserializer->new();
# Initialize SOAP::WSDL interface
my $soap = MyInterfaces::TestService::TestPort->new();
# Load all classes - XML::Compile has created everything before, too
@@ -102,6 +102,15 @@ my $lite = SOAP::Lite->new()->default_ns('http://www.example.org/benchmark/')
->proxy('http://localhost:81/soap-wsdl-test/person.pl');
$lite->on_action( sub { 'http://www.example.org/benchmark/ListPerson' } );
$lite->ListPerson();
my $lite_xml = SOAP::Lite->new()->default_ns('http://www.example.org/benchmark/')
->proxy('http://localhost:81/soap-wsdl-test/person.pl');
$lite_xml->on_action( sub { 'http://www.example.org/benchmark/ListPerson' } );
$lite_xml->outputxml(1);
$lite_xml->ListPerson();
# # register for SOAP 1.1
SOAP::WSDL::Factory::Deserializer->register('1.1' => 'SOAP::WSDL::Deserializer::XSD_XS' );
my $wsdl_xs = MyInterfaces::TestService::TestPort->new();
@@ -114,24 +123,34 @@ SOAP::Lite - $SOAP::Lite::VERSION
SOAP::WSDL - $SOAP::WSDL::Client::VERSION
SOAP::WSDL_XS - $SOAP::WSDL::Deserializer::XSD_XS::VERSION;
XML::Compile::SOAP - $XML::Compile::SOAP::VERSION
XML::Simple - $XML::Simple::VERSION
XML::Simple uses XML::Parser as backend and SOAP::Lite with
outputxml(1) set as SOAP client.
XML::Parser - $XML::Parser::VERSION
XML::Simple is not benchmarked in run 3ff, as it is expected
do deliver the same result.
Benchmark $n: Store result in private variable and destroy it
";
$n++;
cmpthese $count, {
'SOAP::WSDL' => sub { my $result = $soap->ListPerson({}) },
'XML::Compile' => sub { my $result = $call->() },
'SOAP::WSDL_XS' => sub { my $result = $wsdl_xs->ListPerson({}) },
'SOAP::Lite' => sub { my $som = $lite->call('ListPerson') },
'SOAP::WSDL' => sub { my $result = $soap->ListPerson({}) },
'SOAP::WSDL_XS' => sub { my $result = $wsdl_xs->ListPerson({}) },
'XML::Compile' => sub { my $result = $call->() },
'XML::Simple' => sub { my $result = XMLin( $lite_xml->call('ListPerson')) },
};
print "\nBenchmark $n: Push result on list\n";
$n++;
cmpthese $count, {
'SOAP::WSDL' => sub { push @data, $soap->ListPerson({}) },
'XML::Compile' => sub { push @data, $call->() },
'SOAP::WSDL_XS' => sub { push @data, $wsdl_xs->ListPerson({}) },
'SOAP::Lite' => sub { push @data, $lite->call('ListPerson') },
'SOAP::WSDL' => sub { push @data, $soap->ListPerson({}) },
'SOAP::WSDL_XS' => sub { push @data, $wsdl_xs->ListPerson({}) },
'XML::Compile' => sub { push @data, $call->() },
'XML::Simple' => sub { push @data, XMLin( $lite_xml->call('ListPerson')) },
};
@data = ();

View File

@@ -5,7 +5,7 @@ use lib '../../SOAP-WSDL_XS/blib/arch';
use strict;
use Benchmark;
use Storable;
#use SOAP::WSDL::Deserializer::XSD_XS;
use SOAP::WSDL::Deserializer::XSD_XS;
use SOAP::WSDL::Factory::Deserializer;
# # register for SOAP 1.1
SOAP::WSDL::Factory::Deserializer->register('1.1' => 'SOAP::WSDL::Deserializer::XSD_XS' );
@@ -16,10 +16,10 @@ my @data = ();
my $soap = MyInterfaces::TestService::TestPort->new();
# Load all classes - XML::Compile has created everything before, too
#timethis 100, sub { $soap->ListPerson({}) };
#timethis 50, sub { push @data, $soap->ListPerson({}) };
#@data = ();
# timethis 50, sub { push @data, $soap->ListPerson({}) };
timethis 150, sub { $soap->ListPerson({}) };
timethis 300, sub { push @data, $soap->ListPerson({}) };
@data = ();
timethis 300, sub { push @data, $soap->ListPerson({}) };
# for (1..50) { push @data, $soap->ListPerson({}) };
#print $soap->ListPerson({});

View File

@@ -10,11 +10,13 @@ use Term::ReadKey;
my %opt = (
url => '',
prefix => undef,
type_prefix => 'MyTypes',
element_prefix => 'MyElements',
typemap_prefix => 'MyTypemaps',
interface_prefix => 'MyInterfaces',
prefix => 'My',
attribute_prefix => undef,
type_prefix => undef,
element_prefix => undef,
typemap_prefix => undef,
interface_prefix => undef,
server_prefix => undef,
base_path => 'lib/',
proxy => undef,
generator => 'XSD',
@@ -51,10 +53,12 @@ my %opt = (
GetOptions(\%opt,
qw(
prefix|p=s
attribute_prefix|a=s
type_prefix|t=s
element_prefix|e=s
typemap_prefix|m=s
interface_prefix|i=s
server_prefix|sp=s
base_path|b=s
typemap_include|mi=s
help|h
@@ -63,7 +67,7 @@ GetOptions(\%opt,
user=s
password=s
generator=s
server
server|s
namespaces|n
)
);
@@ -87,6 +91,20 @@ my $parser = SOAP::WSDL::Expat::WSDLParser->new({
user_agent => $lwp,
});
# resolve the default prefix options
map {
my $opt_key = $_;
if ( $opt_key =~ / (\w+) _prefix $/xms # relevant option
&& !$opt{ $opt_key } # that hasn't already been explicitly set
)
{
my $prefix_type = $1;
$opt{ $opt_key } = $opt{prefix} . # My
ucfirst( $prefix_type ) . # Typemap
( $prefix_type eq 'server' ? '' : 's' ); # s
}
} keys %opt;
my $definitions = $parser->parse_uri( $url );
my %typemap = ();
@@ -107,12 +125,22 @@ if (%typemap) {
}
};
$generator->set_type_prefix( $opt{ type_prefix }) if $generator->can('set_type_prefix');
$generator->set_typemap_prefix( $opt{ typemap_prefix }) if $generator->can('set_typemap_prefix');
$generator->set_element_prefix($opt{ element_prefix }) if $generator->can('set_element_prefix');
$generator->set_interface_prefix($opt{ interface_prefix }) if $generator->can('set_interface_prefix');
$generator->set_OUTPUT_PATH($opt{ base_path }) if $generator->can('set_OUTPUT_PATH');
$generator->set_definitions($definitions) if $generator->can('set_definitions');
$generator->set_attribute_prefix( $opt{ attribute_prefix })
if $generator->can('set_attribute_prefix');
$generator->set_type_prefix( $opt{ type_prefix })
if $generator->can('set_type_prefix');
$generator->set_typemap_prefix( $opt{ typemap_prefix })
if $generator->can('set_typemap_prefix');
$generator->set_element_prefix($opt{ element_prefix })
if $generator->can('set_element_prefix');
$generator->set_interface_prefix($opt{ interface_prefix })
if $generator->can('set_interface_prefix');
$generator->set_server_prefix($opt{ server_prefix })
if $generator->can('set_server_prefix');
$generator->set_OUTPUT_PATH($opt{ base_path })
if $generator->can('set_OUTPUT_PATH');
$generator->set_definitions($definitions)
if $generator->can('set_definitions');
# $generator->set_wsdl($xml) if $generator->can('set_wsdl');
# start with typelib, as errors will most likely occur here...
@@ -136,7 +164,11 @@ wsdl2perl.pl - create perl bindings for SOAP webservices.
NAME SHORT DESCRITPION
----------------------------------------------------------------------------
prefix p Prefix for both type and element classes.
prefix p Prefix for all generated classes. If you set "-p=Foo",
you will get "FooAttributes", "FooTypes",
"FooElements" and so on.
attribute_prefix a Prefix for XML attribute classes.
Default: MyAttributes
type_prefix t Prefix for type classes.
Default: MyTypes
element_prefix e Prefix for element classes.
@@ -145,6 +177,8 @@ wsdl2perl.pl - create perl bindings for SOAP webservices.
Default: MyTypemaps
interface_prefix i Prefix for interface classes.
Default: MyInterfaces
server_prefix sp Prefix for server classes.
Default: MyServer
base_path b Path to create classes in.
Default: .
typemap_include mi File to include in typemap. Must eval() to a valid

View File

@@ -1,3 +1,4 @@
package MyElements::CountCookies;
use strict;
use warnings;
@@ -17,13 +18,30 @@ use base qw(
SOAP::WSDL::XSD::Typelib::ComplexType
);
our $XML_ATTRIBUTE_CLASS;
undef $XML_ATTRIBUTE_CLASS;
sub __get_attr_class {
return $XML_ATTRIBUTE_CLASS;
}
# There's no variety - empty complexType
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
__PACKAGE__->_factory();
} # end of BLOCK
1;
# __END__
=pod
@@ -36,6 +54,21 @@ MyElements::CountCookies
Perl data type class for the XML Schema defined element
CountCookies from the namespace http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx.
=head1 PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
=over
=head1 METHODS
=head2 new

View File

@@ -1,3 +1,4 @@
package MyElements::CountCookiesResponse;
use strict;
use warnings;
@@ -16,6 +17,14 @@ use base qw(
SOAP::WSDL::XSD::Typelib::Element
SOAP::WSDL::XSD::Typelib::ComplexType
);
our $XML_ATTRIBUTE_CLASS;
undef $XML_ATTRIBUTE_CLASS;
sub __get_attr_class {
return $XML_ATTRIBUTE_CLASS;
}
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
@@ -26,14 +35,18 @@ Class::Std::initialize();
my %CountCookiesResult_of :ATTR(:get<CountCookiesResult>);
__PACKAGE__->_factory(
[ qw(
CountCookiesResult
[ qw( CountCookiesResult
) ],
{
CountCookiesResult => \%CountCookiesResult_of,
'CountCookiesResult' => \%CountCookiesResult_of,
},
{
CountCookiesResult => 'SOAP::WSDL::XSD::Typelib::Builtin::int',
'CountCookiesResult' => 'SOAP::WSDL::XSD::Typelib::Builtin::int',
},
{
'CountCookiesResult' => 'CountCookiesResult',
}
);
@@ -44,11 +57,12 @@ __PACKAGE__->_factory(
} # end of BLOCK
1;
# __END__
=pod
@@ -61,6 +75,30 @@ MyElements::CountCookiesResponse
Perl data type class for the XML Schema defined element
CountCookiesResponse from the namespace http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx.
=head1 PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
=over
=item * CountCookiesResult
$element->set_CountCookiesResult($data);
$element->get_CountCookiesResult();
=back
=head1 METHODS
=head2 new

View File

@@ -1,3 +1,4 @@
package MyElements::GetFortuneCookie;
use strict;
use warnings;
@@ -17,13 +18,30 @@ use base qw(
SOAP::WSDL::XSD::Typelib::ComplexType
);
our $XML_ATTRIBUTE_CLASS;
undef $XML_ATTRIBUTE_CLASS;
sub __get_attr_class {
return $XML_ATTRIBUTE_CLASS;
}
# There's no variety - empty complexType
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
__PACKAGE__->_factory();
} # end of BLOCK
1;
# __END__
=pod
@@ -36,6 +54,21 @@ MyElements::GetFortuneCookie
Perl data type class for the XML Schema defined element
GetFortuneCookie from the namespace http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx.
=head1 PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
=over
=head1 METHODS
=head2 new

View File

@@ -1,3 +1,4 @@
package MyElements::GetFortuneCookieResponse;
use strict;
use warnings;
@@ -16,6 +17,14 @@ use base qw(
SOAP::WSDL::XSD::Typelib::Element
SOAP::WSDL::XSD::Typelib::ComplexType
);
our $XML_ATTRIBUTE_CLASS;
undef $XML_ATTRIBUTE_CLASS;
sub __get_attr_class {
return $XML_ATTRIBUTE_CLASS;
}
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
@@ -26,14 +35,18 @@ Class::Std::initialize();
my %GetFortuneCookieResult_of :ATTR(:get<GetFortuneCookieResult>);
__PACKAGE__->_factory(
[ qw(
GetFortuneCookieResult
[ qw( GetFortuneCookieResult
) ],
{
GetFortuneCookieResult => \%GetFortuneCookieResult_of,
'GetFortuneCookieResult' => \%GetFortuneCookieResult_of,
},
{
GetFortuneCookieResult => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
'GetFortuneCookieResult' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
},
{
'GetFortuneCookieResult' => 'GetFortuneCookieResult',
}
);
@@ -44,11 +57,12 @@ __PACKAGE__->_factory(
} # end of BLOCK
1;
# __END__
=pod
@@ -61,6 +75,30 @@ MyElements::GetFortuneCookieResponse
Perl data type class for the XML Schema defined element
GetFortuneCookieResponse from the namespace http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx.
=head1 PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
=over
=item * GetFortuneCookieResult
$element->set_GetFortuneCookieResult($data);
$element->get_GetFortuneCookieResult();
=back
=head1 METHODS
=head2 new

View File

@@ -1,3 +1,4 @@
package MyElements::GetSpecificCookie;
use strict;
use warnings;
@@ -16,6 +17,14 @@ use base qw(
SOAP::WSDL::XSD::Typelib::Element
SOAP::WSDL::XSD::Typelib::ComplexType
);
our $XML_ATTRIBUTE_CLASS;
undef $XML_ATTRIBUTE_CLASS;
sub __get_attr_class {
return $XML_ATTRIBUTE_CLASS;
}
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
@@ -26,14 +35,18 @@ Class::Std::initialize();
my %index_of :ATTR(:get<index>);
__PACKAGE__->_factory(
[ qw(
index
[ qw( index
) ],
{
index => \%index_of,
'index' => \%index_of,
},
{
index => 'SOAP::WSDL::XSD::Typelib::Builtin::int',
'index' => 'SOAP::WSDL::XSD::Typelib::Builtin::int',
},
{
'index' => 'index',
}
);
@@ -44,11 +57,12 @@ __PACKAGE__->_factory(
} # end of BLOCK
1;
# __END__
=pod
@@ -61,6 +75,30 @@ MyElements::GetSpecificCookie
Perl data type class for the XML Schema defined element
GetSpecificCookie from the namespace http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx.
=head1 PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
=over
=item * index
$element->set_index($data);
$element->get_index();
=back
=head1 METHODS
=head2 new

View File

@@ -1,3 +1,4 @@
package MyElements::GetSpecificCookieResponse;
use strict;
use warnings;
@@ -16,6 +17,14 @@ use base qw(
SOAP::WSDL::XSD::Typelib::Element
SOAP::WSDL::XSD::Typelib::ComplexType
);
our $XML_ATTRIBUTE_CLASS;
undef $XML_ATTRIBUTE_CLASS;
sub __get_attr_class {
return $XML_ATTRIBUTE_CLASS;
}
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
@@ -26,14 +35,18 @@ Class::Std::initialize();
my %GetSpecificCookieResult_of :ATTR(:get<GetSpecificCookieResult>);
__PACKAGE__->_factory(
[ qw(
GetSpecificCookieResult
[ qw( GetSpecificCookieResult
) ],
{
GetSpecificCookieResult => \%GetSpecificCookieResult_of,
'GetSpecificCookieResult' => \%GetSpecificCookieResult_of,
},
{
GetSpecificCookieResult => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
'GetSpecificCookieResult' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
},
{
'GetSpecificCookieResult' => 'GetSpecificCookieResult',
}
);
@@ -44,11 +57,12 @@ __PACKAGE__->_factory(
} # end of BLOCK
1;
# __END__
=pod
@@ -61,6 +75,30 @@ MyElements::GetSpecificCookieResponse
Perl data type class for the XML Schema defined element
GetSpecificCookieResponse from the namespace http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx.
=head1 PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
=over
=item * GetSpecificCookieResult
$element->set_GetSpecificCookieResult($data);
$element->get_GetSpecificCookieResult();
=back
=head1 METHODS
=head2 new

View File

@@ -1,3 +1,4 @@
package MyElements::int;
use strict;
use warnings;
@@ -14,14 +15,12 @@ __PACKAGE__->__set_ref();
use base qw(
SOAP::WSDL::XSD::Typelib::Element
SOAP::WSDL::XSD::Typelib::Builtin::int
);
}
} # end of BLOCK
1;
# __END__
=pod
@@ -34,6 +33,12 @@ MyElements::int
Perl data type class for the XML Schema defined element
int from the namespace http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx.
=head1 METHODS
=head2 new

View File

@@ -1,3 +1,4 @@
package MyElements::readNodeCount;
use strict;
use warnings;
@@ -17,13 +18,30 @@ use base qw(
SOAP::WSDL::XSD::Typelib::ComplexType
);
our $XML_ATTRIBUTE_CLASS;
undef $XML_ATTRIBUTE_CLASS;
sub __get_attr_class {
return $XML_ATTRIBUTE_CLASS;
}
# There's no variety - empty complexType
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
__PACKAGE__->_factory();
} # end of BLOCK
1;
# __END__
=pod
@@ -36,6 +54,21 @@ MyElements::readNodeCount
Perl data type class for the XML Schema defined element
readNodeCount from the namespace http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx.
=head1 PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
=over
=head1 METHODS
=head2 new

View File

@@ -1,3 +1,4 @@
package MyElements::readNodeCountResponse;
use strict;
use warnings;
@@ -16,6 +17,14 @@ use base qw(
SOAP::WSDL::XSD::Typelib::Element
SOAP::WSDL::XSD::Typelib::ComplexType
);
our $XML_ATTRIBUTE_CLASS;
undef $XML_ATTRIBUTE_CLASS;
sub __get_attr_class {
return $XML_ATTRIBUTE_CLASS;
}
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
@@ -26,14 +35,18 @@ Class::Std::initialize();
my %readNodeCountResult_of :ATTR(:get<readNodeCountResult>);
__PACKAGE__->_factory(
[ qw(
readNodeCountResult
[ qw( readNodeCountResult
) ],
{
readNodeCountResult => \%readNodeCountResult_of,
'readNodeCountResult' => \%readNodeCountResult_of,
},
{
readNodeCountResult => 'SOAP::WSDL::XSD::Typelib::Builtin::int',
'readNodeCountResult' => 'SOAP::WSDL::XSD::Typelib::Builtin::int',
},
{
'readNodeCountResult' => 'readNodeCountResult',
}
);
@@ -44,11 +57,12 @@ __PACKAGE__->_factory(
} # end of BLOCK
1;
# __END__
=pod
@@ -61,6 +75,30 @@ MyElements::readNodeCountResponse
Perl data type class for the XML Schema defined element
readNodeCountResponse from the namespace http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx.
=head1 PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
=over
=item * readNodeCountResult
$element->set_readNodeCountResult($data);
$element->get_readNodeCountResult();
=back
=head1 METHODS
=head2 new

View File

@@ -1,27 +1,26 @@
package MyElements::string;
use strict;
use warnings;
{ # BLOCK to scope variables
sub get_xmlns { 'http://www.webserviceX.NET' }
sub get_xmlns { 'http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx' }
__PACKAGE__->__set_name('string');
__PACKAGE__->__set_nillable(true);
__PACKAGE__->__set_nillable(1);
__PACKAGE__->__set_minOccurs();
__PACKAGE__->__set_maxOccurs();
__PACKAGE__->__set_ref();
use base qw(
SOAP::WSDL::XSD::Typelib::Element
SOAP::WSDL::XSD::Typelib::Builtin::string
);
}
} # end of BLOCK
1;
# __END__
=pod
@@ -32,7 +31,13 @@ MyElements::string
=head1 DESCRIPTION
Perl data type class for the XML Schema defined element
string from the namespace http://www.webserviceX.NET.
string from the namespace http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx.
=head1 METHODS

View File

@@ -13,6 +13,8 @@ sub START {
$_[0]->set_proxy('http://www.fullerdata.com/FortuneCookie/FortuneCookie.asmx') if not $_[2]->{proxy};
$_[0]->set_class_resolver('MyTypemaps::FullerData_x0020_Fortune_x0020_Cookie')
if not $_[2]->{class_resolver};
$_[0]->set_prefix($_[2]->{use_prefix}) if exists $_[2]->{use_prefix};
}
sub readNodeCount {
@@ -24,10 +26,11 @@ sub readNodeCount {
style => 'document',
body => {
'use' => 'literal',
namespace => '',
encodingStyle => '',
parts => [qw( MyElements::readNodeCount )],
'use' => 'literal',
namespace => 'http://schemas.xmlsoap.org/wsdl/soap/',
encodingStyle => '',
parts => [qw( MyElements::readNodeCount )],
},
header => {
@@ -38,6 +41,7 @@ sub readNodeCount {
}, $body, $header);
}
sub GetFortuneCookie {
my ($self, $body, $header) = @_;
die "GetFortuneCookie must be called as object method (\$self is <$self>)" if not blessed($self);
@@ -47,10 +51,11 @@ sub GetFortuneCookie {
style => 'document',
body => {
'use' => 'literal',
namespace => '',
encodingStyle => '',
parts => [qw( MyElements::GetFortuneCookie )],
'use' => 'literal',
namespace => 'http://schemas.xmlsoap.org/wsdl/soap/',
encodingStyle => '',
parts => [qw( MyElements::GetFortuneCookie )],
},
header => {
@@ -61,6 +66,7 @@ sub GetFortuneCookie {
}, $body, $header);
}
sub CountCookies {
my ($self, $body, $header) = @_;
die "CountCookies must be called as object method (\$self is <$self>)" if not blessed($self);
@@ -70,10 +76,11 @@ sub CountCookies {
style => 'document',
body => {
'use' => 'literal',
namespace => '',
encodingStyle => '',
parts => [qw( MyElements::CountCookies )],
'use' => 'literal',
namespace => 'http://schemas.xmlsoap.org/wsdl/soap/',
encodingStyle => '',
parts => [qw( MyElements::CountCookies )],
},
header => {
@@ -84,6 +91,7 @@ sub CountCookies {
}, $body, $header);
}
sub GetSpecificCookie {
my ($self, $body, $header) = @_;
die "GetSpecificCookie must be called as object method (\$self is <$self>)" if not blessed($self);
@@ -93,10 +101,11 @@ sub GetSpecificCookie {
style => 'document',
body => {
'use' => 'literal',
namespace => '',
encodingStyle => '',
parts => [qw( MyElements::GetSpecificCookie )],
'use' => 'literal',
namespace => 'http://schemas.xmlsoap.org/wsdl/soap/',
encodingStyle => '',
parts => [qw( MyElements::GetSpecificCookie )],
},
header => {
@@ -109,6 +118,7 @@ sub GetSpecificCookie {
1;
@@ -119,21 +129,20 @@ __END__
=head1 NAME
MyInterfaces::FullerData_x0020_Fortune_x0020_Cookie::FullerData_x0020_Fortune_x0020_CookieSoap - SOAP Interface for the FullerData_x0020_Fortune_x0020_Cookie Web Service
=head1 SYNOPSIS
use MyInterfaces::FullerData_x0020_Fortune_x0020_Cookie::FullerData_x0020_Fortune_x0020_CookieSoap;
my $interface = MyInterfaces::FullerData_x0020_Fortune_x0020_Cookie::FullerData_x0020_Fortune_x0020_CookieSoap->new();
my $response;
$response = $interface->readNodeCount();
$response = $interface->GetFortuneCookie();
$response = $interface->CountCookies();
$response = $interface->GetSpecificCookie();
=head1 DESCRIPTION
@@ -168,42 +177,58 @@ of the corresponding class can be passed instead of the marked hash ref.
You may pass any combination of objects, hash and list refs to these
methods, as long as you meet the structure.
List items (i.e. multiple occurences) are not displayed in the synopsis.
You may generally pass a list ref of hash refs (or objects) instead of a hash
ref - this may result in invalid XML if used improperly, though. Note that
SOAP::WSDL always expects list references at maximum depth position.
XML attributes are not displayed in this synopsis and cannot be set using
hash refs. See the respective class' documentation for additional information.
=head3 readNodeCount
Display the number of nodes specified in fortune XML document
$interface->readNodeCount(,,
Returns a L<MyElements::readNodeCountResponse|MyElements::readNodeCountResponse> object.
$response = $interface->readNodeCount(,,
);
=head3 GetFortuneCookie
Get a random fortune cookie from the XML document
$interface->GetFortuneCookie(,,
Returns a L<MyElements::GetFortuneCookieResponse|MyElements::GetFortuneCookieResponse> object.
$response = $interface->GetFortuneCookie(,,
);
=head3 CountCookies
Count the actual number of nodes in the XML document of fortunes
$interface->CountCookies(,,
Returns a L<MyElements::CountCookiesResponse|MyElements::CountCookiesResponse> object.
$response = $interface->CountCookies(,,
);
=head3 GetSpecificCookie
Get a specific cookie by the XML node number
$interface->GetSpecificCookie( {
Returns a L<MyElements::GetSpecificCookieResponse|MyElements::GetSpecificCookieResponse> object.
$response = $interface->GetSpecificCookie( {
index => $some_value, # int
},,
);
=head1 AUTHOR
Generated by SOAP::WSDL on Sun Dec 16 19:58:30 2007
Generated by SOAP::WSDL on Wed Dec 3 22:05:20 2008
=pod
=cut

View File

@@ -1,3 +1,4 @@
package MyTypemaps::FullerData_x0020_Fortune_x0020_Cookie;
use strict;
use warnings;
@@ -38,11 +39,13 @@ sub get_typemap {
__END__
__END__
=pod
=head1 NAME
MyTypemaps::FullerData_x0020_Fortune_x0020_Cookie; - typemap for ::FullerData_x0020_Fortune_x0020_Cookie;
MyTypemaps::FullerData_x0020_Fortune_x0020_Cookie - typemap for FullerData_x0020_Fortune_x0020_Cookie
=head1 DESCRIPTION

View File

@@ -10,15 +10,14 @@ use Carp;
use Scalar::Util qw(blessed);
use SOAP::WSDL::Client;
use SOAP::WSDL::Expat::WSDLParser;
use Class::Std::Fast;
use Class::Std::Fast constructor => 'none';
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
use LWP::UserAgent;
use version; our $VERSION= qv('2.00.01');
use version; our $VERSION = qv('2.00.06');
my %no_dispatch_of :ATTR(:name<no_dispatch>);
my %wsdl_of :ATTR(:name<wsdl>);
my %proxy_of :ATTR(:name<proxy>);
my %autotype_of :ATTR(:name<autotype>);
my %outputxml_of :ATTR(:name<outputxml> :default<0>);
my %outputtree_of :ATTR(:name<outputtree>);
@@ -42,7 +41,6 @@ my %LOOKUP = (
no_dispatch => \%no_dispatch_of,
class_resolver => \%class_resolver_of,
wsdl => \%wsdl_of,
proxy => \%proxy_of,
autotype => \%autotype_of,
outputxml => \%outputxml_of,
outputtree => \%outputtree_of,
@@ -94,12 +92,30 @@ for my $method (keys %LOOKUP ) {
}
my $ident = ident $self;
$self->wsdlinit() if ($wsdl_of{ $ident });
$client_of{ $ident } = SOAP::WSDL::Client->new();
$self->wsdlinit() if ($wsdl_of{ $ident });
return $self;
}
}
sub set_proxy {
my $self = shift;
return $self->get_client()->set_proxy(@_);
}
sub get_proxy {
my $self = shift;
return $self->get_client()->get_proxy();
}
sub proxy {
my $self = shift;
if (@_) {
return $self->set_proxy(@_);
}
return $self->get_proxy();
}
sub wsdlinit {
my ($self, %opt) = @_;
my $ident = ident $self;
@@ -132,6 +148,15 @@ sub wsdlinit {
$servicename_of{ $ident } = $opt{servicename} if $opt{servicename};
$portname_of{ $ident } = $opt{portname} if $opt{portname};
$self->_wsdl_init_methods();
# pass-through keep_alive if we need it...
$self->get_client()->set_proxy(
$port_of{ $ident }->first_address()->get_location(),
$keep_alive_of{ $ident } ? (keep_alive => 1) : (),
);
return $self;
} ## end sub wsdlinit
@@ -151,6 +176,7 @@ sub _wsdl_get_port :PRIVATE {
? $service_of{ $ident }->get_port( $ns, $portname_of{ $ident } )
: $port_of{ $ident } = $service_of{ $ident }->get_port()->[ 0 ];
}
sub _wsdl_get_binding :PRIVATE {
my $self = shift;
my $ident = ident $self;
@@ -160,6 +186,7 @@ sub _wsdl_get_binding :PRIVATE {
or croak "no binding found for ", $port->get_binding();
return $binding_of{ $ident };
}
sub _wsdl_get_portType :PRIVATE {
my $self = shift;
my $ident = ident $self;
@@ -169,6 +196,7 @@ sub _wsdl_get_portType :PRIVATE {
or croak "cannot find portType for " . $binding->get_type();
return $porttype_of{ $ident };
}
sub _wsdl_init_methods :PRIVATE {
my $self = shift;
my $ident = ident $self;
@@ -240,6 +268,10 @@ sub _wsdl_init_methods :PRIVATE {
return $method_info_of{ $ident };
}
# on_action is a no-op and just here for compatibility reasons.
# It returns the first parameter to allow method chaining.
sub on_action { return shift }
sub call {
my ($self, $method, @data_from) = @_;
my $ident = ${ $self };
@@ -255,12 +287,6 @@ sub call {
my $client = $client_of{ $ident };
# pass-through keep_alive if we need it...
$client->set_proxy( $proxy_of{ $ident }
|| $port_of{ $ident }->first_address()->get_location(),
$keep_alive_of{ $ident } ? (keep_alive => 1) : (),
);
$client->set_no_dispatch( $no_dispatch_of{ $ident } );
$client->set_outputxml( $outputxml_of{ $ident } ? 1 : 0 );
@@ -273,7 +299,7 @@ sub call {
&& ( ! $no_dispatch_of{ $ident } ) ) {
require SOAP::WSDL::Deserializer::SOM;
$client->set_deserializer( SOAP::WSDL::Deserializer::SOM->new() );
};
}
my $method_info = $method_info_of{ $ident }->{ $method };
@@ -555,6 +581,12 @@ SOAP message to your favorite XML editor and run the source format command.
Outputting readable XML requires lots of programming for little use: The
resulting XMl is still quite unreadable.
=head2 on_action
Setting on_action is not required any more, the appropriate value is
automatically taken from the WSDL. on_action is a no-op, and is just here
for compatibility issues.
=head1 Differences to SOAP::Lite
=head2 readable
@@ -762,8 +794,6 @@ Peter Orvos, Mark Overmeer, Jon Robens, Isidro Vila Verde and Glenn Wood
(in alphabetical order) spotted bugs and/or suggested improvements in
the 1.2x releases.
Noah Robin contirbuted lots of documentation fixes, and the mod_perl server.
JT Justman and Noah Robin provided early feedback and bug reports for
the 2.xx pre-releases.
@@ -776,13 +806,17 @@ Matt S. Trout encouraged me "to get a non-dev-release out."
CPAN Testers provided most valuable (automated) feedback. Thanks a lot.
Numerous people sent me their real-world WSDL files for testing. Thank you.
Numerous people sent me their real-world WSDL files and error reports for
testing. Thank you.
Noah Robin contributed lots of documentation fixes, and the mod_perl server,
and eventually joined SOAP::WSDL's developement. Thanks.
Mark Overmeer wrote XML::Compile::SOAP - competition is good for business.
Paul Kulchenko and Byrne Reese wrote and maintained SOAP::Lite and
thus provided a base (and counterpart) for SOAP::WSDL.
Mark Overmeer wrote XML::Compile::SOAP - competition is good for business.
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2008 Martin Kutter.
@@ -796,9 +830,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 755 $
$LastChangedBy: kutterma $
$Id: WSDL.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL.pm $
$Id: WSDL.pm 755 2008-12-03 21:36:54Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL.pm $
=cut

View File

@@ -1,20 +1,21 @@
package SOAP::WSDL::Base;
use strict;
use warnings;
use strict; use warnings;
use Class::Std::Fast::Storable;
use List::Util qw(first);
use List::Util;
use Scalar::Util;
use Carp qw(croak carp confess);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %id_of :ATTR(:name<id> :default<()>);
my %lang_of :ATTR(:name<lang> :default<()>);
my %name_of :ATTR(:name<name> :default<()>);
my %namespace_of :ATTR(:name<namespace> :default<()>);
my %documentation_of :ATTR(:name<documentation> :default<()>);
my %annotation_of :ATTR(:name<annotation> :default<()>);
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
my %xmlns_of :ATTR(:name<xmlns> :default<{}>);
my %parent_of :ATTR(:name<parent> :default<()>);
my %parent_of :ATTR(:get<parent> :default<()>);
my %namespaces_of :ATTR(:default<{}>);
@@ -22,34 +23,42 @@ sub namespaces {
return shift->get_xmlns();
}
sub BUILD {
my ($self, $ident, $arg_ref) = @_;
if (defined $arg_ref->{ parent }) {
$parent_of{ $ident } = delete $arg_ref->{ parent },
Scalar::Util::weaken($parent_of{ $ident });
}
}
sub START {
my ($self, $ident, $arg_ref) = @_;
$xmlns_of{ $ident }->{ '#default' } = $self->get_xmlns()->{ '#default' };
$xmlns_of{ $ident }->{ 'xml' } = 'http://www.w3.org/XML/1998/namespace';
$namespaces_of{ $ident }->{ '#default' } = $self->get_xmlns()->{ '#default' };
$namespaces_of{ $ident }->{ 'xml' } = 'http://www.w3.org/XML/1998/namespace';
}
sub DEMOLISH {
my $self = shift;
# delete upward references
delete $parent_of{ ident $self };
return;
#
# set_parent is hand-implemented to break up (weaken) the circular reference
# between an object and it's parent
#
sub set_parent {
$parent_of{ ${ $_[0]} } = $_[1];
Scalar::Util::weaken($parent_of{ ${ $_[0]} });
}
sub STORABLE_freeze_pre :CUMULATIVE {};
sub STORABLE_freeze_post :CUMULATIVE {};
sub STORABLE_thaw_pre :CUMULATIVE {};
sub STORABLE_thaw_post :CUMULATIVE { return $_[0] };
# _accept is here to be called by visitor.
# The visitor pattern is a level of indirection - here the visitor calls
# $object->_accept($visitor) on each object, which in turn calls
# $visitor->visit_$class( $object ) where $class is the object's class.
#
sub _accept {
my $self = shift;
my $class = ref $self;
$class =~ s{ \A SOAP::WSDL:: }{}xms;
$class =~ s{ (:? :: ) }{_}gxms;
my $method = "visit_$class";
no strict qw(refs); ## no critic ProhibitNoStrict
no strict qw(refs);
return shift->$method( $self );
}
@@ -64,13 +73,12 @@ sub AUTOMETHOD {
if ($subname =~s{^push_}{}xms) {
my $getter = "get_$subname";
my $setter = "set_$subname";
## Checking here is paranoid - will fail fatally if
## there is no setter...
## And we would have to check getters, too.
## Maybe do it the Conway way via the Symbol table...
## ... can is way slow...
# Checking here is paranoid - will fail fatally if there is no setter.
# And we would have to check getters, too.
# Maybe do it the Conway way via the Symbol table...
# ... can is way slow...
return sub {
no strict qw(refs); ## no critic ProhibitNoStrict
no strict qw(refs);
my $old_value = $self->$getter();
# Listify if not a list ref
$old_value = $old_value ? [ $old_value ] : [] if not ref $old_value;
@@ -84,7 +92,7 @@ sub AUTOMETHOD {
elsif ($subname =~s {^find_}{get_}xms) {
@values = @{ $values[0] } if ref $values[0] eq 'ARRAY';
return sub {
return first {
return List::Util::first {
$_->get_targetNamespace() eq $values[0] &&
$_->get_name() eq $values[1]
}
@@ -100,24 +108,29 @@ sub AUTOMETHOD {
};
}
# return if called from can();
my @caller = caller(2);
return if ($caller[3] eq 'Class::Std::Fast::__ANON__');
# confess "$subname not found in class " . ref $self;
return;
}
sub init {
my ($self, @args) = @_;
foreach my $value (@args)
{
foreach my $value (@args) {
croak @args if (not defined ($value->{ Name }));
if ($value->{ Name } =~m{^xmlns\:}xms) {
# add namespaces
$xmlns_of{ ident $self }->{ $value->{ LocalName } } = $value->{ Value };
next;
}
# check for namespae-qualified attributes.
# neither XML Schema, nor WSDL1.1, nor the SOAP binding allow
# namespace-qualified attribute names
my ($ns, $localname) = split /\|/, $value->{ Name };
if ($ns) {
warn "found unrecognised attribute \{$ns}$localname (ignored)";
next;
}
my $name = $value->{ LocalName };
my $method = "set_$name";
$self->$method( $value->{ Value } );
@@ -128,21 +141,27 @@ sub init {
sub expand {
my ($self, $qname) = @_;
my $ns_of = $self->namespaces();
my $parent;
if (not $qname=~m{:}xm) {
if (defined $ns_of->{ '#default' }) {
# TODO check. Returning the targetNamespace for the default ns
# is probably wrong
#return $self->get_targetNamespace(), $qname;
return $ns_of->{ '#default' }, $qname;
}
if ($parent = $self->get_parent()) {
return $parent->expand($qname);
}
die "un-prefixed element name <$qname> found, but no default namespace set\n"
if not defined $ns_of->{ '#default' };
return $ns_of->{ '#default' }, $qname;
}
my ($prefix, $localname) = split /:/x, $qname;
return ($ns_of->{ $prefix }, $localname) if ($ns_of->{ $prefix });
if (my $parent = $self->get_parent()) {
if ($parent = $self->get_parent()) {
return $parent->expand($qname);
}
confess "unbound prefix $prefix found for $prefix:$localname. Bound prefixes are"
croak "unbound prefix $prefix found for $prefix:$localname. Bound prefixes are "
. join(', ', keys %{ $ns_of });
}
sub _expand;

View File

@@ -2,10 +2,10 @@ package SOAP::WSDL::Binding;
use strict;
use warnings;
use Class::Std::Fast::Storable;
use List::Util qw(first);
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %operation_of :ATTR(:name<operation> :default<()>);
my %type_of :ATTR(:name<type> :default<()>);

View File

@@ -11,18 +11,19 @@ use SOAP::WSDL::Factory::Serializer;
use SOAP::WSDL::Factory::Transport;
use SOAP::WSDL::Expat::MessageParser;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
my %no_dispatch_of :ATTR(:name<no_dispatch> :default<()>);
my %prefix_of :ATTR(:name<prefix> :default<()>);
my %outputxml_of :ATTR(:name<outputxml> :default<()>);
my %transport_of :ATTR(:name<transport> :default<()>);
my %endpoint_of :ATTR(:name<endpoint> :default<()>);
my %soap_version_of :ATTR(:get<soap_version> :init_attr<soap_version> :default<'1.1'>);
my %soap_version_of :ATTR(:get<soap_version> :init_attr<soap_version> :default<1.1>);
my %on_action_of :ATTR(:name<on_action> :default<()>);
my %content_type_of :ATTR(:name<content_type> :default<text/xml; charset=utf8>); #/#trick editors
my %content_type_of :ATTR(:name<content_type> :default<text/xml; charset=utf-8>); #/#trick editors
my %serializer_of :ATTR(:name<serializer> :default<()>);
my %deserializer_of :ATTR(:name<deserializer> :default<()>);
@@ -61,7 +62,7 @@ sub set_proxy {
}
sub set_soap_version {
my $ident = ident shift;
my $ident = ${ $_[0] };
# remember old value to return it later - Class::Std does so, too
my $soap_version = $soap_version_of{ $ident };
@@ -71,14 +72,14 @@ sub set_soap_version {
delete $serializer_of{ $ident };
delete $deserializer_of{ $ident };
$soap_version_of{ $ident } = shift;
$soap_version_of{ $ident } = $_[1];
return $soap_version;
}
# Mimic SOAP::Lite's behaviour for getter/setter routines
SUBFACTORY: {
for (qw(class_resolver no_dispatch outputxml proxy)) {
for (qw(class_resolver no_dispatch outputxml proxy prefix)) {
my $setter = "set_$_";
my $getter = "get_$_";
no strict qw(refs); ## no critic ProhibitNoStrict
@@ -94,7 +95,7 @@ SUBFACTORY: {
sub call {
my ($self, $method, @data_from) = @_;
my $ident = ident $self;
my $ident = ${ $self };
# the only valid idiom for calling a method with both a header and a body
# is
@@ -124,6 +125,7 @@ sub call {
method => $operation,
body => $data,
header => $header,
options => {prefix => $prefix_of{ $ident }},
});
return $envelope if $self->no_dispatch();
@@ -268,6 +270,39 @@ Default:
text/xml; charset: utf8
=head3 set_prefix
$soap->set_prefix('ns2');
If set, alters the serialization of the request XML such that the supplied value is used as a namespace prefix for SOAP method calls. By way of example, the default XML serialization returns something like this:
<?xml version="1.0"?>
<SOAP-ENV:Envelope
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
<SOAP-ENV:Body>
<getElementId xmlns="http://services.exmaple.org/">
<elementId>12345</elementId>
</getElementId>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
If the sample set_prefix() call above is used prior to calling your SOAP method, the XML serialization returns this instead:
<?xml version="1.0"?>
<SOAP-ENV:Envelope
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:ns2="http://services.example.org/">
<SOAP-ENV:Body>
<ns2:getElementId>
<elementId>12345</elementId>
</ns2:getElementId>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
This is useful in cases where, for instance, one is communicating with a JAX L<https://jax-ws.dev.java.net/> webservice, which tends to understand the latter but not the former. Note that this implementation is currently limited to a single additional namespace; if you require multiple custom namespaces, you should probably look into creating your own serializer.
=head2 Features different from SOAP::Lite
SOAP::WSDL does not aim to be a complete replacement for SOAP::Lite - the
@@ -321,7 +356,7 @@ to true. SOAP::WSDL::Client returns the complete XML response.
=head3 Auto-Dispatching
SOAP::WSDL::Client does B<does not> support auto-dispatching.
SOAP::WSDL::Client B<does not> support auto-dispatching.
This is on purpose: You may easily create interface classes by using
SOAP::WSDL::Client and implementing something like
@@ -360,10 +395,10 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 744 $
$LastChangedBy: kutterma $
$Id: Client.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
$Id: Client.pm 744 2008-10-15 16:58:45Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
=cut

View File

@@ -4,7 +4,7 @@ use warnings;
use base 'SOAP::WSDL::Client';
use Scalar::Util qw(blessed);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
sub call {
my ($self, $method, $body, $header) = @_;
@@ -22,7 +22,7 @@ sub call {
# parameters given
my @part_from = ();
foreach my $class (@{ $method->{ body }->{ parts } }) {
eval "require $class" || die $@;
eval "require $class" || die $@; ## no critic (ProhibitStringyEval)
push @part_from, $class->new(shift(@body_from) || {});
}
@@ -33,10 +33,10 @@ sub call {
# if we have a header
if (%{ $method->{ header } }) {
# trat non object special - as above, but only for one
# treat non object special - as above, but only for one
if (not blessed $header) {
my $class = $method->{ header }->{ parts }->[0];
eval "require $class" || die $@;
eval "require $class" || die $@; ## no critic (ProhibitStringyEval)
$header = $class->new($header);
}
}
@@ -65,6 +65,13 @@ SOAP::WSDL::Client::Base - Factory class for WSDL-based SOAP access
Factory class for creating interface classes. Should probably be renamed to
SOAP::WSDL::Factory::Interface...
=head1 METHODS
=head2 call
Abstraction layer method between the generated interfaces and
L<SOAP::WSDL::Client|SOAP::WSDL::Client>.
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2007 Martin Kutter.
@@ -78,9 +85,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 728 $
$LastChangedBy: kutterma $
$Id: Base.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client/Base.pm $
$Id: Base.pm 728 2008-07-13 19:28:50Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client/Base.pm $
=cut

View File

@@ -1,26 +1,22 @@
package SOAP::WSDL::Definitions;
use utf8;
use strict;
use warnings;
use Carp;
use File::Basename;
use File::Path;
use List::Util qw(first);
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %types_of :ATTR(:name<types> :default<[]>);
my %message_of :ATTR(:name<message> :default<[]>);
my %portType_of :ATTR(:name<portType> :default<[]>);
my %binding_of :ATTR(:name<binding> :default<[]>);
my %service_of :ATTR(:name<service> :default<[]>);
my %namespace_of :ATTR(:name<namespace> :default<()>);
my %namespace_of :ATTR(:name<namespace> :default<()>);
# must be attr for Class::Std::Fast::Storable
my %attributes_of :ATTR();
%attributes_of = (
#my %attributes_of :ATTR();
my %attributes_of = (
binding => \%binding_of,
message => \%message_of,
portType => \%portType_of,
@@ -44,6 +40,7 @@ BLOCK: {
}
}
1;
=pod
@@ -72,7 +69,7 @@ Returns the service matching the namespace/localname pair passed as arguments.
Accessors/Mutators for accessing / setting the E<gt>bindingE<lt> child
element(s).
=head2 find_service
=head2 find_binding
Returns the binding matching the namespace/localname pair passed as arguments.
@@ -94,7 +91,7 @@ Returns the portType matching the namespace/localname pair passed as arguments.
Accessors/Mutators for accessing / setting the E<gt>messageE<lt> child
element(s).
=head2 find_service
=head2 find_message
Returns the message matching the namespace/localname pair passed as arguments.
@@ -118,10 +115,10 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 728 $
$LastChangedBy: kutterma $
$Id: Definitions.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Definitions.pm $
$Id: Definitions.pm 728 2008-07-13 19:28:50Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Definitions.pm $
=cut

View File

@@ -8,7 +8,7 @@ use SOAP::WSDL::Expat::Message2Hash;
use SOAP::WSDL::Factory::Deserializer;
SOAP::WSDL::Factory::Deserializer->register( '1.1', __PACKAGE__ );
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
sub BUILD {
my ($self, $ident, $args_of_ref) = @_;
@@ -139,9 +139,20 @@ a parse error appears
=back
=head1 METHODS
=head2 deserialize
Deserializes the message.
=head2 generate_fault
Generates a L<SOAP::WSDL::SOAP::Typelib::Fault11|SOAP::WSDL::SOAP::Typelib::Fault11>
object and returns it.
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2007 Martin Kutter.
Copyright 2004-2008 Martin Kutter.
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself.
@@ -152,9 +163,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 728 $
$LastChangedBy: kutterma $
$Id: Hash.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Deserializer/Hash.pm $
$Id: Hash.pm 728 2008-07-13 19:28:50Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Deserializer/Hash.pm $
=cut

View File

@@ -2,7 +2,7 @@ package SOAP::WSDL::Deserializer::SOM;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
our @ISA;
eval {
@@ -13,6 +13,18 @@ or die "Cannot load SOAP::Lite.
Cannot deserialize to SOM object without SOAP::Lite.
Please install SOAP::Lite.";
sub deserialize {
my $self = shift;
my $result = eval { $self->SUPER::deserialize(@_) };
if ($@) {
return SOAP::Fault->new(
faultactor => 'soap:Server',
faultstring => $@,
);
}
return $result;
}
sub generate_fault {
my ($self, $args_from_ref) = @_;
# code, message, detail, actor
@@ -66,6 +78,17 @@ This may be XML including mixed content, attachements and other XML data not
SOAP::WSDL::Deserializer::SOM is a subclass of L<SOAP::Deserializer|SOAP::Deserializer>
from the L<SOAP::Lite|SOAP::Lite> package.
=head1 METHODS
=head2 deserialize
Deserializes a XML sting into a SOAP::SOM object. Returns a SOAP::Fault object
on deserialization errors.
=head2 generate_fault
Dies with a SOAP::Fault object.
=head1 USAGE
SOAP::WSDL::Deserializer will not autoregister itself - to use it for a particular
@@ -85,8 +108,8 @@ SOAP version just use the following lines:
=item * No on_fault handler
You cannot specify what to do when an error occurs - SOAP::WSDL will die
with a SOAP::Fault object on transport errors.
You cannot specify what to do when an error occurs - SOAP::WSDL will return
a SOAP::Fault object on transport errors.
=back
@@ -99,6 +122,9 @@ with a SOAP::Fault object on transport errors.
SOAP::WSDL::Deserializer::SOM will die with a SOAP::Fault object on calls
to generate_fault.
This also means that a SOAP::Fault may be thrown as exception when using
=back
=head1 LICENSE AND COPYRIGHT
@@ -114,9 +140,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 728 $
$LastChangedBy: kutterma $
$Id: SOM.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Deserializer/SOM.pm $
$Id: SOM.pm 728 2008-07-13 19:28:50Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Deserializer/SOM.pm $
=cut

View File

@@ -5,7 +5,7 @@ use Class::Std::Fast::Storable;
use SOAP::WSDL::SOAP::Typelib::Fault11;
use SOAP::WSDL::Expat::MessageParser;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
@@ -25,7 +25,7 @@ sub deserialize {
$parser_of{ ${ $self } } = SOAP::WSDL::Expat::MessageParser->new()
if not $parser_of{ ${ $self } };
$parser_of{ ${ $self } }->class_resolver( $class_resolver_of{ ident $self } );
$parser_of{ ${ $self } }->class_resolver( $class_resolver_of{ ${ $self } } );
eval { $parser_of{ ${ $self } }->parse_string( $content ) };
if ($@) {
return $self->generate_fault({
@@ -99,9 +99,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 728 $
$LastChangedBy: kutterma $
$Id: XSD.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Deserializer/XSD.pm $
$Id: XSD.pm 728 2008-07-13 19:28:50Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Deserializer/XSD.pm $
=cut

View File

@@ -6,7 +6,7 @@ use XML::Parser::Expat;
# TODO: convert to Class::Std::Fast based class - hash based classes suck.
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
sub new {
my ($class, $arg_ref) = @_;
@@ -35,23 +35,29 @@ sub get_uri { return $_[0]->{ uri }; }
sub set_user_agent { $_[0]->{ user_agent } = $_[1]; }
sub get_user_agent { return $_[0]->{ user_agent }; }
# Mark a URI as "already parsed"
sub set_parsed {
my ($self, $uri) = @_;
$self->{ parsed }->{ $uri } = 1;
return;
}
# returns true if a specific URI has already been parsed
sub is_parsed {
my ($self, $uri) = @_;
return exists $self->{ parsed }->{ $uri };
}
# parse a URI. This is the preferred parsing method for WSDL files, as it's
# the only one allowing automatic import resolution
sub parse_uri {
my $self = shift;
my $uri = shift;
if ($self->is_parsed($uri)){
warn "$uri already imported. Ignoring it\n";
warn "$uri already imported; ignoring it.\n";
return;
}
$self->set_parsed($uri);
@@ -74,6 +80,7 @@ sub parse {
$_[0]->{ parser }->release();
};
$_[0]->{ parser }->xpcroak( $@ ) if $@;
delete $_[0]->{ parser };
return $_[0]->{ data };
}
@@ -83,6 +90,7 @@ sub parsefile {
$_[0]->{ parser }->release();
};
$_[0]->{ parser }->xpcroak( $@ ) if $@;
delete $_[0]->{ parser };
return $_[0]->{ data };
}

View File

@@ -4,7 +4,7 @@ use strict;
use warnings;
use base qw(SOAP::WSDL::Expat::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
sub _initialize {
my ($self, $parser) = @_;

View File

@@ -1,19 +1,20 @@
#!/usr/bin/perl
package SOAP::WSDL::Expat::MessageParser;
use strict;
use warnings;
use Carp qw(croak confess);
use version; our $VERSION = qv('2.00.01');
use strict; use warnings;
use SOAP::WSDL::XSD::Typelib::Builtin;
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
use base qw(SOAP::WSDL::Expat::Base);
require Class::Std::Fast;
BEGIN { require Class::Std::Fast };
use version; our $VERSION = qv('2.00.05');
# GLOBALS
my $OBJECT_CACHE_REF = Class::Std::Fast::OBJECT_CACHE_REF();
# keep track of classes loaded
my %LOADED_OF = ();
sub new {
@@ -46,7 +47,10 @@ sub class_resolver {
sub load_classes {
my $self = shift;
for (values %{ $self->{ class_resolver }->get_typemap }) {
return if $LOADED_OF{ $self->{ class_resolver } };
# requires sorting to make sub-packages load after their parent
for (sort values %{ $self->{ class_resolver }->get_typemap }) {
no strict qw(refs);
my $class = $_;
@@ -54,9 +58,10 @@ sub load_classes {
next if $class eq '__SKIP__';
next if defined *{ "$class\::" }; # check if namespace exists
# Require takes a bareword or a file name - we have to take
# the filname road here...
$class =~s{ :: }{/}xmsg;
$class .= '.pm';
require $class;
require "$class.pm"; ## no critic (RequireBarewordIncludes)
}
$LOADED_OF{ $self->{ class_resolver } } = 1;
}
@@ -106,16 +111,12 @@ sub _initialize {
: ();
# use "globals" for speed
my ($_prefix, $_method,
$_class, $_leaf) = ();
my ($_prefix, $_method, $_class, $_leaf) = ();
my $char_handler = sub {
return if (!$_leaf); # we only want characters in leaf nodes
$characters .= $_[1];
# if $_[1] =~m{ [^\s] }xms;
return;
return if (!$_leaf); # we only want characters in leaf nodes
$characters .= $_[1]; # add to characters
return; # return void
};
no strict qw(refs);
@@ -194,6 +195,9 @@ sub _initialize {
}
}
$depth++;
# TODO: Skip content of anyType / any stuff
return;
},
@@ -238,8 +242,14 @@ sub _initialize {
# set appropriate attribute in last element
# multiple values must be implemented in base class
# TODO check if hash access is faster
# $_method = "add_$_localname";
$_method = "add_$_[1]";
#
# fixup XML names for perl names
#
$_method =~s{\.}{__}xg;
$_method =~s{\-}{_}xg;
$list->[-1]->$_method( $current );
$current = pop @$list; # step up in object hierarchy
@@ -313,11 +323,11 @@ the same terms as perl itself
=head1 Repository information
$Id: $
$Id: MessageParser.pm 728 2008-07-13 19:28:50Z kutterma $
$LastChangedDate: 2008-04-22 23:51:49 +0200 (Di, 22 Apr 2008) $
$LastChangedRevision: 616 $
$LastChangedDate: 2008-07-13 21:28:50 +0200 (So, 13 Jul 2008) $
$LastChangedRevision: 728 $
$LastChangedBy: kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $

View File

@@ -6,7 +6,7 @@ use XML::Parser::Expat;
use SOAP::WSDL::Expat::MessageParser;
use base qw(SOAP::WSDL::Expat::MessageParser);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
sub parse_start {
my $self = shift;
@@ -69,9 +69,9 @@ the same terms as perl itself
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 728 $
$LastChangedBy: kutterma $
$Id: MessageStreamParser.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageStreamParser.pm $
$Id: MessageStreamParser.pm 728 2008-07-13 19:28:50Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageStreamParser.pm $
=cut

View File

@@ -1,38 +1,54 @@
package SOAP::WSDL::Expat::WSDLParser;
package SOAP::WSDL::Expat::WSDLParser;
use strict;
use warnings;
use Carp;
use SOAP::WSDL::TypeLookup;
use base qw(SOAP::WSDL::Expat::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
#
# Import child elements of a WSDL / XML Schema tree into the current tree
#
# Set the targetNamespace of the imported nodes to $import_namespace
#
# SYNOPSIS
#
# $self->_import_children($name, $imported, $imported, $import_namespace)
#
sub _import_children {
my ($self, $name, $imported, $importer, $import_namespace) = @_;
return if not $imported;
my $targetNamespace = $importer->get_targetNamespace();
my $push_method = "push_$name";
my $get_method = "get_$name";
my $default_namespace = $imported->get_xmlns()->{ '#default' };
no strict qw(refs);
my $value_ref = $imported->$get_method();
if ($value_ref) {
#print $self->get_uri(), "\n";
#use Data::Dumper;
#print Data::Dumper::Dumper $value_ref;
$value_ref = [ $value_ref ] if (not ref $value_ref eq 'ARRAY');
# set xmlns - can be different from parent
for (@{ $value_ref }) {
# fixup namespace - new parent may be from different namespace
if (defined ($default_namespace)) {
my $xmlns = $_->get_xmlns();
# it's a hash ref, so we can just update values
if (! defined $xmlns->{ '#default'}) {
$xmlns->{ '#default' } = $default_namespace;
}
}
# fixup targetNamespace, but don't override
$_->set_targetNamespace( $import_namespace )
if ( ($import_namespace ne $targetNamespace) && ! $_->get_targetNamespace);
# update parent...
$_->set_parent( $importer );
# push elements into importing WSDL
$importer->$push_method($_);
}
# push elements into importing WSDL
#$importer->$push_method(@{ $value_ref })
# if @{ $value_ref };
}
}
@@ -45,6 +61,10 @@ sub _import_namespace_definitions {
# import namespace definitions, too
my $importer_ns_of = $importer->get_xmlns();
my %xmlns_of = %{ $imported->get_xmlns() };
# it's a hash ref, we can just add to.
# TODO: check whether prefix is already taken.
# TODO: check wheter URI is the better key.
while (my ($prefix, $url) = each %xmlns_of) {
$importer_ns_of->{ $prefix } = $url;
}
@@ -56,6 +76,16 @@ sub xml_schema_import {
my $parser = $self->clone();
my %attr_of = @_;
my $import_namespace = $attr_of{ namespace };
if (not $attr_of{schemaLocation}) {
warn "cannot import document for namespace >$import_namespace< without location";
return;
}
if (not $self->get_uri) {
die "cannot import document from namespace >$import_namespace< without base uri. Use >parse_uri< or >set_uri< to set one."
}
my $uri = URI->new_abs($attr_of{schemaLocation}, $self->get_uri() );
my $imported = $parser->parse_uri($uri);
@@ -78,6 +108,16 @@ sub wsdl_import {
my $parser = $self->clone();
my %attr_of = @_;
my $import_namespace = $attr_of{ namespace };
if (not $attr_of{location}) {
warn "cannot import document for namespace >$import_namespace< without location";
return;
}
if (not $self->get_uri) {
die "cannot import document from namespace >$import_namespace< without base uri. Use >parse_uri< or >set_uri< to set one."
}
my $uri = URI->new_abs($attr_of{location}, $self->get_uri() );
my $imported = $parser->parse_uri($uri);
@@ -110,7 +150,9 @@ sub _initialize {
# TODO skip non-XML Schema namespace tags
$parser->setHandlers(
Start => sub {
my ($parser, $localname, %attrs) = @_;
# handle attrs as list - expat uses dual-vars for looking
# up namespace information, and hash keys don't allow dual vars...
my ($parser, $localname, @attrs) = @_;
$characters = q{};
my $action = SOAP::WSDL::TypeLookup->lookup(
@@ -124,10 +166,11 @@ sub _initialize {
eval "require $action->{ class }";
croak $@ if ($@);
my $obj = $action->{ class }->new({ parent => $current,
xmlns => { '#default' => $parser->namespace($localname) }
my $obj = $action->{ class }->new({
parent => $current,
namespace => $parser->namespace($localname),
})
->init( _fixup_attrs( $parser, %attrs ) );
->init( _fixup_attrs( $parser, @attrs ) );
if ($current) {
# inherit namespace, but don't override
@@ -143,14 +186,12 @@ sub _initialize {
# remember element for stepping back
push @{ $list }, $current;
}
else {
$self->{ data } = $obj;
}
# set new element (step down)
$current = $obj;
}
elsif ($action->{ type } eq 'PARENT') {
$current->init( _fixup_attrs($parser, %attrs) );
$current->init( _fixup_attrs($parser, @attrs) );
}
elsif ($action->{ type } eq 'METHOD') {
my $method = $action->{ method };
@@ -166,12 +207,12 @@ sub _initialize {
? ref $action->{ value }
? @{ $action->{ value } }
: ($action->{ value })
: _fixup_attrs($parser, %attrs)
: _fixup_attrs($parser, @attrs)
);
}
elsif ($action->{type} eq 'HANDLER') {
my $method = $self->can($action->{method});
$method->($self, $current, %attrs);
$method->($self, $current, @attrs);
}
else {
# TODO replace by hash lookup of known namespaces.
@@ -197,6 +238,11 @@ sub _initialize {
$localname
) || {};
if (! defined $list->[-1]) {
$self->{ data } = $current;
return;
}
return if not ($action->{ type });
if ( $action->{ type } eq 'CLASS' ) {
$current = pop @{ $list };
@@ -219,29 +265,40 @@ sub _initialize {
# make attrs SAX style
sub _fixup_attrs {
my ($parser, %attrs_of) = @_;
my ($parser, @attrs) = @_;
my @attrs_from = map { $_ =
{
Name => $_,
Value => $attrs_of{ $_ },
LocalName => $_
}
} keys %attrs_of;
my @attr_key_from = ();
my @attr_value_from = ();
while (@attrs) {
push @attr_key_from, shift @attrs;
push @attr_value_from, shift @attrs;
}
my @attrs_from;
# add xmlns: attrs. expat eats them.
#
# add namespaces before attributes: Attributes may be namespace-qualified
#
push @attrs_from, map {
# ignore xmlns=FOO namespaces - must be XML schema
# Other nodes should be ignored somewhere else
($_ eq '#default')
? ()
:
{
Name => "xmlns:$_",
Value => $parser->expand_ns_prefix( $_ ),
LocalName => $_
}
} $parser->new_ns_prefixes();
push @attrs_from, map {
{
Name => defined $parser->namespace($_)
? $parser->namespace($_) . '|' . $_
: '|' . $_,
Value => shift @attr_value_from, # $attrs_of{ $_ },
LocalName => $_
}
} @attr_key_from;
return @attrs_from;
}
@@ -279,11 +336,11 @@ the same terms as perl itself
=head1 Repository information
$Id: WSDLParser.pm 616 2008-04-22 21:51:49Z kutterma $
$Id: WSDLParser.pm 728 2008-07-13 19:28:50Z kutterma $
$LastChangedDate: 2008-04-22 23:51:49 +0200 (Di, 22 Apr 2008) $
$LastChangedRevision: 616 $
$LastChangedDate: 2008-07-13 21:28:50 +0200 (So, 13 Jul 2008) $
$LastChangedRevision: 728 $
$LastChangedBy: kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/WSDLParser.pm $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/WSDLParser.pm $

View File

@@ -2,7 +2,7 @@ package SOAP::WSDL::Factory::Deserializer;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %DESERIALIZER = (
'1.1' => 'SOAP::WSDL::Deserializer::XSD',

View File

@@ -2,7 +2,7 @@ package SOAP::WSDL::Factory::Generator;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %GENERATOR = (
'XSD' => 'SOAP::WSDL::Generator::Template::XSD',

View File

@@ -2,7 +2,7 @@ package SOAP::WSDL::Factory::Serializer;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %SERIALIZER = (
'1.1' => 'SOAP::WSDL::Serializer::XSD',
@@ -138,9 +138,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 728 $
$LastChangedBy: kutterma $
$Id: Serializer.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
$Id: Serializer.pm 728 2008-07-13 19:28:50Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
=cut

View File

@@ -1,7 +1,7 @@
package SOAP::WSDL::Factory::Transport;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %registered_transport_of = ();
@@ -39,7 +39,7 @@ sub get_transport {
if (defined $registered_transport_of{ $scheme }) {
no strict qw(refs);
defined %{ "$registered_transport_of{ $scheme }::" } or
$registered_transport_of{ $scheme }->can('new') or
eval "require $registered_transport_of{ $scheme }"
or die "Cannot load transport class $registered_transport_of{ $scheme } : $@";
@@ -60,11 +60,11 @@ sub get_transport {
no strict qw(refs);
# behaves interestingly different under different versions of perl
# maybe true even if it's not available
defined %{ "$SOAP_LITE_TRANSPORT_OF{ $scheme }::" }
my $protocol_class = $SOAP_LITE_TRANSPORT_OF{ $scheme } . '::Client';
$protocol_class->can('new')
or eval "require $SOAP_LITE_TRANSPORT_OF{ $scheme }"
or last SOAP_Lite;
my $protocol_class = $SOAP_LITE_TRANSPORT_OF{ $scheme } . '::Client';
# may fail if it's not available
my $transport = eval { $protocol_class->new( %attrs ) }
or last SOAP_Lite;
@@ -74,7 +74,7 @@ sub get_transport {
if (exists $SOAP_WSDL_TRANSPORT_OF{ $scheme }) {
no strict qw(refs);
defined %{ "$SOAP_WSDL_TRANSPORT_OF{ $scheme }::"}
$SOAP_WSDL_TRANSPORT_OF{ $scheme }->can('new')
or eval "require $SOAP_WSDL_TRANSPORT_OF{ $scheme }"
or die "Cannot load transport class $SOAP_WSDL_TRANSPORT_OF{ $scheme } : $@";
return $SOAP_WSDL_TRANSPORT_OF{ $scheme }->new( %attrs );
@@ -243,9 +243,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 728 $
$LastChangedBy: kutterma $
$Id: Transport.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Transport.pm $
$Id: Transport.pm 728 2008-07-13 19:28:50Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Transport.pm $
=cut

View File

@@ -2,7 +2,7 @@ package SOAP::WSDL::Generator::Iterator::WSDL11;
use strict; use warnings;
use Class::Std::Fast;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %definitions_of :ATTR(:name<definitions> :default<[]>);
my %nodes_of :ATTR(:name<nodes> :default<[]>);
@@ -74,7 +74,8 @@ my %METHOD_OF = (
? do {
die "unsupported global type <"
. $node->get_type . "> found in part ". $node->get_name();
$types->find_type( $node->expand($node->get_type) )
## use this once we can auto-generate an element for RPC bindings
# $types->find_type( $node->expand($node->get_type) )
}
: (),
$node->get_element()

View File

@@ -3,7 +3,7 @@ use strict; use warnings;
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %namespace_prefix_map_of :ATTR(:name<namespace_prefix_map> :default<{}>);
my %namespace_map_of :ATTR(:name<namespace_map> :default<{}>);
@@ -128,7 +128,7 @@ You cannot suffix your types by some rule yet...
Copyright 2008 Martin Kutter.
This library is free software. You may distribute/modify it under
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself
=head1 AUTHOR

View File

@@ -1,11 +1,11 @@
package SOAP::WSDL::Generator::Template;
use strict;
use strict; use warnings;
use Template;
use Class::Std::Fast::Storable;
use Carp;
use SOAP::WSDL::Generator::PrefixResolver;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %tt_of :ATTR(:get<tt>);
my %definitions_of :ATTR(:name<definitions> :default<()>);
@@ -39,7 +39,8 @@ sub _process :PROTECTED {
INCLUDE_PATH => $INCLUDE_PATH_of{ $ident },
OUTPUT_PATH => $OUTPUT_PATH_of{ $ident },
PLUGIN_BASE => 'SOAP::WSDL::Generator::Template::Plugin',
);
)
or die Template->error();
$tt->process( $template,
{
@@ -68,4 +69,4 @@ sub _process :PROTECTED {
or croak $INCLUDE_PATH_of{ $ident }, '\\', $template, ' ', $tt->error();
}
1;
1;

View File

@@ -3,20 +3,23 @@ use strict;
use warnings;
use Carp qw(confess);
use Class::Std::Fast::Storable constructor => 'none';
use version; our $VERSION = qv('2.00.01');
use Scalar::Util qw(blessed);
use version; our $VERSION = qv('2.00.05');
my %namespace_prefix_map_of :ATTR(:name<namespace_prefix_map> :default<{}>);
my %namespace_map_of :ATTR(:name<namespace_map> :default<{}>);
my %prefix_of :ATTR(:name<prefix> :default<()>);
my %prefix_resolver_of :ATTR(:name<prefix_resolver> :default<()>);
my %definitions_of :ATTR(:name<definitions> :default<()>);
# create a singleton
sub load { # called as MyPlugin->load($context)
sub load { # called as MyPlugin->load($context)
my ($class, $context, @arg_from) = @_;
my $stash = $context->stash();
my $self = bless \do { my $o = Class::Std::Fast::ID() }, $class;
$self->set_prefix_resolver( $stash->{ context }->{ prefix_resolver });
$self->set_definitions( $stash->{ definitions });
return $self; # returns 'MyPlugin'
}
@@ -27,6 +30,7 @@ sub new {
my $self = bless \do { my $o = Class::Std::Fast::ID() }, $class;
$self->set_prefix_resolver( $arg_ref->{ prefix_resolver });
$self->set_definitions( $arg_ref->{ definitions });
return $self; # returns 'MyPlugin'
}
@@ -47,7 +51,9 @@ sub _get_prefix {
}
sub create_xsd_name {
my ($self,$node) = @_;
my ($self, $node) = @_;
confess "no node $node" if not defined($node)
or $node eq "";
my $name = $self->_resolve_prefix($node) #. '::'
. $node->get_name();
return $self->perl_name( $name );
@@ -84,7 +90,7 @@ sub create_interface_name {
sub _resolve_prefix {
my ($self, $node) = @_;
confess "no node" if not $node;
if ($node->isa('SOAP::WSDL::XSD::Builtin')) {
return $self->_get_prefix('type', $node)
}
@@ -109,6 +115,14 @@ sub perl_name {
return $name;
}
sub perl_var_name {
my $self = shift;
my $name = shift;
$name =~s{\-}{_}xmsg;
$name =~s{\.}{__}xmsg;
return $name;
}
sub create_subpackage_name {
my $self = shift;
my $arg_ref = shift;
@@ -127,6 +141,7 @@ sub create_subpackage_name {
}
}
# create name for top node
die "FOO" if not defined $top_node;
my $top_node_name = $self->create_xsd_name($top_node);
my $package_name = join('::_', $top_node_name , (@name_from) ? join('::', @name_from) : () );
return $package_name;
@@ -136,6 +151,24 @@ sub create_xmlattr_name {
return join '::', shift->create_subpackage_name(shift), 'XmlAttr';
}
sub element_name {
my $self = shift;
my $element = shift;
confess "no element object" unless blessed $element;
my $name = $element->get_name();
if (! $name) {
while (my $ref = $element->get_ref()) {
$element = $self->get_definitions()->first_types()
->find_element($element->expand( $ref ) );
$name = $element->get_name();
last if ($name);
}
}
return $name;
}
1;
=pod

View File

@@ -1,11 +1,11 @@
package SOAP::WSDL::Generator::Template::XSD;
use strict;
use strict; use warnings;
use Template;
use Class::Std::Fast::Storable;
use File::Basename;
use File::Spec;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
use SOAP::WSDL::Generator::Visitor::Typemap;
use SOAP::WSDL::Generator::Visitor::Typelib;
@@ -205,6 +205,7 @@ sub visit_XSD_Element {
my $output = defined $output_of{ ident $self }
? $output_of{ ident $self }
: $self->_generate_filename( $self->get_name_resolver()->create_xsd_name($element) );
warn "Creating element class $output \n";
$self->_process('element.tt', { element => $element } , $output);
}
@@ -213,6 +214,7 @@ sub visit_XSD_SimpleType {
my $output = defined $output_of{ ident $self }
? $output_of{ ident $self }
: $self->_generate_filename( $self->get_name_resolver()->create_xsd_name($type) );
warn "Creating simpleType class $output \n";
$self->_process('simpleType.tt', { simpleType => $type } , $output);
}
@@ -221,6 +223,7 @@ sub visit_XSD_ComplexType {
my $output = defined $output_of{ ident $self }
? $output_of{ ident $self }
: $self->_generate_filename( $self->get_name_resolver()->create_xsd_name($type) );
warn "Creating complexType class $output \n";
$self->_process('complexType.tt', { complexType => $type } , $output);
}

View File

@@ -15,6 +15,8 @@ sub START {
$_[0]->set_proxy('[% port.first_address.get_location %]') if not $_[2]->{proxy};
$_[0]->set_class_resolver('[% XSD.create_typemap_name(service) %]')
if not $_[2]->{class_resolver};
$_[0]->set_prefix($_[2]->{use_prefix}) if exists $_[2]->{use_prefix};
}
[% binding = definitions.find_binding( port.expand( port.get_binding ) );
@@ -88,4 +90,4 @@ All arguments are forwarded to L<SOAP::WSDL::Client|SOAP::WSDL::Client>.
Generated by SOAP::WSDL on [% PERL %]print scalar localtime() [% END %]
=cut
=cut

View File

@@ -4,6 +4,16 @@
[% type = definitions.find_portType( binding.expand( binding.get_type ) );
port_op = type.find_operation( definitions.get_targetNamespace, operation.get_name );
port_op.get_documentation %]
port_op.get_documentation();
$interface->[% operation.get_name %]([% INCLUDE Interface/POD/Message.tt %] );
# for now we only document the first response part - document/literal
# doesn't allow more.
response_name = port_op.first_output.get_message();
response_part = definitions.find_message( port_op.first_output.expand( response_name ) ).get_part();
response_body_element = definitions.first_types.find_element( response_part.0.expand( response_part.0.get_element ) );
response_body_class = XSD.create_xsd_name(response_body_element);
%]
Returns a L<[% response_body_class %]|[% response_body_class %]> object.
$response = $interface->[% operation.get_name %]([% INCLUDE Interface/POD/Message.tt %] );

View File

@@ -40,8 +40,16 @@ methods:
=over
[% FOREACH element = complexType.get_element -%]
=item * [% element.get_name %]
=item * [% XSD.perl_var_name(XSD.element_name(element)) %]
[% IF (XSD.perl_var_name(XSD.element_name(element)) == element.get_name); %]
[% ELSE %]
Note: The name of this property has been altered, because it didn't match
perl's notion of variable/subroutine names. The altered name is used in
perl code only, XML output uses the original name:
[% element.get_name %]
[% END %]
[% IF element.get_annotation.get_documentation; %]
[% element.get_annotation.get_documentation %]
[% END -%]

View File

@@ -1,7 +1,8 @@
[% USE XSD -%]
{
[%- IF complexType.get_name %] # [% XSD.create_xsd_name(complexType) %][% END %]
[%- indent = indent _ ' ';
FOREACH element = complexType.get_element %]
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
[% indent %][% XSD.perl_var_name(XSD.element_name(element)) %] => [% INCLUDE element/POD/structure.tt -%]
[% END %]
[% indent.replace('\s{2}$', ''); %]}

View File

@@ -34,4 +34,7 @@ This attribute is of type L<[% XSD.create_xsd_name(type) %]|[% XSD.create_xsd_na
[% END %]
[%- END -%]
=back
[% END %]

View File

@@ -1,9 +1,10 @@
[%USE XSD -%]
[% indent %]{
[%- IF complexType.get_name %] # [% XSD.create_xsd_name(complexType) %][% END %]
[%- indent = indent _ ' ' %]
[% indent %]# One of the following elements.
[% indent %]# No occurance checks yet, so be sure to pass just one...
[%- FOREACH element = complexType.get_element %]
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
[% indent %][% XSD.perl_var_name(XSD.element_name(element)) %] => [% INCLUDE element/POD/structure.tt -%]
[% END %]
[% indent.replace('\s{2}$', ''); %]}

View File

@@ -1,12 +1,12 @@
[% IF (complexType.get_variety == 'restriction');
[% IF (complexType.get_derivation == 'restriction');
INCLUDE complexType/POD/restriction.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'extension');
ELSIF (complexType.get_derivation == 'extension');
#THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType complexContent extension not implemented yet";
%]
# No documentation generated for complexContent / extension yet
[%
ELSE;
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
THROW UNKNOWN, "unknown derivation ${ complexType.get_derivation }";
END;
%]

View File

@@ -7,26 +7,42 @@ Class::Std::initialize();
[%
atomic_types = {};
FOREACH element = complexType.get_element %]
my %[% XSD.perl_name(element.get_name) %]_of :ATTR(:get<[% XSD.perl_name(element.get_name) %]>);
FOREACH element = complexType.get_element;
name = XSD.perl_var_name(XSD.element_name(element)); %]
my %[% XSD.perl_name(name) %]_of :ATTR(:get<[% XSD.perl_name(name) %]>);
[%- END %]
__PACKAGE__->_factory(
[ qw([% FOREACH element = complexType.get_element %]
[% element.get_name -%]
[ qw([% FOREACH element = complexType.get_element;
# ugly copied code - macro or plugin method?
name = XSD.perl_var_name(XSD.element_name(element)); -%]
[% name %]
[% END %]
) ],
{
[% FOREACH element = complexType.get_element -%]
'[% element.get_name %]' => \%[% XSD.perl_name(element.get_name) %]_of,
[% FOREACH element = complexType.get_element;
# ugly copied code - macro or plugin method?
name = XSD.perl_var_name(XSD.element_name(element)); -%]
'[% name %]' => \%[% XSD.perl_name(name) %]_of,
[% END -%]
},
{
[% FOREACH element = complexType.get_element;
IF (type = element.get_type);
element_type = definitions.first_types.find_type(complexType.expand( type )); -%]
'[% element.get_name %]' => '[% XSD.create_xsd_name(element_type) %]',
[% ELSE;
IF (ref = element.get_ref);
ref_element = definitions.first_types.find_element(element.expand( ref ));
-%]
'[% XSD.perl_var_name(XSD.element_name(ref_element)) %]' => '[% XSD.create_xsd_name(ref_element) %]',
[% ELSIF (type = element.get_type);
element_type = definitions.first_types.find_type(complexType.expand( type ));
IF (! element_type);
type_name = complexType.expand( type );
THROW NOT_FOUND, "${ type_name.0 } ${ type_name.1 } not found";
END;
-%]
'[% XSD.perl_var_name(XSD.element_name(element)) %]' => '[% XSD.create_xsd_name(element_type) %]',
[% ELSE;
IF (element.first_simpleType);
atomic_types.${ element.get_name } = element.first_simpleType;
ELSIF (element.first_complexType);
@@ -34,9 +50,14 @@ __PACKAGE__->_factory(
ELSE;
THROW NOT_IMPLEMENTED , "Neither simple nor complex atomic type for element ${ element.get_name } - don't know what to do with it";
END; %]
'[% element.get_name %]' => '[% XSD.create_subpackage_name({ value => element }) %]',
'[% XSD.perl_var_name(XSD.element_name(element)) %]' => '[% XSD.create_subpackage_name({ value => element }) %]',
[% END;
END -%]
},
{
[% FOREACH element = complexType.get_element; %]
'[% XSD.perl_var_name(XSD.element_name(element)); %]' => '[% element.get_name %]',
[%- END %]
}
);

View File

@@ -1,10 +1,16 @@
[% IF (complexType.get_variety == 'restriction');
INCLUDE complexType/restriction.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'extension');
INCLUDE complexType/extension.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'sequence');
INCLUDE complexType/extension.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'all');
INCLUDE complexType/extension.tt(complexType = complexType);
ELSE;
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
IF (complexType.get_variety);
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
ELSE -%]
# empty variety
[% END;
END;
%]

View File

@@ -1,28 +1,77 @@
[%
#
# extension
#
# unfortunately, SOAP::WSDL's speed tweaks don't play well with
# Class::Std's inheritance model.
#
# In Class::Std, all properties are stored in the class, and in objects
# using inheritance in the defining class.
#
# As the speed tweaks directly access the class' data without checking
# inheritance, the simplest way is to resolve complexType extension
# relationships
#
# To capture deep inheritance, extensions must be followed until a non-
# extension base is found
#
# TODO attribute handling is missing
# TODO sort out some better way to handle inheritance
base_name=complexType.expand( complexType.get_base );
element_list = [];
# copy complexType ref
base_type = complexType;
base_name = base_type.expand( base_type.get_base );
base_type = definitions.first_types.find_type( base_name );
element_from = complexType.get_element;
# add a use base for first to setup inheritance
%]
use base qw([% XSD.create_xsd_name( base_type ) %]);
[%
# loop forever
WHILE (1);
IF (complexType.get_variety == 'extension');
# wrap statement in IF to avoid printing
IF (complexType.set_variety( base_type.get_variety )); END;
END;
# make a copy. We don't want to modify the original list here...
FOREACH element = base_type.get_element.reverse;
element_list.unshift(element);
END;
# get next base type if there is one...
IF (base_type.get_base);
base_name=base_type.expand( base_type.get_base );
# set new base_type
base_type = definitions.first_types.find_type( base_name );
ELSE;
# exit loop if there is none
BREAK;
END;
END;
#
# Sanity check: All original elements must be noted first
# and now the new elements...
#
element_list = base_type.get_element;
element_from = complexType.get_element;
FOREACH element = element_from;
IF element_list.${ loop.index }.get_name != element.get_name;
element_list.push( element );
# THROW WSDL "${element.get_name} not found at position ${ loop.index } in extension type ${ complexType.get_name }";
END;
END;
complexType.set_element( element_list );
# set derived element list
# wrap in IF; END; to prevent it getting printed
IF ( complexType.set_element( element_list ) ); END;
-%]
use base qw([% XSD.create_xsd_name( base_type ) %]);
# Variety: [% complexType.get_variety %]
[%
INCLUDE complexType/variety.tt(complexType = complexType);
# restore original element list
# wrap in IF; END; to prevent it getting printed
IF ( complexType.set_element( element_from ) ); END;
%]

View File

@@ -7,8 +7,8 @@ ELSIF (complexType.get_variety == 'group');
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType group not implemented yet";
ELSIF (complexType.get_variety == 'choice');
INCLUDE complexType/all.tt(complexType = complexType);
ELSIF (complexType.get_variety);
THROW NOT_IMPLEMENTED, "Unknown variety ${ complexType.get_variety } in ${ complexType.get_name } (${ element.get_name })";
#ELSIF (complexType.get_variety);
# THROW NOT_IMPLEMENTED, "unknown variety ${ complexType.get_variety } in ${ complexType.get_name } (${ element.get_name })";
ELSE %]
# There's no variety - empty complexType

View File

@@ -76,6 +76,38 @@ Perl data type class for the XML Schema defined element
[% INCLUDE POD/annotation.tt(node = element) %]
[% IF (complexType = element.first_complexType);
IF (complexType.get_element); %]
[% head1 %] PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
=over
[% FOREACH child_element = complexType.get_element -%]
=item * [% XSD.perl_var_name(XSD.element_name(child_element)) %]
$element->set_[% XSD.perl_var_name(XSD.element_name(child_element)) %]($data);
$element->get_[% XSD.perl_var_name(XSD.element_name(child_element)) %]();
[% IF (XSD.perl_var_name(XSD.element_name(child_element)) == child_element.get_name); %]
[% ELSE %]
Note: The name of this property has been altered, because it didn't match
perl's notion of variable/subroutine names. The altered name is used in
perl code only, XML output uses the original name:
[% child_element.get_name %]
[% END %]
=back
[% END;
END;
END; -%]
[% head1 %] METHODS
[% head2 %] new

View File

@@ -4,11 +4,11 @@ use base qw(
[%
base_type = definitions.get_types.0.find_type(simpleType.expand(base));
IF ! base_type;
THROW NOT_FOUND "No base type in " _ simpleType.get_parent.get_name;
THROW NOT_FOUND "base type $base not found." _ simpleType.get_parent.get_name;
END;
XSD.create_xsd_name(base_type) %]);
[% ELSIF (type = simpleType.first_simpleType() );
INCLUDE simpleType/atomicType.tt(type = type);
ELSE;
THROW "neither base nor atomic type - don't know what to do" %]
[% END %]
[% END %]

View File

@@ -3,7 +3,7 @@ use strict;
use warnings;
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %definitions_of :ATTR(:name<definitions> :default<()>);
my %type_prefix_of :ATTR(:name<type_prefix> :default<()>);

View File

@@ -5,7 +5,7 @@ use base qw(SOAP::WSDL::Generator::Visitor
SOAP::WSDL::Generator::Template
);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
1;

View File

@@ -5,7 +5,7 @@ use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Generator::Visitor);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %path_of :ATTR(:name<path> :default<[]>);
my %typemap_of :ATTR(:name<typemap> :default<()>);
@@ -32,11 +32,14 @@ sub add_element_path {
# Well almost: Class names are not constructed in a namespace-sensitive
# manner, yet - there should be some facility to allow binding a (perl)
# prefix to a namespace...
push @{ $path_of{ ident $self } }, $element->get_name();
# push @{ $path_of{ ident $self } },
# "{". $element->get_targetNamespace . "}"
# . $element->get_name();
if (my $ref = $element->get_ref() ) {
$element = $self->get_definitions()->first_types()->find_element(
$element->expand($ref) );
}
my $name = $element->get_name();
push @{ $path_of{ ident $self } }, $name;
}
sub process_referenced_type {
@@ -61,14 +64,6 @@ sub process_referenced_type {
return $self;
}
sub process_atomic_type {
my ( $self, $type, $callback ) = @_;
return if not $type;
$callback->( $self, $type );
return $self;
}
sub visit_XSD_Element {
my ( $self, $ident, $element ) = ( $_[0], ident $_[0], $_[1] );
@@ -84,9 +79,11 @@ sub visit_XSD_Element {
# They all just return if no argument is given,
# and return $self on success.
SWITCH: {
my $name = $element->get_name();
if ($element->get_type) {
$self->process_referenced_type( $element->expand( $element->get_type() ) )
&& last;
$self->process_referenced_type( $element->expand( $element->get_type() ) );
last SWITCH;
}
# atomic simpleType typemap rule:
@@ -106,11 +103,23 @@ sub visit_XSD_Element {
my $typeclass = $self->get_resolver()->create_subpackage_name($element);
$self->set_typemap_entry($typeclass);
$self->process_atomic_type( $element->first_complexType()
, sub { $_[1]->_accept($_[0]) } )
&& last SWITCH;
if (my $complexType = $element->first_complexType()) {
$complexType->_accept($self);
last SWITCH;
}
# TODO: add element ref handling
# element ref handling
if (my $ref = $element->get_ref()) {
$element = $self->get_definitions()->first_types()->find_element(
$element->expand($ref) );
# we added a path too much - we should add the path of this
# element instead.
pop @{ $path_of{$ident} };
$element->_accept($self);
# and we must not pop it off now - thus, just return
return;
}
die "Neither type nor ref in element >". $element->get_name ."<. Don't know what to do."
};
# Safety measure. If someone defines a top-level element with
@@ -128,6 +137,7 @@ sub visit_XSD_Element {
sub visit_XSD_ComplexType {
my ($self, $ident, $type) = ($_[0], ident $_[0], $_[1] );
my $variety = $type->get_variety();
my $derivation = $type->get_derivation();
my $content_model = $type->get_contentModel;
return if not $variety; # empty complexType
return if ($content_model eq 'simpleContent');
@@ -138,10 +148,16 @@ sub visit_XSD_ComplexType {
for (@{ $type->get_element() || [] }) {
$_->_accept( $self );
}
return;
}
# Only continue for derived types
# Saves a uninitialized warning.
return if not $derivation;
if (grep { $_ eq $variety } qw(restriction extension) ) {
if ($derivation eq 'restriction' ) {
# TODO check and probably correct - this includes
# all base type's elements in a restriction derivation.
# Probably wrong.
#
# resolve base / get atomic type and run on elements
if (my $type_name = $type->get_base()) {
my $subtype = $self->get_definitions()
@@ -150,14 +166,19 @@ sub visit_XSD_ComplexType {
for (@{ $subtype->get_element() || [] }) {
$_->_accept( $self );
}
# that's all for restriction
return if ($variety eq 'restriction');
}
}
warn "unsupported content model $variety found in "
. "complex type " . $type->get_name()
. " - typemap may be incomplete";
elsif ($derivation eq 'extension' ) {
# resolve base / get atomic type and run on elements
while (my $type_name = $type->get_base()) {
$type = $self->get_definitions()
->first_types()->find_type( $type->expand($type_name) );
# visit child elements
for (@{ $type->get_element() || [] }) {
$_->_accept( $self );
}
}
}
}
1;

View File

@@ -0,0 +1,142 @@
=pod
=head1 NAME
SOAP::WSDL::Manual::Cookbook - SOAP::WSDL recipes
=head2 Accessing HTTPS webservices
You need Crypt::SSLeay installed to access HTTPS webservices.
=head2 Accessing protected web services
Passing a username and password, or a client certificate and key, to the
transport layer is highly dependent on the transport backend. The descriptions
below are for HTTP(S) transport usingLWP::UserAgent
=head3 Accessing HTTP(S) webservices with basic/digest authentication
When using SOAP::WSDL::Transport::HTTP (SOAP::Lite not installed), add a
method called "get_basic_credentials" to SOAP::WSDL::Transport::HTTP:
*SOAP::WSDL::Transport::HTTP::get_basic_credentials = sub {
return ($user, $password);
};
When using SOAP::Transport::HTTP (SOAP::Lite is installed), do the same to
this backend:
*SOAP::Transport::HTTP::Client::get_basic_credentials = sub {
return ($user, $password);
};
=head3 Accessing HTTP(S) webservices protected by NTLM authentication
You need the L<NTLM|NTLM> distribution installed to access webservices protected
by NTLM authentication. More specifically, you need the Authen::NTLM module
from this distribution. Note that this is different from the Authen::NTML
distribution by Yee Man Chan also available from CPAN.
Your user credentials usually need to include the windows domain like this:
testdomain\testuser
Besides passing user credentials as when accessing a web service protected
by basic or digest authentication, you also need to enforce connection
keep_alive on the transport backens.
To do so, pass a I<proxy> argument to the new() method of the generated
class. This unfortunately means that you have to set the endpoint URL, too:
my $interface = MyInterfaces::SERVICE_NAME::PORT_NAME->new({
proxy => [ $url, keep_alive => 1 ]
});
You may, of course, decide to just hack the generated class. Be advised that
subclassing might be a more appropriate solution - re-generating overwrites
changes in interface classes.
=head3 Accessing HTTPS webservices protected by certificate authentication
You need Crypt::SSLeay installed to access HTTPS webservices.
See L<Crypt::SSLeay> on how to configure client certificate authentication.
=head1 XML OUTPUT
=head2 Outputting namespaces as prefixes
Q: I need to interface with a SOAP server which doesn't accept the following
format:
<SOAP-ENV:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
<SOAP-ENV:Body>
<getElement xmlns="http://services.company.com/">
<elementId>12345</elementId>
</getElement>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
Instead, it requires this:
<SOAP-ENV:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:ns2="http://services.company.com/"
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
<SOAP-ENV:Body>
<ns2:getElement>
<ns2:elementId>12345</ns2:elementId>
</ns2:getElement>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
How do I do this using SOAP::WSDL?
A: The following steps are neccessary to achieve this result:
First, you would need to write a new serializer, which is quite easy, as it
just creates the envelope and calls ->serialize_qualified() on $header and
$body to fill them in. The new serializer has to declare all namespace
prefixes used, the rest is just the same as the original XSD serializer.
Second, you'd need to overwrite the start_tag method in
L<SOAP::WSDL::XSD::Typelib::Element|SOAP::WSDL::XSD::Typelib::Element> to use
the appropriate prefixes for the body elements.
In contrast to the original method, it would probably look up the appropriate
prefix from some data set in the serializer class, so this could be the
appropriate place to load SOAP::WSDL::XSD::Typelib::Element and override the
method.
Something like this should do (without the handling of specialties like empty
or nil elements):
%PREFIX_OF = { 'http://services.company.com/' => 'ns2' };
*SOAP::WSDL::XSD::Typelib::Element::start_tag = sub {
# use prefix instead of xmlns attribute and copy the rest from
# SOAP::WSDL::XSD::Typelib::Element::start_tag
my $prefix = $PREFIX_OF{ $_[0]->get_xmlns() };
my $name = $_[1]->{ name } || $self->__get_name();
return "<$prefix:$name>";
}
=head1 LICENSE AND COPYRIGHT
Copyright 2008 Martin Kutter.
This library is free software. You may distribute/modify it under
the same terms as perl itself
=head1 AUTHOR
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 583 $
$LastChangedBy: kutterma $
$Id: $
$HeadURL: $
=cut

View File

@@ -0,0 +1,152 @@
=pod
=head1 NAME
SOAP::WSDL::Manual::FAQ - Frequently Asked Questions (and answers)
=head1 Development status
=head2 Can I use SOAP::WSDL in a production environment?
Yes. SOAP::WSDL is used in production environments. You should - as always -
apply common sense and take appropriate safety measures, especially if
running SOAP::WSDL as a server.
=head2 Can I throw the WSDL away after generating?
Please don't. Future versions of SOAP::WSDL may require you to re-generate
interfaces in order to use them.
=head1 SOAP/WSDL Version and message styles
=head2 Which SOAP / WSDL versions does SOAP::WSDL support?
SOAP1.1 and WSDL1.1. SOAP1.2 and WSDL2 are not supported yet.
=head2 Which SOAP message Styles are supported?
document/literal.
The message / encoding styles rpc/encoded and rpc/literal are not supported
(rpc/literal is hardly used).
rpc/literal is not implemented yet.
Unfortunately, SOAP::WSDL can't even parse many rpc/encoded WSDL definitions,
and thus cannot inform you about unsupported message styles in some
situations.
=head1 Aren't rpc variants bad anyway?
No. They can be as well-defined and useful as the document/literal variant.
The difference between rpc and document is that rpc SOAP messages have an
additional container named after the remote procedure called.
rpc/literal is RPC with named parameters, whereas rpc/encoded corresponds to
positional parameters.
rpc/encoded is prohibited by the WS-I Basic Profile. However, rpc/encoded
is still popular, especially for scripting languages like perl, python or php.
You should probably use L<SOAP::Lite|SOAP::Lite> for rpc/encoded web services.
All the document/rpc literal/encoded discussion will cede with WSDL2.0: These
variants are dropped in favour of an extensible operation style mechanism.
=head1 XML Parsing / Generation
=head2 Does SOAP::WSDL support namespaces?
Well, sort of. SOAP::WSDL can use WSDL definitions containing namespaces,
and emits SOAP messages with namespace information.
Its SOAP message parser however, is not namespace sensitive but uses the
pre-shared information from the WSDL for looking up what each XML node means.
SOAP::WSDL can parse SOAP messages including namespace informations up to the
point where equally named elements from different namespaces may appear at
the same position.
This is a long-standing feature request and will eventually be resolved.
=head2 Validation
=head3 Does SOAP::WSDL perform XML Schema Validation?
No, SOAP::WSDL does not perform XML Schema Validation. It does, however,
enforce the correct structure on both XML and perl data. Occurrence, ordering,
value-spaces, and identity constraints are not checked.
=head3 Does SOAP::WSDL perform XML Validation?
No, SOAP::WSDL does not perform XML Validation (that is, validation against
a DTD). WS-I prohibits the use of DTDs in WSDL definitions.
=head3 Isn't validation required for XML?
No. The XML Specification does not require validation from XML processors.
It states how validating and non-validating parsers must react on errors.
Note: Validation in the context of (only) XML actually means DTD validation.
=head3 And doesn't XML Schema require validation?
The XML Schema specification requires conformant XML Schema processors to
be able to validate XML Schema constraints.
SOAP::WSDL is not a conformant XML Schema processor in this sense, as it does
not validate all XML Schema constraints.
=head3 And does SOAP require XML Schema Validation?
No. The SOAP1.1 note does not say anything about validation. The SOAP1.2.
specification explicitly states that XML Schema validation is not required
for the SOAP envelope, and that applications may decide whether they need
XML Schema Validation for the SOAP payload or not.
The WSDL 1.1. specification does not mandate XML Schema validation. It does
actually not even mandate the use of XML Schema for type definitions.
=head2 Can SOAP::WSDL parse SOAP message fragments?
No. SOAP::WSDL can parse neither well-formed nor not-well-formed
SOAP message chunks.
=head1 Persistence
=head2 Can I use Storable to freeze/thaw SOAP::WSDL's objects?
You can freeze almost all of SOAP::WSDL's objects. The only exceptions are
the objects used in parsing WSDL definitions itself - they cannot be frozen.
Note that freezing/thawing inside-out objects comes with a performance penalty
and is at around the speed of XML generation/parsing.
=head1 Performance and memory consumption
=head2 How fast is SOAP::WSDL?
As of this writing, SOAP::WSDL is the fastest SOAP Client toolkit for perl
available on CPAN. There are no published server benchmarks yet.
If you need extra speed you can try SOAP::WSDL_XS available
from SOAP::WSDL's subversion repository at:
https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL_XS/trunk
Note however that SOAP::WSDL_XS is not very mature yet and only suitable for
use in trusted environments - you definitely should not use it on a public
internet SOAP server yet.
Note further that SOAP::WSDL's inside-out objects come with a big performance
penalty when freezing/thawing them with Storable.
=head2 There's a lot of perl modules generated. Don't they eat up all my
memory?
SOAP::WSDL usually uses a bit more memory than SOAP::Lite, but less than
XML::Compile. Test if in question.
=cut

View File

@@ -93,7 +93,7 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
$Rev: 391 $
$LastChangedBy: kutterma $
$Id: Glossary.pod 391 2007-11-17 21:56:13Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Manual/Glossary.pod $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Manual/Glossary.pod $
=cut

View File

@@ -241,7 +241,7 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
$Rev: 391 $
$LastChangedBy: kutterma $
$Id: Parser.pod 391 2007-11-17 21:56:13Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Manual/Parser.pod $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Manual/Parser.pod $
=cut

View File

@@ -1255,7 +1255,7 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
$Rev: 562 $
$LastChangedBy: kutterma $
$Id: WS_I.pod 562 2008-02-22 20:32:17Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Manual/WS_I.pod $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Manual/WS_I.pod $
=cut

View File

@@ -90,10 +90,8 @@ can just say
Of course this will only work if MyTypes::NewType has a superset of the old
object class' elements.
.
Future versions will restrict the data returned to the child element's data -
you should not expect XML attributes to be returned through hash refs.
Note that XML attribute data is not included in the hash ref output yet.
=head1 HOW IT WORKS
@@ -405,7 +403,7 @@ supported (yet).
=item * import
The import includion element requires the schemaLocation attribute for
The import inclusion element requires the schemaLocation attribute for
resolving the XML schema to import. Support for the import element is
implemented in L<SOAP::WSDL::Expat::WSDLParser|SOAP::WSDL::Expat::WSDLParser>,
so alternative parsers may or may not support the import element.

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %part_of :ATTR(:name<part> :default<[]>);

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %body_of :ATTR(:name<body> :default<[]>);
my %header_of :ATTR(:name<header> :default<[]>);

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %operation_of :ATTR(:name<operation> :default<()>);
my %input_of :ATTR(:name<input> :default<[]>);

View File

@@ -6,7 +6,7 @@ use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %element_of :ATTR(:name<element> :default<()>);
my %type_of :ATTR(:name<type> :default<()>);

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %binding_of :ATTR(:name<binding> :default<()>);
my %address_of :ATTR(:name<address> :default<()>);

View File

@@ -2,33 +2,26 @@ package SOAP::WSDL::PortType;
use strict;
use warnings;
use Class::Std::Fast::Storable;
use List::Util;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %operation_of :ATTR(:name<operation> :default<()>);
my %attributes_of :ATTR();
#
#=head2 find_operation
#
#$port_type->find_operation($namespace, $name)
#
#Returns the PortType's operation object matching the given namespace and
#name
#
%attributes_of = (
operation => \%operation_of,
);
# Function factory - we could be writing this method for all %attribute
# keys, too, but that's just C&P (eehm, Copy & Paste...)
foreach my $method(keys %attributes_of ) {
no strict qw(refs); ## no critic ProhibitNoStrict
# ... btw, we mean this method here...
*{ "find_$method" } = sub {
my ($self, @args) = @_;
my @found_at = grep {
$_->get_targetNamespace() eq $args[0] &&
$_->get_name() eq $args[1]
}
@{ $attributes_of{ $method }->{ ident $self } };
return $found_at[0];
};
}
sub find_operation {
return List::Util::first {
( $_->get_targetNamespace() eq $_[1] ) && ( $_->get_name() eq $_[2] )
} @{ $operation_of{ ${ $_[0] } } };
};
1;

View File

@@ -4,7 +4,7 @@ use warnings;
use base qw(SOAP::WSDL::Base);
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %location :ATTR(:name<location> :default<()>);
1;

View File

@@ -4,7 +4,7 @@ use warnings;
use base qw(SOAP::WSDL::Base);
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %use_of :ATTR(:name<use> :default<q{}>);
my %namespace_of :ATTR(:name<namespace> :default<q{}>);

View File

@@ -4,7 +4,7 @@ use warnings;
use base qw(SOAP::WSDL::Base);
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %use_of :ATTR(:name<use> :default<q{}>);
my %namespace_of :ATTR(:name<namespace> :default<q{}>);

View File

@@ -3,6 +3,6 @@ use strict;
use warnings;
use base qw(SOAP::WSDL::Header);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
1;

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %style_of :ATTR(:name<style> :default<()>);
my %soapAction_of :ATTR(:name<soapAction> :default<()>);

View File

@@ -3,7 +3,7 @@ use strict;
use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
use SOAP::WSDL::XSD::Typelib::ComplexType;
use SOAP::WSDL::XSD::Typelib::Element;
@@ -37,7 +37,7 @@ __PACKAGE__->_factory(
sub get_xmlns { return 'http://schemas.xmlsoap.org/soap/envelope/' };
__PACKAGE__->__set_name('Fault');
__PACKAGE__->__set_nillable();
__PACKAGE__->__set_nillable(0);
__PACKAGE__->__set_minOccurs();
__PACKAGE__->__set_maxOccurs();
__PACKAGE__->__set_ref('');
@@ -101,10 +101,10 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 728 $
$LastChangedBy: kutterma $
$Id: Fault11.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm $
$Id: Fault11.pm 728 2008-07-13 19:28:50Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm $
=cut

View File

@@ -5,7 +5,7 @@ use warnings;
use Class::Std::Fast::Storable;
use Scalar::Util qw(blessed);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
use SOAP::WSDL::Factory::Serializer;
@@ -36,6 +36,10 @@ sub serialize {
{
$xml .= "xmlns:$prefix=\"$uri\" ";
}
#
# add namespace for user-supplied prefix if needed
$xml .= "xmlns:$opt->{prefix}=\"" . $args_of_ref->{ body }->get_xmlns() . "\" "
if $opt->{prefix};
# TODO insert encoding
$xml.='>';
@@ -46,7 +50,7 @@ sub serialize {
}
sub serialize_header {
my ($self, $name, $data, $opt) = @_;
my ($self, $method, $data, $opt) = @_;
# header is optional. Leave out if there's no header data
return q{} if not $data;
@@ -58,7 +62,11 @@ sub serialize_header {
}
sub serialize_body {
my ($self, $name, $data, $opt) = @_;
my ($self, $method, $data, $opt) = @_;
# TODO This one wipes out the old class' XML name globally
# Fix in some more appropriate place...
$data->__set_name("$opt->{prefix}:" . $data->__get_name() ) if $opt->{prefix};
# Body is NOT optional. Serialize to empty body
# if we have no data.
@@ -68,7 +76,9 @@ sub serialize_body {
? ref $data eq 'ARRAY'
? join q{}, map { blessed $_ ? $_->serialize_qualified() : () } @{ $data }
: blessed $data
? $data->serialize_qualified()
? $opt->{prefix}
? $data->serialize()
: $data->serialize_qualified()
: ()
: (),
"</$opt->{ namespace }->{ $SOAP_NS }\:Body>",
@@ -122,10 +132,10 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 735 $
$LastChangedBy: kutterma $
$Id: XSD.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Serializer/XSD.pm $
$Id: XSD.pm 735 2008-08-14 07:36:54Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Serializer/XSD.pm $
=cut

View File

@@ -6,7 +6,7 @@ use Scalar::Util qw(blessed);
use SOAP::WSDL::Factory::Deserializer;
use SOAP::WSDL::Factory::Serializer;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %dispatch_to_of :ATTR(:name<dispatch_to> :default<()>);
my %action_map_ref_of :ATTR(:name<action_map_ref> :default<{}>);
@@ -199,6 +199,38 @@ SOAP::Server's deserializer create one for you:
You may use any other object as exception, provided it has a
serialize() method which returns the object's XML representation.
=head2 Subclassing
To write a transport-specific SOAP Server, you should subclass
SOAP::WSDL::Server.
See the C<SOAP::WSDL::Server::*> modules for examples.
A SOAP Server must call the following method to actually handle the request:
=head3 handle
Handles the SOAP request.
Returns the response message as XML.
Expects a C<HTTP::Request> object as only parameter.
You may use any other object as parameter, as long as it implements the
following methods:
=over
=item * header
Called as header('SOAPAction'). Must return the corresponding HTTP header.
=item * content
Returns the request message
=back
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2008 Martin Kutter.

View File

@@ -2,6 +2,8 @@ package SOAP::WSDL::Server::CGI;
use strict;
use warnings;
use Encode;
use HTTP::Request;
use HTTP::Response;
use HTTP::Status;
@@ -12,7 +14,7 @@ use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Server);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.06');
# mostly copied from SOAP::Lite. Unfortunately we can't use SOAP::Lite's CGI
# server directly - we would have to swap out it's base class...
@@ -80,7 +82,7 @@ sub handle {
else {
$response = HTTP::Response->new(200);
$response->header('Content-type' => 'text/xml; charset="utf-8"');
$response->content( $response_message );
$response->content( encode('utf8', $response_message ) );
{
use bytes;
$response->header('Content-length', length $response_message);

View File

@@ -0,0 +1,285 @@
package SOAP::WSDL::Server::Mod_Perl2;
use strict;
use warnings;
use base qw(SOAP::WSDL::Server);
use Scalar::Util qw(blessed);
use HTTP::Request ();
use Apache2::RequestIO (); # $r->read()
use Apache2::RequestRec (); # $r->headers_in
use Apache2::RequestUtil(); # $r->dir_config()
use APR::Table (); # $r->headers_in->get()
use Apache2::Log (); # $r->log
use Apache2::Const -compile => qw(
OK
SERVER_ERROR
HTTP_LENGTH_REQUIRED
);
use version; our $VERSION = qv('2.00.05');
my %LOADED_OF = ();
sub handler {
my $r = shift;
my $rlog = $r->log();
#
# Set up section; import requested modules, throwing errors if we're
# unable to do so. For maximum performance, this should be re-worked
# to use perl-based Apache directives rather than dir_config(), since
# the former happens at startup time and the latter at request time.
#
# dispatch_to
my $dispatch_to = $r->dir_config('dispatch_to');
if (! $dispatch_to) {
$rlog->error("No 'dispatch_to' variable set in httpd.conf");
return Apache2::Const::SERVER_ERROR;
}
if (! exists $LOADED_OF{$dispatch_to}) {
eval "require $dispatch_to";
if ($@) {
$rlog->error("Failed to require [$dispatch_to]: $@");
return Apache2::Const::SERVER_ERROR;
}
$LOADED_OF{$dispatch_to} = undef;
}
#
# SOAP service
my $soap_service_package = $r->dir_config('soap_service');
if (! $soap_service_package) {
$rlog->error("No 'soap_service' variable set in httpd.conf");
return Apache2::Const::SERVER_ERROR;
}
if (! exists $LOADED_OF{$soap_service_package}) {
eval "require $soap_service_package";
if ($@) {
$rlog->error("Failed to require [$soap_service_package]: $@");
return Apache2::Const::SERVER_ERROR;
}
$LOADED_OF{$soap_service_package} = undef;
}
#
# transport_class (optional)
my $transport_class = $r->dir_config('transport_class');
if ($transport_class) {
eval "require $transport_class";
if ($@) {
$rlog->error("Failed to require [$transport_class]: $@");
return Apache2::Const::SERVER_ERROR;
}
}
else {
#
# if no transport class was specified, use this package's handle()
# method
$transport_class = __PACKAGE__;
}
#
# instantiate SOAP server object
my $server = $soap_service_package->new({
dispatch_to => $dispatch_to, # methods
transport_class => $transport_class, # handle() call
});
my $response_msg = $server->handle($r);
if ($response_msg =~ /^\d{3}$/) {
#
# a 3-digit number is presumed to be an HTTP return status; since
# we got this and not a SOAP response, it's presumed to be an
# error; pass it back to the client as-is
$rlog->error("Dispatcher returned HTTP $response_msg");
return $response_msg;
}
if ($response_msg) {
$r->content_type('text/xml; charset="utf-8"');
$r->print($response_msg);
return Apache2::Const::OK;
}
else {
$rlog->error("No response returned from dispatcher");
return Apache2::Const::SERVER_ERROR;
}
}
sub handle {
my ($self, $r) = @_;
my $rlog = $r->log();
my $length = $r->headers_in->get('content-length');
if (! $length) {
$rlog->error("No content-length provided");
# TODO maybe throw instead of returning a HTTP code?
# ... it's an exception, anyway...
return Apache2::Const::HTTP_LENGTH_REQUIRED;
}
# read may return less than requested - read until there's no more...
# TODO: We should note that LimitRequestBody is a must in apache config
my ($buffer, $read_length);
my $content = q{};
while ($read_length = $r->read($buffer, $length)) {
$content .= $buffer;
}
if ($length != length $content) {
$rlog->error("Read length mismatch; read [" . length($content) . "] bytes but received [$length] bytes");
return Apache2::Const::SERVER_ERROR;
}
# Shamelessly copied (with mild tweaks) from SOAP::WSDL::Server::CGI
# ... which was as shamelessly copied from SOAP::Transport::HTTP...
my $request = HTTP::Request->new(
$r->method => $r->uri,
HTTP::Headers->new(
SOAPAction => $r->headers_in()->get('SOAPAction'),
),
$content,
);
my $response_message = eval { $self->SUPER::handle($request) };
# TODO return response if @$ is a SOAP::WSDL::XSD::Typelib::Builtin::anyType object
if ($@ || blessed($@)) {
$rlog->error("Failed to handle request: $@");
return Apache2::Const::SERVER_ERROR;
}
else {
return $response_message;
}
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::Server::Mod_Perl2 - mod_perl based SOAP server using SOAP::WSDL
=head1 DESCRIPTION
Perl module providing a mod_perl2-based SOAP server using SOAP::WSDL
=head1 CONFIGURATION
Configuration is managed through the use of PerlSetVar directives.
The following variables are available:
=head2 dispatch_to
Takes as a single argument the package name of the module which contains
the methods which handle SOAP requests.
PerlSetVar dispatch_to "WebPackage::SOAPMethods"
=head2 soap_service
Takes as a single argument the package name of the Server module
generated by SOAP::WSDL using
wsdl2perl.pl --server file:///path/to/your/wsdl
By default, the name of the package is MyServer::$SERVICENAME::$PORTTYPE.
EXAMPLE: Given this sample WSDL which wsdl2perl.pl was run against to generate
perl packages:
<wsdl:portType name="WebServiceSoap">
[...]
</wsdl:portType>
[...]
<wsdl:service name="WebService">
<wsdl:port name="WebServiceSoap" binding="tns:WebServiceSoap">
<soap:address location="http://www.example.com/WebService"/>
</wsdl:port>
</wsdl:service>
The following directive would be correct:
PerlSetVar soap_service "MyServer::WebService::WebServiceSoap"
=head2 transport_class [OPTIONAL]
Takes as a single argument the package name of the perl module containing a
handle() method used to assemble the HTTP request which will be passed to the
methods in your L<dispatch_to> module (see above). A default handle() method
is supplied in this module which should handle most common cases.
handle() is called with the following parameters:
$r - Apache::RequestRec object
=head1 EXAMPLES
The following snippet added to httpd.conf will enable a SOAP server at
/WebService on your webserver:
<Location /WebService>
SetHandler perl-script
PerlResponseHandler SOAP::WSDL::Server::Mod_Perl2
PerlSetVar dispatch_to "WebPackage::SOAPMethods"
PerlSetVar soap_service "MyServer::WebService::WebServiceSoap"
</Location>
=head1 PERFORMANCE
On my machine, a simple SOAP server (the HelloWorld service from the examples)
needs around 20s to process 300 requests to a CGI script implemented with
SOAP::WSDL::Server::CGI, around 4.5s to the same CGI with mod_perl enabled,
and around 3.2s with SOAP::WSDL::Server::Mod_Perl2. All these figures
include the time for creating the request and parsing the response.
As general advice, using mod_perl is highly recommended in high-performance
environments. Using SOAP::WSDL::Server::Mod_Perl2 yields an extra 20% speedup
compared with mod_perl enabled CGI scripts - and it allows one to configure
SOAP servers in the Apache config.
=head1 THREAD SAFETY
SOAP::WSDL uses Class::Std::Fast, which is not guaranteed to be threadsafe
yet. Thread safety in Class::Std::Fast is dependent on whether
my $foo = $bar++;
is an atomic operation. I haven't found out yet.
A load test on a single CPU machine with 4 clients using the worker mpm
did not reveal any threading issues - but that does not mean there are none.
=head1 CREDITS
Contributed (along with lots of other little improvements) by Noah Robin.
Thanks!
=head1 LICENSE AND COPYRIGHT
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself
=head1 AUTHOR
Noah Robin E<lt>noah.robin gmail.comE<gt>
Based on SOAP::WSDL::Server::CGI, by Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 583 $
$LastChangedBy: kutterma $
$Id: $
$HeadURL: $
=cut

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %port_of :ATTR(:name<port> :default<[]>);

View File

@@ -1,8 +1,8 @@
package SOAP::WSDL::Transport::HTTP;
use strict;
use strict; use warnings;
use base qw(LWP::UserAgent);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
# create methods normally inherited from SOAP::Client
SUBFACTORY: {
@@ -23,9 +23,10 @@ sub send_receive {
$encoding = defined($encoding)
? lc($encoding)
: 'utf8';
: 'utf-8';
$content_type = 'text/xml' if not defined($content_type);
$content_type = "text/xml; charset=$encoding"
if not defined($content_type);
# what's this all about?
# unfortunately combination of LWP and Perl 5.6.1 and later has bug
# in sending multibyte characters. LWP uses length() to calculate
@@ -48,7 +49,7 @@ sub send_receive {
my $request = HTTP::Request->new( 'POST',
$endpoint,
[ 'Content-Type', "$content_type; charset=$encoding",
[ 'Content-Type', "$content_type",
'Content-Length', $bytelength,
'SOAPAction', $soap_action,
],
@@ -90,10 +91,10 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 616 $
$Rev: 744 $
$LastChangedBy: kutterma $
$Id: HTTP.pm 616 2008-04-22 21:51:49Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Transport/HTTP.pm $
$Id: HTTP.pm 744 2008-10-15 16:58:45Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Transport/HTTP.pm $
=cut

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'basic';
use SOAP::WSDL::Factory::Transport;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
# register on loading
SOAP::WSDL::Factory::Transport->register( http => __PACKAGE__ );

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use SOAP::WSDL::Factory::Transport;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
SOAP::WSDL::Factory::Transport->register( http => __PACKAGE__ );
SOAP::WSDL::Factory::Transport->register( https => __PACKAGE__ );
@@ -33,7 +33,7 @@ sub send_receive {
$filename =~s{ (:?'|")\z }{}xms;
$filename =~s{ \A [^:]+ : (:? /{2})? }{}xms;
$filename = join '/', $base_dir_of{ ident $self }, "$filename.xml";
$filename = join '/', $base_dir_of{ ${ $self } }, "$filename.xml";
if (not -r $filename) {
warn "cannot access $filename";
@@ -126,4 +126,4 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
$Id: HTTP.pm 218 2007-09-10 16:19:23Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Transport/HTTP.pm $
=cut
=cut

View File

@@ -2,7 +2,7 @@ package SOAP::WSDL::TypeLookup;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %TYPE_FROM = (
# wsdl:
@@ -231,9 +231,7 @@ my %TYPE_FROM = (
$TYPE_FROM{ 'http://www.w3.org/2000/10/XMLSchema' } = $TYPE_FROM{ 'http://www.w3.org/2001/XMLSchema' };
sub lookup {
my $self = shift;
my $namespace = shift || 'http://schemas.xmlsoap.org/wsdl/';
my $name = shift;
my ($self, $namespace, $name) = @_;
return $TYPE_FROM{ $namespace }->{ $name };
}

View File

@@ -5,7 +5,7 @@ use SOAP::WSDL::XSD::Schema::Builtin;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
my %schema_of :ATTR(:name<schema> :default<[]>);

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
#<enumeration value="">

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
#<attribute
# default = string

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
#<attributeGroup
# id = ID

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
# only used in SOAP::WSDL - will be obsolete once SOAP::WSDL uses the
# generative approach, too

View File

@@ -1,12 +1,11 @@
package SOAP::WSDL::XSD::ComplexType;
use strict;
use warnings;
use Carp;
use Class::Std::Fast::Storable;
use Scalar::Util qw(blessed);
use base qw/SOAP::WSDL::Base/;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.06');
# id provided by Base
# name provided by Base
@@ -26,14 +25,17 @@ my %maxInclusive :ATTR(:name<maxInclusive> :default<[]>);
my %attribute_of :ATTR(:name<attribute> :default<()>);
my %element_of :ATTR(:name<element> :default<()>);
my %element_of :ATTR(:name<element> :default<[]>);
my %group_of :ATTR(:name<group> :default<()>);
my %variety_of :ATTR(:name<variety> :default<()>);
my %base_of :ATTR(:name<base> :default<()>);
my %itemType_of :ATTR(:name<itemType> :default<()>);
my %abstract_of :ATTR(:name<abstract> :default<()>);
my %final_of :ATTR(:name<final> :default<()>);
my %mixed_of :ATTR(:name<mixed> :default<()>); # default is false
my %derivation_of :ATTR(:name<derivation> :default<()>);
# is set to simpleContent/complexContent
my %content_model_of :ATTR(:name<contentModel> :default<NONE>);
@@ -59,6 +61,7 @@ sub set_restriction {
my $self = shift;
my $element = shift;
$variety_of{ ident $self } = 'restriction';
$derivation_of{ ident $self } = 'restriction';
$base_of{ ident $self } = $element->{ Value };
}
@@ -66,6 +69,7 @@ sub set_extension {
my $self = shift;
my $element = shift;
$variety_of{ ident $self } = 'extension';
$derivation_of{ ident $self } = 'extension';
$base_of{ ident $self } = $element->{ Value };
}
@@ -107,6 +111,19 @@ sub serialize {
if ( ($variety eq "sequence") or ($variety eq "all") ) {
$opt->{ indent } .= "\t";
for my $element (@{ $self->get_element() }) {
# resolve element ref
#
# Basic algorithm is like this:
# If on serialization, we meet a element whose get_ref method
# returns a true value, lookup the element from the <types>
# definitions instead, and serialize this element.
#
if (my $ref = $element->get_ref()) {
$element = $opt->{ typelib }->find_element(
$element->expand($ref)
);
}
# might be list - listify
$value = [ $value ] if not ref $value eq 'ARRAY';

View File

@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.05');
# id provided by Base
# name provided by Base

Some files were not shown because too many files have changed in this diff Show More