diff --git a/Build.PL b/Build.PL index e993b19..1b95426 100644 --- a/Build.PL +++ b/Build.PL @@ -4,7 +4,7 @@ Module::Build->new( create_makefile_pl => 'passthrough', dist_abstract => 'SOAP with WSDL support', dist_name => 'SOAP-WSDL', - dist_version => '2.00_13', + dist_version => '2.00_14', module_name => 'SOAP::WSDL', license => 'artistic', requires => { diff --git a/CHANGES b/CHANGES index f3605ea..3202095 100644 --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,4 @@ -Release notes for SOAP::WSDL 2.00_12 +Release notes for SOAP::WSDL 2.00_14 ------- I'm very happy to present a new pre-release version of SOAP::WSDL. @@ -22,14 +22,40 @@ Features: * Plugin support. SOAP::WSDL can be extended through plugins in various aspects. The following plugins are supported: o Transport plugins via SOAP::WSDL::Factory::Transport - o Serializer plugins via SOAP::WSDL::Factory::Serializer + o Serializer plugins via SOAP::WSDL::Factory::Serializer + o Deserializer plugins via SOAP::WSDL::Factory::Serializer The following changes have been made: + +2.00_14 +---- + +The following bugs have been fixed (the numbers in square brackets are the +tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921): + + * [ 1792235 ] SOAP::WSDL::Transport::Test missing from 2.00_13 + The package has been re-added + + * [ 1792221 ] class_resolver not set from ::Client in 2.00_13 + Changed to set class_resolver correctly. + +The following uncategorized improvements have been made: + + * The ::SOM deserializer has been simplified to be just a subclass + of SOAP::Deserializer from SOAP::Lite + * Factories now emit more useful error messages when no class is registered + for the protocol/soap_version requested + * Documentation has been improved + - refined ::Factory:: modules' documentation + * Several tests have been added + * XSD classes have been improved for testability + 2.00_13 ---- The following features were added (the numbers in square brackets are the tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924): + * [ 1790619 ] Test transport backend A test transport backend has been implemented (SOAP::WSDL::Transport::Test). It returns the contents from a file and discards the response. @@ -62,7 +88,7 @@ tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921): * [1785646] SOAPAction header not set from soap:operation soapAction SOAP::WSDL now sets the SOAPAction header correctly. -The following uncategorized improvements have been mad: +The following uncategorized improvements have been made: * Documentation improvements diff --git a/MANIFEST b/MANIFEST index 7b65424..4b9d43b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -63,6 +63,7 @@ lib/SOAP/WSDL/Service.pm lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm lib/SOAP/WSDL/SoapOperation.pm lib/SOAP/WSDL/Transport/HTTP.pm +lib/SOAP/WSDL/Transport/Test.pm lib/SOAP/WSDL/TypeLookup.pm lib/SOAP/WSDL/Types.pm lib/SOAP/WSDL/XSD/Builtin.pm @@ -123,7 +124,7 @@ lib/SOAP/WSDL/XSD/Typelib/Element.pm lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm LICENSE Makefile.PL -MANIFEST This list of files +MANIFEST META.yml README t/001_use.t @@ -206,9 +207,14 @@ t/SOAP/WSDL/05_simpleType-restriction.t t/SOAP/WSDL/05_simpleType-union.t t/SOAP/WSDL/11_helloworld.NET.t t/SOAP/WSDL/12_binding.pl -t/SOAP/WSDL/XSD/Typelib/Builtin/001_string.t -t/SOAP/WSDL/XSD/Typelib/Builtin/002_dateTime.t +t/SOAP/WSDL/Transport/01_Test.t +t/SOAP/WSDL/Transport/acceptance/test2.xml +t/SOAP/WSDL/Transport/acceptance/test3.xml +t/SOAP/WSDL/XSD/Typelib/Builtin/001_anyType.t +t/SOAP/WSDL/XSD/Typelib/Builtin/002_anySimpleType.t t/SOAP/WSDL/XSD/Typelib/Builtin/003_date.t t/SOAP/WSDL/XSD/Typelib/Builtin/004_time.t +t/SOAP/WSDL/XSD/Typelib/Builtin/005_dateTime.t +t/SOAP/WSDL/XSD/Typelib/Builtin/006_string.t t/test.pl TODO diff --git a/META.yml b/META.yml index 838a34d..de76fed 100644 --- a/META.yml +++ b/META.yml @@ -1,6 +1,6 @@ --- name: SOAP-WSDL -version: 2.00_13 +version: 2.00_14 author: abstract: SOAP with WSDL support license: artistic @@ -30,7 +30,7 @@ provides: file: lib/SOAP/WSDL/Binding.pm SOAP::WSDL::Client: file: lib/SOAP/WSDL/Client.pm - version: 2.00_13 + version: 2.00_14 SOAP::WSDL::Client::Base: file: lib/SOAP/WSDL/Client/Base.pm SOAP::WSDL::Definitions: @@ -40,7 +40,7 @@ provides: version: 2.00_13 SOAP::WSDL::Deserializer::SOM: file: lib/SOAP/WSDL/Deserializer/SOM.pm - version: 2.00_13 + version: 2.00_14 SOAP::WSDL::Expat::MessageParser: file: lib/SOAP/WSDL/Expat/MessageParser.pm SOAP::WSDL::Expat::MessageStreamParser: @@ -78,6 +78,9 @@ provides: file: lib/SOAP/WSDL/SoapOperation.pm SOAP::WSDL::Transport::HTTP: file: lib/SOAP/WSDL/Transport/HTTP.pm + SOAP::WSDL::Transport::Test: + file: lib/SOAP/WSDL/Transport/Test.pm + version: 2.00_14 SOAP::WSDL::TypeLookup: file: lib/SOAP/WSDL/TypeLookup.pm SOAP::WSDL::Types: diff --git a/example/weather_wsdl.pl b/example/weather_wsdl.pl index b3f3040..be68355 100644 --- a/example/weather_wsdl.pl +++ b/example/weather_wsdl.pl @@ -31,9 +31,9 @@ print $som->result(); # set on the GetWeather SOAP::Data object from the WSDL. use SOAP::Lite; # +trace; -my $soap = SOAP::Lite->new()->on_action( sub { join'/', @_ } ) +$soap = SOAP::Lite->new()->on_action( sub { join'/', @_ } ) ->proxy("http://www.webservicex.net/globalweather.asmx"); # from WSDL -my $som = $soap->call( +$som = $soap->call( SOAP::Data->name('GetWeather') ->attr({ xmlns => 'http://www.webserviceX.NET' }), # from WSDL SOAP::Data->name('CountryName')->value('Germany'), diff --git a/lib/SOAP/WSDL/Client.pm b/lib/SOAP/WSDL/Client.pm index d79832b..5706ee6 100644 --- a/lib/SOAP/WSDL/Client.pm +++ b/lib/SOAP/WSDL/Client.pm @@ -13,7 +13,7 @@ use SOAP::WSDL::Factory::Serializer; use SOAP::WSDL::Factory::Transport; use SOAP::WSDL::Expat::MessageParser; -our $VERSION='2.00_13'; +our $VERSION = '2.00_14'; # Package global for speed and memory savings. # But should be factored out into serializer/deserializer... @@ -183,15 +183,13 @@ sub call { }); # set class resolver if serializer supports it - $deserializer_of{ $ident }->class_resolver( $class_resolver_of{ $ident } ) - if ( $deserializer_of{ $ident }->can('class_resolver') ); - - my $result; + $deserializer_of{ $ident }->set_class_resolver( $class_resolver_of{ $ident } ) + if ( $deserializer_of{ $ident }->can('set_class_resolver') ); # Try deserializing response - there may be some, # even if transport did not succeed (got a 500 response) if ( $response ) { - eval { $result = $deserializer_of{ $ident }->deserialize( $response ); }; + my $result = eval { $deserializer_of{ $ident }->deserialize( $response ); }; return $result if (not $@); return $deserializer_of{ $ident }->generate_fault({ code => 'soap:Server', @@ -377,9 +375,9 @@ Martin Kutter Emartin.kutter fen-net.deE =head1 REPOSITORY INFORMATION - $Rev: 218 $ + $Rev: 239 $ $LastChangedBy: kutterma $ - $Id: Client.pm 218 2007-09-10 16:19:23Z kutterma $ + $Id: Client.pm 239 2007-09-11 09:45:42Z kutterma $ $HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $ =cut diff --git a/lib/SOAP/WSDL/Deserializer/SOM.pm b/lib/SOAP/WSDL/Deserializer/SOM.pm index d87203d..5b0f62a 100644 --- a/lib/SOAP/WSDL/Deserializer/SOM.pm +++ b/lib/SOAP/WSDL/Deserializer/SOM.pm @@ -1,23 +1,19 @@ package SOAP::WSDL::Deserializer::SOM; use strict; use warnings; -use Class::Std::Storable; -use SOAP::Lite; -our $VERSION='2.00_13'; +our $VERSION = '2.00_14'; +our @ISA = qw(SOAP::Deserializer); -sub BUILD { - my ($self, $ident, $args_of_ref) = @_; - - # ignore all options - for (keys %{ $args_of_ref }) { - delete $args_of_ref->{ $_ }; - } -} +my $HAVE_SOAP_LITE = eval { require SOAP::Lite }; sub deserialize { - my ($self, $content) = @_; - return SOAP::Deserializer->new()->deserialize( $content ); + my $self = shift; + die 'Cannot deserialize to SOM object without SOAP::Lite. +Please install SOAP::Lite. +' + if not $HAVE_SOAP_LITE; + $self->SUPER::deserialize(@_); } sub generate_fault { @@ -48,15 +44,46 @@ SOAP::WSDL::Deserializer::SOM - Deserializer SOAP messages into SOM objects =head1 DESCRIPTION Deserializer for creating SOAP::Lite's SOM object as result of a SOAP call. + +This package is here for two reasons: -This package is mainly here for compatibility reasons: You don't have to -change the rest of your SOAP::Lite based app when switching to SOAP::WSDL, -but can just use SOAP::WSDL::Deserializer::SOM to get back the same objects -as you were used to. - -SOAP::WSDL::Deserializer will not auroregister itself - just use the lines -from the L to register it as deserializer for SOAP::WSDL. +=over + +=item * Compatibility + +You don't have to change the rest of your SOAP::Lite based app when switching +to SOAP::WSDL, but can just use SOAP::WSDL::Deserializer::SOM to get back the +same objects as you were used to. + +=item * Completeness + +SOAP::Lite covers much more of the SOAP specification than SOAP::WSDL. + +SOAP::WSDL::Deserializer::SOM can be used for content which cannot be +deserialized by L. +This may be XML including mixed content, attachements and other XML data not +(yet) handled by L. + +=back + +SOAP::WSDL::Deserializer::SOM is a subclass of L +from the L package. + +You may + +=head1 USAGE + +SOAP::WSDL::Deserializer will not auroregister itself - to use it for a particular +SOAP version just use the following lines: + + my $soap_version = '1.1'; # or '1.2', further versions may appear. + + use SOAP::WSDL::Deserializer::SOM; + use SOAP::WSDL::Factory::Deserializer; + SOAP::WSDL::Factory::Deserializer->register( $soap_version, __PACKAGE__ ); +=head1 DIFFERENCES FROM OTHER CLASSES + =head2 Differences from SOAP::Lite =over diff --git a/lib/SOAP/WSDL/Factory/Deserializer.pm b/lib/SOAP/WSDL/Factory/Deserializer.pm index 37d8fc2..dba4556 100644 --- a/lib/SOAP/WSDL/Factory/Deserializer.pm +++ b/lib/SOAP/WSDL/Factory/Deserializer.pm @@ -13,8 +13,16 @@ sub register { } sub get_deserializer { - my ($self, $args_of_ref) = @_; - eval "require $DESERIALIZER{ $args_of_ref->{ soap_version } }" or die $@; + my ($self, $args_of_ref) = @_; + + # sanity check + die "no deserializer registered for SOAP version $args_of_ref->{ soap_version }" + if not exists ($DESERIALIZER{ $args_of_ref->{ soap_version } }); + + # load module + eval "require $DESERIALIZER{ $args_of_ref->{ soap_version } }" + or die "Cannot load serializer $DESERIALIZER{ $args_of_ref->{ soap_version } }", $@; + return $DESERIALIZER{ $args_of_ref->{ soap_version } }->new($args_of_ref); } @@ -24,21 +32,21 @@ sub get_deserializer { =head1 NAME -SOAP::WSDL::Factory::Deserializer - factory for retrieving Deserializer objects +SOAP::WSDL::Factory::Deserializer - Factory for retrieving Deserializer objects =head1 SYNOPSIS # from SOAP::WSDL::Client: - $deserializer = SOAP::WSDL::Factory::Serializer->get_deserializer({ + $deserializer = SOAP::WSDL::Factory::Deserializer->get_deserializer({ soap_version => $soap_version, class_resolver => $class_resolver, }); - # in serializer class: - package MyWickedSerializer; + # in deserializer class: + package MyWickedDeserializer; use SOAP::WSDL::Factory::Deserializer; - # u don't know the SOAP 1.2 recommendation? poor boy... + # register class as deserializer for SOAP1.2 messages SOAP::WSDL::Factory::Deserializer->register( '1.2' , __PACKAGE__ ); =head1 DESCRIPTION @@ -49,16 +57,23 @@ deserializer objects for SOAP::WSDL. The actual work is done by specific deserializer classes. SOAP::WSDL::Deserializer tries to load one of the following classes: - - a) the class registered for the scheme via register() + +=over + +=item * The class registered for the scheme via register() + +=back + +By default, L +is registered for SOAP1.1 messages. =head1 METHODS =head2 register - SOAP::WSDL::Serializer->register('1.1', 'MyWickedSerializer'); + SOAP::WSDL::Deserializer->register('1.1', 'MyWickedDeserializer'); -Globally registers a class for use as serializer class. +Globally registers a class for use as deserializer class. =head2 get_deserializer @@ -66,24 +81,26 @@ Returns an object of the deserializer class for this endpoint. =head1 WRITING YOUR OWN DESERIALIZER CLASS -Deserializer classes may register with -SOAP::WSDL::Factory::Deserializer. +Deserializer classes may register with SOAP::WSDL::Factory::Deserializer. + +=head2 Registering a deserializer -Registering a deserializer class with -SOAP::WSDL::Factory::Deserializer is done by executing the -following code where $version is the SOAP version the class should -be used for, and $class is the class -name. +Registering a deserializer class with SOAP::WSDL::Factory::Deserializer +is done by executing the following code where $version is the SOAP version +the class should be used for, and $class is the class name. SOAP::WSDL::Factory::Deserializer->register( $version, $class); To auto-register your transport class on loading, execute register() in your tranport class (see L above). + +=head2 Deserializer package layout -Deserializer modules must be named equal to the deserializer -class they contain. There can only be one deserializer class per -deserializer module. - +Deserializer modules must be named equal to the deserializer class they +contain. There can only be one deserializer class per deserializer module. + +=head2 Methods to implement + Deserializer classes must implement the following methods: =over @@ -96,19 +113,17 @@ Constructor. Deserialize data from XML to arbitrary formats. -deserialize() must return a fault indicating that deserializing -failed if any error is encountered during the process of -deserializing the XML message. +deserialize() must return a fault indicating that deserializing failed if +any error is encountered during the process of deserializing the XML message. -The following -positional parameters are passed to the deserialize method: +The following positional parameters are passed to the deserialize method: $content - the xml message =item * generate_fault -Generate a fault in the supported format. The following named -parameters are passed as a single hash ref: +Generate a fault in the supported format. The following named parameters are +passed as a single hash ref: code - The fault code, e.g. 'soap:Server' or the like role - The fault role (actor in SOAP1.1) diff --git a/lib/SOAP/WSDL/Factory/Serializer.pm b/lib/SOAP/WSDL/Factory/Serializer.pm index 3825a93..d400766 100644 --- a/lib/SOAP/WSDL/Factory/Serializer.pm +++ b/lib/SOAP/WSDL/Factory/Serializer.pm @@ -13,8 +13,16 @@ sub register { } sub get_serializer { - my ($self, $args_of_ref) = @_; - eval "require $SERIALIZER{ $args_of_ref->{ soap_version } }" or die $@; + my ($self, $args_of_ref) = @_; + + # sanity check + die "no deserializer registered for SOAP version $args_of_ref->{ soap_version }" + if not exists ($SERIALIZER{ $args_of_ref->{ soap_version } }); + + # load module + eval "require $SERIALIZER{ $args_of_ref->{ soap_version } }" + or die "Cannot load serializer $SERIALIZER{ $args_of_ref->{ soap_version } }", $@; + return $SERIALIZER{ $args_of_ref->{ soap_version } }->new(); } @@ -24,7 +32,7 @@ sub get_serializer { =head1 NAME -SOAP::WSDL::Factory::Serializer - factory for retrieving serializer objects +SOAP::WSDL::Factory::Serializer - Factory for retrieving serializer objects =head1 SYNOPSIS @@ -37,7 +45,7 @@ SOAP::WSDL::Factory::Serializer - factory for retrieving serializer objects package MyWickedSerializer; use SOAP::WSDL::Factory::Serializer; - # u don't know the SOAP 1.2 recommendation? poor boy... + # register as serializer for SOAP1.2 messages SOAP::WSDL::Factory::Serializer->register( '1.2' , __PACKAGE__ ); =head1 DESCRIPTION @@ -49,7 +57,11 @@ The actual work is done by specific serializer classes. SOAP::WSDL::Serializer tries to load one of the following classes: - a) the class registered for the scheme via register() +=over + +=item * the class registered for the scheme via register() + +=back =head1 METHODS @@ -64,29 +76,33 @@ Globally registers a class for use as serializer class. Returns an object of the serializer class for this endpoint. =head1 WRITING YOUR OWN SERIALIZER CLASS + +=head2 Registering a deserializer Serializer classes may register with SOAP::WSDL::Factory::Serializer. -Serializer objects may also be passed directly to SOAP::WSDL::Client -by using the set_serializer method. Note that serializers objects set -via SOAP::WSDL::Client's set_serializer method are discarded when the -SOAP version is changed via set_soap_version. +Serializer objects may also be passed directly to SOAP::WSDL::Client by +using the set_serializer method. Note that serializers objects set via +SOAP::WSDL::Client's set_serializer method are discarded when the SOAP +version is changed via set_soap_version. -Registering a serializer class with SOAP::WSDL::Factory::Serializer -is done by executing the following code where $version is the -SOAP version the class should be used for, and $class is the class -name. +Registering a serializer class with SOAP::WSDL::Factory::Serializer is done +by executing the following code where $version is the SOAP version the +class should be used for, and $class is the class name. SOAP::WSDL::Factory::Serializer->register( $version, $class); -To auto-register your transport class on loading, execute register() -in your tranport class (see L above). +To auto-register your transport class on loading, execute register() in +your tranport class (see L above). + +=head2 Serializer package layout -Serializer modules must be named equal to the serializer -class they contain. There can only be one serializer class per -serializer module. +Serializer modules must be named equal to the serializer class they contain. +There can only be one serializer class per serializer module. + +=head2 Methods to implement -Serializer class must implement the following methods: +Serializer classes must implement the following methods: =over @@ -96,8 +112,8 @@ Constructor. =item * serialize -Serializes data to XML. The following named parameters are passed to -the serialize method in a anonymous hash ref: +Serializes data to XML. The following named parameters are passed to the +serialize method in a anonymous hash ref: { method => $operation_name, @@ -120,9 +136,9 @@ Martin Kutter Emartin.kutter fen-net.deE =head1 REPOSITORY INFORMATION - $Rev: 218 $ + $Rev: 225 $ $LastChangedBy: kutterma $ - $Id: Serializer.pm 218 2007-09-10 16:19:23Z kutterma $ + $Id: Serializer.pm 225 2007-09-10 19:04:57Z kutterma $ $HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $ =cut diff --git a/lib/SOAP/WSDL/Factory/Transport.pm b/lib/SOAP/WSDL/Factory/Transport.pm index 75f44dc..d1ec67e 100644 --- a/lib/SOAP/WSDL/Factory/Transport.pm +++ b/lib/SOAP/WSDL/Factory/Transport.pm @@ -78,7 +78,7 @@ sub get_transport { =head1 NAME -SOAP::WSDL::Factory::Transport - factory for retrieving transport objects +SOAP::WSDL::Factory::Transport - Factory for retrieving transport objects =head1 SYNOPSIS @@ -89,22 +89,29 @@ SOAP::WSDL::Factory::Transport - factory for retrieving transport objects package MyWickedTransport; use SOAP::WSDL::Factory::Transport; - # u don't know the httpr protocol? poor boy... + # register class as transport module for httpr and https + # (httpr is "reliable http", a protocol developed by IBM). SOAP::WSDL::Factory::Transport->register( 'httpr' , __PACKAGE__ ); SOAP::WSDL::Factory::Transport->register( 'https' , __PACKAGE__ ); =head1 DESCRIPTION -SOAP::WSDL::Transport serves as factory for retrieving -transport objects for SOAP::WSDL. +SOAP::WSDL::Transport serves as factory for retrieving transport objects for +SOAP::WSDL. The actual work is done by specific transport classes. SOAP::WSDL::Transport tries to load one of the following classes: + +=over - a) the class registered for the scheme via register() - b) the SOAP::Lite class matching the scheme - c) the SOAP::WSDL class matching the scheme +=item * the class registered for the scheme via register() + +=item * the SOAP::Lite class matching the scheme + +=item * the SOAP::WSDL class matching the scheme + +=back =head1 METHODS @@ -131,32 +138,35 @@ Sets the current transport object. Gets the current transport object. =head1 WRITING YOUR OWN TRANSPORT CLASS + +=head2 Registering a transport class Transport classes must be registered with SOAP::WSDL::Factory::Transport. -This is done by executing the following code where $scheme is the -URL scheme the class should be used for, and $module is the class' -module name. +This is done by executing the following code where $scheme is the URL scheme +the class should be used for, and $module is the class' module name. SOAP::WSDL::Factory::Transport->register( $scheme, $module); -To auto-register your transport class on loading, execute register() -in your tranport class (see L above). +To auto-register your transport class on loading, execute register() in your +tranport class (see L above). Multiple protocols ore multiple classes are registered by multiple calls to register(). + +=head2 Transport plugin package layout You may only use transport classes whose name is either the module name or the module name with '::Client' appended. -Transport classes must implement the interface required for -SOAP::Lite transport classes. - -See L for details, -L -for an example. - -Transport modules must implement the following methods: +=head2 Methods to implement + +Transport classes must implement the interface required for SOAP::Lite +transport classes (see L for details, +L for an example). + +To provide this interface, transport modules must implement the following +methods: =over @@ -200,15 +210,14 @@ SOAP::WSDL does not require you to follow these restrictions. There is only one restriction in SOAP::WSDL: -You may only use transport classes whose name is either -the module name or the module name with '::Client' appended. +You may only use transport classes whose name is either the module name or +the module name with '::Client' appended. -SOAP::WSDL will try to instantiate an object of your -transport class with '::Client' appended to allow using transport -classes written for SOAP::Lite. +SOAP::WSDL will try to instantiate an object of your transport class with +'::Client' appended to allow using transport classes written for SOAP::Lite. -This may lead to errors when a different module with the name -of your transport module suffixed with ::Client is also loaded. +This may lead to errors when a different module with the name of your +transport module suffixed with ::Client is also loaded. =head1 LICENSE @@ -223,9 +232,9 @@ Martin Kutter Emartin.kutter fen-net.deE =head1 REPOSITORY INFORMATION - $Rev: 218 $ + $Rev: 225 $ $LastChangedBy: kutterma $ - $Id: Transport.pm 218 2007-09-10 16:19:23Z kutterma $ + $Id: Transport.pm 225 2007-09-10 19:04:57Z kutterma $ $HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Transport.pm $ =cut diff --git a/lib/SOAP/WSDL/Transport/Test.pm b/lib/SOAP/WSDL/Transport/Test.pm new file mode 100644 index 0000000..dd59ed9 --- /dev/null +++ b/lib/SOAP/WSDL/Transport/Test.pm @@ -0,0 +1,129 @@ +package SOAP::WSDL::Transport::Test; +use strict; +use warnings; +use Class::Std::Storable; +use SOAP::WSDL::Factory::Transport; + +our $VERSION = '2.00_14'; + +SOAP::WSDL::Factory::Transport->register( http => __PACKAGE__ ); +SOAP::WSDL::Factory::Transport->register( https => __PACKAGE__ ); + +my %code_of :ATTR(:name :default<()>); +my %status_of :ATTR(:name :default<()>); +my %message_of :ATTR(:name :default<()>); +my %is_success_of :ATTR(:name :default<()>); +my %base_dir_of :ATTR(:name :init_arg :default<.>); + +# create methods normally inherited from SOAP::Client +SUBFACTORY: { + no strict qw(refs); + foreach my $method ( qw(code message status is_success) ) { + *{ $method } = *{ "get_$method" }; + } +} + +sub send_receive { + my ($self, %parameters) = @_; + my ($envelope, $soap_action, $endpoint, $encoding, $content_type) = + @parameters{qw(envelope action endpoint encoding content_type)}; + + my $filename = $soap_action; + $filename =~s{ \A(:?'|") }{}xms; + $filename =~s{ (:?'|")\z }{}xms; + $filename =~s{ \A [^:]+ : (:? /{2})? }{}xms; + + $filename = join '/', $base_dir_of{ ident $self }, "$filename.xml"; + + if (not -r $filename) { + warn "cannot access $filename"; + $self->set_code( 500 ); + $self->set_message( "Failed" ); + $self->set_is_success(0); + $self->set_status("500 Failed"); + return; + } + + open my $fh, '<', $filename or die "cannot open $filename: $!"; + binmode $fh; + my $response = <$fh>; + close $fh or die "cannot close $filename: $!"; + + $self->set_code( 200 ); + $self->set_message( "OK" ); + $self->set_is_success(1); + $self->set_status("200 OK"); + return $response; +} + +1; + +=head1 NAME + +SOAP::WSDL::Transport::Test - Test transport class for SOAP::WSDL + +=head1 SYNOPSIS + + use SOAP::WSDL::Client; + use SOAP::WSDL::Transport::Test; + + my $soap = SOAP::WSDL::Client->new() + $soap->get_transport->set_base_dir('.'); + $soap->call('method', \%body, \%header); + +=head1 DESCRIPTION + +SOAP::WSDL::Transport::Test is a file-based test transport backend for +SOAP::WSDL. + +When SOAP::WSDL::Transport::Test is used as transport backend, the reponse is +read from a XML file and the request message is discarded. This is particularly +useful for testing SOAP::WSDL plugins. + +=head2 Filename resolution + +SOAP::WSDL::Transport makes up the response XML file name from the SOAPAction +of the request. The following filename is used: + + base_dir / soap_action .xml + +The protocol scheme (e.g. http:) and two heading slashes (//) are stripped from +the soap_action. + +base_dir defaults to '.' + +Examples: + + SOAPAction: http://somewhere.over.the.rainbow/webservice/webservice.asmx + Filename: ./somewhere.over.the.rainbow/webservice/webservice.asmx.xml + + SOAPAction: uri:MyWickedService/test + Filename: ./MyWickedService/test.xml + + +=head1 METHODS + +=head2 set_base_dir + +Sets the base directory SOAP::WSDL::Transport::Test should look for response +files. + +=head1 LICENSE + +Copyright 2004-2007 Martin Kutter. + +This file is part of SOAP-WSDL. You may distribute/modify it under +the same terms as perl itself + +=head1 AUTHOR + +Martin Kutter Emartin.kutter fen-net.deE + +=head1 REPOSITORY INFORMATION + + $Rev: 218 $ + $LastChangedBy: kutterma $ + $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 \ No newline at end of file diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm index 74e121d..fff7490 100644 --- a/lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm @@ -13,15 +13,23 @@ my %value_of :ATTR(:get :init_arg :default<()>); # and we don't need to return the last value... sub set_value { $value_of{ ident $_[0] } = $_[1] } +# use $_[n] for speed. +# This is less readable, but notably faster. +# +# use postfix-if for speed. This is slightly faster, as it saves +# perl from creating a pad (variable context). +# +# The methods below may get called zillions of times, so +# every little statement matters... + sub serialize { - my ($self, $opt) = @_; - my $ident = ident $self; - $opt ||= {}; - return $self->start_tag({ %$opt, nil => 1}) - if not defined $value_of{ $ident }; - return join q{}, $self->start_tag($opt, $value_of{ $ident }) + no warnings qw(uninitialized); + my $ident = ident $_[0]; + $_[1]->{ nil } = 1 if not defined $value_of{ $ident }; + return join q{} + , $_[0]->start_tag($_[1], $value_of{ $ident }) , $value_of{ $ident } - , $self->end_tag($opt); + , $_[0]->end_tag($_[1]); } # TODO disallow serializing ! diff --git a/lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm b/lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm index 9c82b43..64fd24a 100644 --- a/lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm +++ b/lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm @@ -3,7 +3,9 @@ use strict; use warnings; use Class::Std::Storable; -my %xmlns_of :ATTR(:name :default<()>); +my %xmlns_of :ATTR(:get :init_arg :default<()>); + +sub set_xmlns { $xmlns_of{ ident $_[0] } = $_[1] }; # use $_[1] for performance sub start_tag { @@ -19,6 +21,8 @@ sub end_tag { : q{}; }; +sub serialize { q{} }; + sub serialize_qualified :STRINGIFY { return $_[0]->serialize( { qualified => 1 } ); } diff --git a/t/001_use.t b/t/001_use.t index a970680..a4f4535 100644 --- a/t/001_use.t +++ b/t/001_use.t @@ -1,11 +1,15 @@ #!/usr/bin/perl -w use strict; use warnings; -use Test::More qw/no_plan/; # TODO: change to tests => N; +use Test::More; # TODO: change to tests => N; use lib '../lib'; -chdir 't/' if (-d 't/'); my @modules = qw( + SOAP::WSDL + SOAP::WSDL::Client + SOAP::WSDL::Serializer::SOAP11 + SOAP::WSDL::Deserializer::SOAP11 + SOAP::WSDL::Transport::HTTP SOAP::WSDL::Definitions SOAP::WSDL::Message SOAP::WSDL::Operation @@ -22,6 +26,8 @@ my @modules = qw( SOAP::WSDL::XSD::Schema ); +plan tests => 2* scalar @modules; + for my $module (@modules) { use_ok($module); diff --git a/t/SOAP/WSDL/Transport/01_Test.t b/t/SOAP/WSDL/Transport/01_Test.t new file mode 100644 index 0000000..95939c1 --- /dev/null +++ b/t/SOAP/WSDL/Transport/01_Test.t @@ -0,0 +1,44 @@ +use Test::More tests => 9; +use strict; +use warnings; +use File::Basename; +use SOAP::WSDL::Client; + +my $soap; +my $base_dir = dirname( __FILE__ ); +use_ok(qw/SOAP::WSDL::Transport::Test/); + +$soap = SOAP::WSDL::Client->new(); +$soap->set_proxy('http://somewhere.over.the.rainbow'); + +ok( $soap->get_transport->set_base_dir( join '/', $base_dir, 'acceptance' ) ); + +my $response = $soap->call({ operation => 'test', soap_action => 'http://test' }, {}); +ok ! $response, 'Returned fault on error'; +is $response->get_faultcode(), 'soap:Server', 'faultcode'; +is $response->get_faultactor(), 'urn:localhost', 'faultactor'; + +$soap->outputxml(1); +$response = $soap->call({ operation => 'test', soap_action => 'http://test2' }, {}); +is $response, 'test2', 'Returned file content'; + +SKIP: { + eval { require SOAP::WSDL::Deserializer::SOM; } + or skip 'SOAP::WSDL::Deserializer::SOM required', 3; + # requre SOAP::WSDL::Factory::Deserializer; + SOAP::WSDL::Factory::Deserializer->register('1.1', 'SOAP::WSDL::Deserializer::SOM'); + + my $soap_som = SOAP::WSDL::Client->new(); + $soap_som->set_proxy('http://somewhere.over.the.rainbow'); + $soap_som->get_transport->set_base_dir( join '/', $base_dir, 'acceptance' ); + + my $som; + ok $som = $soap_som->call({ operation => 'test', soap_action => 'http://test3' }, {}) + , 'Call with SOAP::WSDL::Deserializer::SOM'; + + # In the somewhat weird logic of SOAP::Lite, the first node inside the root element + # is the reault, all others are output parameters (and may be accessed via "paramsout") + is $som->result(), 'Munich', 'Result match'; + is $som->paramsout(), 'Germany' , 'Output parameter match'; +} + diff --git a/t/SOAP/WSDL/Transport/acceptance/test2.xml b/t/SOAP/WSDL/Transport/acceptance/test2.xml new file mode 100644 index 0000000..d606037 --- /dev/null +++ b/t/SOAP/WSDL/Transport/acceptance/test2.xml @@ -0,0 +1 @@ +test2 \ No newline at end of file diff --git a/t/SOAP/WSDL/Transport/acceptance/test3.xml b/t/SOAP/WSDL/Transport/acceptance/test3.xml new file mode 100644 index 0000000..34a5ba2 --- /dev/null +++ b/t/SOAP/WSDL/Transport/acceptance/test3.xml @@ -0,0 +1 @@ +MunichGermany \ No newline at end of file diff --git a/t/SOAP/WSDL/XSD/Typelib/Builtin/001_anyType.t b/t/SOAP/WSDL/XSD/Typelib/Builtin/001_anyType.t new file mode 100644 index 0000000..01096b8 --- /dev/null +++ b/t/SOAP/WSDL/XSD/Typelib/Builtin/001_anyType.t @@ -0,0 +1,20 @@ +use strict; +use warnings; +use Test::More qw(no_plan); +use Scalar::Util qw(blessed); +use lib '../../../../../../lib'; +use_ok qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType); + +my $obj = SOAP::WSDL::XSD::Typelib::Builtin::anyType->new({ + xmlns => 'urn:Siemens.mosaic' +}); + +ok blessed $obj, 'constructor returned blessed reference'; + +ok $obj->set_xmlns('urn:SOAP-WSDL'), 'set_xmlns'; +is $obj->get_xmlns(), 'urn:SOAP-WSDL', 'get_xmlns'; + +is $obj->start_tag({ name => 'test' }), '', 'start_tag'; +is $obj->end_tag({ name => 'test' }), '', 'end_tag'; + +is "$obj", q{}, 'serialize overloading'; \ No newline at end of file diff --git a/t/SOAP/WSDL/XSD/Typelib/Builtin/002_anySimpleType.t b/t/SOAP/WSDL/XSD/Typelib/Builtin/002_anySimpleType.t new file mode 100644 index 0000000..6c5a0cf --- /dev/null +++ b/t/SOAP/WSDL/XSD/Typelib/Builtin/002_anySimpleType.t @@ -0,0 +1,44 @@ +use strict; +use warnings; +use Test::More qw(no_plan); +use Scalar::Util qw(blessed); +use lib '../../../../../../lib'; +use_ok qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); + +my $obj = SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({}); + +ok $obj->set_xmlns('urn:SOAP-WSDL'), 'set_xmlns'; +is $obj->get_xmlns(), 'urn:SOAP-WSDL', 'get_xmlns'; + +ok blessed $obj, 'constructor returned blessed reference'; + +is $obj->start_tag({ name => 'test' }), '', 'start_tag'; +is $obj->end_tag({ name => 'test' }), '', 'end_tag'; + +ok $obj->set_value('test'), 'set_value'; +is $obj->get_value(), 'test', 'get_value'; + +is "$obj", q{test}, 'serialize overloading'; + +ok ($obj) + ? pass 'boolean overloading' + : fail 'boolean overloading'; + +ok ! $obj->set_value(undef), 'set_value with explicit undef'; +is $obj->get_value(), undef, 'get_value'; + +is "$obj", q{}, 'stringification overloading'; + +ok $obj = SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new({ + xmlns => 'urn:XSD', + value => 'test2', +}); + +is $obj->get_xmlns(), 'urn:XSD', 'get_xmlns on attr value'; +is $obj->get_value(), 'test2', 'get_value on attr value'; + +$obj->set_value(undef); + +is $obj->serialize({ name => 'foo' }), '' + , 'serialize undef value with name'; +is $obj->serialize(), q{}, 'serialize undef value without name' \ No newline at end of file diff --git a/t/SOAP/WSDL/XSD/Typelib/Builtin/002_dateTime.t b/t/SOAP/WSDL/XSD/Typelib/Builtin/005_dateTime.t similarity index 100% rename from t/SOAP/WSDL/XSD/Typelib/Builtin/002_dateTime.t rename to t/SOAP/WSDL/XSD/Typelib/Builtin/005_dateTime.t diff --git a/t/SOAP/WSDL/XSD/Typelib/Builtin/001_string.t b/t/SOAP/WSDL/XSD/Typelib/Builtin/006_string.t similarity index 100% rename from t/SOAP/WSDL/XSD/Typelib/Builtin/001_string.t rename to t/SOAP/WSDL/XSD/Typelib/Builtin/006_string.t