diff --git a/Build.PL b/Build.PL index b75856a..26505e3 100644 --- a/Build.PL +++ b/Build.PL @@ -5,7 +5,7 @@ $build = Module::Build->new( create_makefile_pl => 'passthrough', dist_abstract => 'SOAP with WSDL support', dist_name => 'SOAP-WSDL', - dist_version => '2.00_25', + dist_version => '2.00_26', module_name => 'SOAP::WSDL', license => 'artistic', requires => { diff --git a/Changes b/Changes index 931990e..5e02d8b 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,4 @@ -Release notes for SOAP::WSDL 2.00_24 +Release notes for SOAP::WSDL 2.00_26 ------- I'm proud to present a new pre-release version of SOAP::WSDL. @@ -34,6 +34,23 @@ Features: The following changes have been made: +2.00_26 + +The following features were added (the numbers in square brackets are the +tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660924): + +The following bugs have been fixed (the numbers in square brackets are the +tracker IDs from https://sourceforge.net/tracker/?group_id=111978&atid=660921): +The numbers with # are CPAN RT IDs (http://rt.cpan.org/). + + * [ 1843195 ] t/013_complexType.t still requires Class::Std::Storable + * [ 1843590 ] Tests broken on Cygwin + +The following uncategorized improvements have been made: + + * Added examples + * Added Content-length header to CGI output + 2.00_25 --- WARNING: INCOMPATIBLE CHANGE: diff --git a/MANIFEST b/MANIFEST index e2a8278..dfcda35 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,5 +1,7 @@ benchmark/01_expat.t benchmark/hello.pl +benchmark/person.pl +benchmark/person.xml benchmark/XSD/01_anyType.t benchmark/XSD/02_anySimpleType.t benchmark/XSD/03_string.t @@ -7,6 +9,7 @@ bin/wsdl2perl.pl Build.PL Changes example/cgi-bin/helloworld.pl +example/cgi-bin/person.pl example/fortune.pl example/genericbarcode.pl example/hello.pl @@ -25,6 +28,8 @@ example/lib/MyElements/GetSpecificCookieResponse.pm example/lib/MyElements/GetWeather.pm example/lib/MyElements/GetWeatherResponse.pm example/lib/MyElements/int.pm +example/lib/MyElements/ListPerson.pm +example/lib/MyElements/ListPersonResponse.pm example/lib/MyElements/readNodeCount.pm example/lib/MyElements/readNodeCountResponse.pm example/lib/MyElements/sayHello.pm @@ -34,13 +39,25 @@ example/lib/MyInterfaces/BarCode/BarCodeSoap.pm example/lib/MyInterfaces/FullerData_x0020_Fortune_x0020_Cookie/FullerData_x0020_Fortune_x0020_CookieSoap.pm example/lib/MyInterfaces/GlobalWeather/GlobalWeatherSoap.pm example/lib/MyInterfaces/HelloWorld/HelloWorldSoap.pm +example/lib/MyInterfaces/TestService/TestPort.pm example/lib/MyServer/HelloWorld/HelloWorldSoap.pm +example/lib/MyServer/TestService/TestPort.pm example/lib/MyTypemaps/BarCode.pm example/lib/MyTypemaps/FullerData_x0020_Fortune_x0020_Cookie.pm example/lib/MyTypemaps/GlobalWeather.pm example/lib/MyTypemaps/HelloWorld.pm +example/lib/MyTypemaps/TestService.pm +example/lib/MyTypes/Address.pm +example/lib/MyTypes/ArrayOfContract.pm +example/lib/MyTypes/ArrayOfPerson.pm +example/lib/MyTypes/Contract.pm +example/lib/MyTypes/Person.pm +example/lib/MyTypes/PersonID.pm +example/lib/MyTypes/PhoneNumber.pm example/lib/MyTypes/test2.pm example/lib/MyTypes/testExtended.pm +example/person.pl +example/person_compile.pl example/visitor/visitor.pl example/weather.pl example/weather_wsdl.pl @@ -48,6 +65,7 @@ example/wsdl/11_helloworld.wsdl example/wsdl/FortuneCookie.xml example/wsdl/genericbarcode.xml example/wsdl/globalweather.xml +example/wsdl/Person.wsdl HACKING lib/SOAP/WSDL.pm lib/SOAP/WSDL/Base.pm @@ -250,6 +268,7 @@ t/acceptance/wsdl/email_account.wsdl t/acceptance/wsdl/generator_test.wsdl t/acceptance/wsdl/generator_unsupported_test.wsdl t/acceptance/wsdl/message_gateway.wsdl +t/contributed.wsdl t/Expat/01_expat.t t/Expat/03_wsdl.t t/lib/MyComplexType.pm diff --git a/META.yml b/META.yml index afcc327..39d67c5 100644 --- a/META.yml +++ b/META.yml @@ -1,6 +1,6 @@ --- name: SOAP-WSDL -version: 2.00_25 +version: 2.00_26 author: - 'Martin Kutter ' abstract: SOAP with WSDL support @@ -126,7 +126,7 @@ provides: version: 2.00_25 SOAP::WSDL::Server::CGI: file: lib/SOAP/WSDL/Server/CGI.pm - version: 2.00_25 + version: 2.00_26 SOAP::WSDL::Service: file: lib/SOAP/WSDL/Service.pm SOAP::WSDL::Transport::HTTP: diff --git a/benchmark/person.pl b/benchmark/person.pl new file mode 100644 index 0000000..12366c8 --- /dev/null +++ b/benchmark/person.pl @@ -0,0 +1,102 @@ +use lib '../lib'; +use lib '../example/lib'; +use strict; + +package MyData; +my $XML; +sub xml { + return $XML if ($XML); + + open my $fh, 'person.xml' or die 'cannot open data file'; + $XML = join '', <$fh>; + close $fh; + return $XML; +} + +package MyTransport; +use SOAP::WSDL::Factory::Transport; +SOAP::WSDL::Factory::Transport->register( http => __PACKAGE__ ); +sub send_receive { + # warn MyData::xml; + return MyData::xml(); +} +sub new { return bless {}, 'MyTransport' }; + + +package main; + +use Benchmark qw(cmpthese); + +# Do this BEFORE the client SOAP handlers are compiled! +use XML::Compile::Transport::SOAPHTTP(); +use XML::Compile::SOAP::Tester (); +use XML::Compile::Util;#use Data::Dumper; +#print Dumper $result; +use XML::Compile::WSDL11; +use XML::Simple; +$XML::Simple::PREFERRED_PARSER = 'XML::Parser'; +use SOAP::Lite; + +use MyInterfaces::TestService::TestPort; + +my $tester = XML::Compile::SOAP::Tester->new(); + +my $action = pack_type 'http://example.org', 'ListPerson'; +sub ListPerson(@) { MyData::xml }; +my $compile = XML::Compile::WSDL11->new('../example/wsdl/Person.wsdl'); +# $tester->fromWSDL($wsdl); +$tester->actionCallback($action, \&ListPerson); + +# I have to lookup the methods from the WSDL +my $call = $compile->compileClient('ListPerson'); + +# I have to lookup the parameters from the WSDL +my $result = $call->({ in => undef}); +#use Data::Dumper; +#print Dumper $result; + +my $deserializer = SOAP::Deserializer->new(); + +my $soap = MyInterfaces::TestService::TestPort->new(); + +$result = $soap->ListPerson({}); +#print $result; +#exit; + +my @data = (); +my $n = 0; +print "Benchmark conducted with +SOAP::Lite - $SOAP::Lite::VERSION +SOAP::WSDL - $SOAP::WSDL::Client::VERSION +XML::Compile::SOAP - $XML::Compile::SOAP::VERSION +XML::Simple - $XML::Simple::VERSION + +Benchmark $n: Push result on list +"; +$n++; +print "Benchmark $n: Store result in private variable and destroy it\n"; +cmpthese 100, { + 'XML::Simple' => sub { my $result = XMLin( MyData::xml() )}, + 'SOAP::WSDL' => sub { my $result = $soap->ListPerson({}) }, + 'XML::Compile::SOAP' => sub { my $result = $call->() }, + 'SOAP::Lite' => sub { my $result = $deserializer->deserialize( MyData::xml() )} +}; + +$n++; +cmpthese 100, { + 'XML::Simple' => sub { push @data, XMLin( MyData::xml() )}, + 'SOAP::WSDL' => sub { push @data, $soap->ListPerson({}) }, + 'XML::Compile::SOAP' => sub { push @data, $call->() }, + 'SOAP::Lite' => sub { push @data, $deserializer->deserialize( MyData::xml() )} +}; + +@data = (); +print "Benchmark $n: Play it again, Sam\n"; + +cmpthese 100, { + 'XML::Simple' => sub { push @data, XMLin( MyData::xml() )}, + 'SOAP::WSDL' => sub { push @data, $soap->ListPerson({}) }, + 'XML::Compile::SOAP' => sub { push @data, $call->() }, + 'SOAP::Lite' => sub { push @data, $deserializer->deserialize( MyData::xml() )} +}; + diff --git a/benchmark/person.xml b/benchmark/person.xml new file mode 100644 index 0000000..dda218f --- /dev/null +++ b/benchmark/person.xml @@ -0,0 +1,437 @@ + + + + + + 1 + + Salutation0 + Name0 + Martin + 1970-01-01 + + Street 0 + 00000 + City0 + Country0 + ++499131123456 + ++49150123456 + + + Somestreet 23 + 12345 + SomeCity + Germany + ++499131123456 + ++49150123456 + + + + 100000 + SomeContract0 + + + 100001 + SomeContract1 + + + 100002 + SomeContract2 + + + 100003 + SomeContract3 + + + + + + 1 + + Salutation0 + Name0 + Martin + 1970-01-01 + + Street 0 + 00000 + City0 + Country0 + ++499131123456 + ++49150123456 + + + Somestreet 23 + 12345 + SomeCity + Germany + ++499131123456 + ++49150123456 + + + + 100000 + SomeContract0 + + + 100001 + SomeContract1 + + + 100002 + SomeContract2 + + + 100003 + SomeContract3 + + + + + + 1 + + Salutation0 + Name0 + Martin + 1970-01-01 + + Street 0 + 00000 + City0 + Country0 + ++499131123456 + ++49150123456 + + + Somestreet 23 + 12345 + SomeCity + Germany + ++499131123456 + ++49150123456 + + + + 100000 + SomeContract0 + + + 100001 + SomeContract1 + + + 100002 + SomeContract2 + + + 100003 + SomeContract3 + + + + + + 1 + + Salutation0 + Name0 + Martin + 1970-01-01 + + Street 0 + 00000 + City0 + Country0 + ++499131123456 + ++49150123456 + + + Somestreet 23 + 12345 + SomeCity + Germany + ++499131123456 + ++49150123456 + + + + 100000 + SomeContract0 + + + 100001 + SomeContract1 + + + 100002 + SomeContract2 + + + 100003 + SomeContract3 + + + + + + 1 + + Salutation0 + Name0 + Martin + 1970-01-01 + + Street 0 + 00000 + City0 + Country0 + ++499131123456 + ++49150123456 + + + Somestreet 23 + 12345 + SomeCity + Germany + ++499131123456 + ++49150123456 + + + + 100000 + SomeContract0 + + + 100001 + SomeContract1 + + + 100002 + SomeContract2 + + + 100003 + SomeContract3 + + + + + + 1 + + Salutation0 + Name0 + Martin + 1970-01-01 + + Street 0 + 00000 + City0 + Country0 + ++499131123456 + ++49150123456 + + + Somestreet 23 + 12345 + SomeCity + Germany + ++499131123456 + ++49150123456 + + + + 100000 + SomeContract0 + + + 100001 + SomeContract1 + + + 100002 + SomeContract2 + + + 100003 + SomeContract3 + + + + + + 1 + + Salutation0 + Name0 + Martin + 1970-01-01 + + Street 0 + 00000 + City0 + Country0 + ++499131123456 + ++49150123456 + + + Somestreet 23 + 12345 + SomeCity + Germany + ++499131123456 + ++49150123456 + + + + 100000 + SomeContract0 + + + 100001 + SomeContract1 + + + 100002 + SomeContract2 + + + 100003 + SomeContract3 + + + + + + 1 + + Salutation0 + Name0 + Martin + 1970-01-01 + + Street 0 + 00000 + City0 + Country0 + ++499131123456 + ++49150123456 + + + Somestreet 23 + 12345 + SomeCity + Germany + ++499131123456 + ++49150123456 + + + + 100000 + SomeContract0 + + + 100001 + SomeContract1 + + + 100002 + SomeContract2 + + + 100003 + SomeContract3 + + + + + + 1 + + Salutation0 + Name0 + Martin + 1970-01-01 + + Street 0 + 00000 + City0 + Country0 + ++499131123456 + ++49150123456 + + + Somestreet 23 + 12345 + SomeCity + Germany + ++499131123456 + ++49150123456 + + + + 100000 + SomeContract0 + + + 100001 + SomeContract1 + + + 100002 + SomeContract2 + + + 100003 + SomeContract3 + + + + + + 1 + + Salutation0 + Name0 + Martin + 1970-01-01 + + Street 0 + 00000 + City0 + Country0 + ++499131123456 + ++49150123456 + + + Somestreet 23 + 12345 + SomeCity + Germany + ++499131123456 + ++49150123456 + + + + 100000 + SomeContract0 + + + 100001 + SomeContract1 + + + 100002 + SomeContract2 + + + 100003 + SomeContract3 + + + + + + + diff --git a/example/cgi-bin/person.pl b/example/cgi-bin/person.pl new file mode 100755 index 0000000..6747290 --- /dev/null +++ b/example/cgi-bin/person.pl @@ -0,0 +1,83 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use lib qw(../lib ../../lib); +use MyElements::ListPersonResponse; +use MyServer::TestService::TestPort; +my $server = MyServer::TestService::TestPort->new({ + dispatch_to => 'main', + transport_class => 'SOAP::WSDL::Server::CGI', # optional, default +}); +$server->handle(); + +sub ListPerson { + my ($self, $body, $header) = @_; + # body is a ??? object - sorry, POD not implemented yet + # header is a ??? object - sorry, POD not implemented yet + + # do something with body and header... + + my %person = ( + PersonID => { # MyTypes::PersonID + ID => 1, # int + }, + Salutation => 'Salutation0', # string + Name => 'Name0', # string + GivenName => 'Martin', # string + DateOfBirth => '1970-01-01', # date + HomeAddress => { # MyTypes::Address + Street => 'Street 0', # string + ZIP => '00000', # string + City => 'City0', # string + Country => 'Country0', # string + PhoneNumber => '++499131123456', # PhoneNumber + MobilePhoneNumber => '++49150123456', # PhoneNumber + }, + WorkAddress => { # MyTypes::Address + Street => 'Somestreet 23', # string + ZIP => '12345', # string + City => 'SomeCity', # string + Country => 'Germany', # string + PhoneNumber => '++499131123456', # PhoneNumber + MobilePhoneNumber => '++49150123456', # PhoneNumber + }, + Contracts => { # MyTypes::ArrayOfContract + Contract => [ + { # MyTypes::Contract + ContractID => 100000, # long + ContractName => 'SomeContract0', # string + }, + { # MyTypes::Contract + ContractID => 100001, # long + ContractName => 'SomeContract1', # string + }, + { # MyTypes::Contract + ContractID => 100002, # long + ContractName => 'SomeContract2', # string + }, + { # MyTypes::Contract + ContractID => 100003, # long + ContractName => 'SomeContract3', # string + }, + ], + }, + ); + + return MyElements::ListPersonResponse->new( { + out => { # MyTypes::ArrayOfPerson + NewElement => [ + { %person }, + { %person }, + { %person }, + { %person }, + { %person }, + { %person }, + { %person }, + { %person }, + { %person }, + { %person }, + ], + }, + } + ); + } diff --git a/example/lib/MyElements/ListPerson.pm b/example/lib/MyElements/ListPerson.pm new file mode 100644 index 0000000..04ae689 --- /dev/null +++ b/example/lib/MyElements/ListPerson.pm @@ -0,0 +1,111 @@ +package MyElements::ListPerson; +use strict; +use warnings; + +{ # BLOCK to scope variables + +sub get_xmlns { 'http://www.example.org/benchmark/' } + +__PACKAGE__->__set_name('ListPerson'); +__PACKAGE__->__set_nillable(); +__PACKAGE__->__set_minOccurs(); +__PACKAGE__->__set_maxOccurs(); +__PACKAGE__->__set_ref(); + +use base qw( + SOAP::WSDL::XSD::Typelib::Element + SOAP::WSDL::XSD::Typelib::ComplexType +); +use Class::Std::Fast::Storable constructor => 'none'; +use base qw(SOAP::WSDL::XSD::Typelib::ComplexType); + +Class::Std::initialize(); + +{ # BLOCK to scope variables + +my %in_of :ATTR(:get); + +__PACKAGE__->_factory( + [ qw( + in + ) ], + { + in => \%in_of, + }, + { + in => 'MyTypes::Person', + } +); + +} # end BLOCK + + + + + + + +} # end of BLOCK +1; + +# __END__ + +=pod + +=head1 NAME + +MyElements::ListPerson + +=head1 DESCRIPTION + +Perl data type class for the XML Schema defined element +ListPerson from the namespace http://www.example.org/benchmark/. + +=head1 METHODS + +=head2 new + + my $element = MyElements::ListPerson->new($data); + +Constructor. The following data structure may be passed to new(): + + { + in => { # MyTypes::Person + PersonID => { # MyTypes::PersonID + ID => $some_value, # int + }, + Salutation => $some_value, # string + Name => $some_value, # string + GivenName => $some_value, # string + DateOfBirth => $some_value, # date + HomeAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + WorkAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + Contracts => { # MyTypes::ArrayOfContract + Contract => { # MyTypes::Contract + ContractID => $some_value, # long + ContractName => $some_value, # string + }, + }, + }, + }, + +=head1 AUTHOR + +Generated by SOAP::WSDL + +=cut + diff --git a/example/lib/MyElements/ListPersonResponse.pm b/example/lib/MyElements/ListPersonResponse.pm new file mode 100644 index 0000000..e66bd2d --- /dev/null +++ b/example/lib/MyElements/ListPersonResponse.pm @@ -0,0 +1,113 @@ +package MyElements::ListPersonResponse; +use strict; +use warnings; + +{ # BLOCK to scope variables + +sub get_xmlns { 'http://www.example.org/benchmark/' } + +__PACKAGE__->__set_name('ListPersonResponse'); +__PACKAGE__->__set_nillable(); +__PACKAGE__->__set_minOccurs(); +__PACKAGE__->__set_maxOccurs(); +__PACKAGE__->__set_ref(); + +use base qw( + SOAP::WSDL::XSD::Typelib::Element + SOAP::WSDL::XSD::Typelib::ComplexType +); +use Class::Std::Fast::Storable constructor => 'none'; +use base qw(SOAP::WSDL::XSD::Typelib::ComplexType); + +Class::Std::initialize(); + +{ # BLOCK to scope variables + +my %out_of :ATTR(:get); + +__PACKAGE__->_factory( + [ qw( + out + ) ], + { + out => \%out_of, + }, + { + out => 'MyTypes::ArrayOfPerson', + } +); + +} # end BLOCK + + + + + + + +} # end of BLOCK +1; + +# __END__ + +=pod + +=head1 NAME + +MyElements::ListPersonResponse + +=head1 DESCRIPTION + +Perl data type class for the XML Schema defined element +ListPersonResponse from the namespace http://www.example.org/benchmark/. + +=head1 METHODS + +=head2 new + + my $element = MyElements::ListPersonResponse->new($data); + +Constructor. The following data structure may be passed to new(): + + { + out => { # MyTypes::ArrayOfPerson + NewElement => { # MyTypes::Person + PersonID => { # MyTypes::PersonID + ID => $some_value, # int + }, + Salutation => $some_value, # string + Name => $some_value, # string + GivenName => $some_value, # string + DateOfBirth => $some_value, # date + HomeAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + WorkAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + Contracts => { # MyTypes::ArrayOfContract + Contract => { # MyTypes::Contract + ContractID => $some_value, # long + ContractName => $some_value, # string + }, + }, + }, + }, + }, + +=head1 AUTHOR + +Generated by SOAP::WSDL + +=cut + diff --git a/example/lib/MyInterfaces/TestService/TestPort.pm b/example/lib/MyInterfaces/TestService/TestPort.pm new file mode 100644 index 0000000..73217a8 --- /dev/null +++ b/example/lib/MyInterfaces/TestService/TestPort.pm @@ -0,0 +1,146 @@ +package MyInterfaces::TestService::TestPort; +use strict; +use warnings; +use Class::Std::Fast::Storable; +use Scalar::Util qw(blessed); +use base qw(SOAP::WSDL::Client::Base); + +# only load if it hasn't been loaded before +require MyTypemaps::TestService + if not MyTypemaps::TestService->can('get_class'); + +sub START { + $_[0]->set_proxy('http://localhost:81/soap-wsdl-test/person.pl') if not $_[2]->{proxy}; + $_[0]->set_class_resolver('MyTypemaps::TestService') + if not $_[2]->{class_resolver}; +} + +sub ListPerson { + my ($self, $body, $header) = @_; + die "ListPerson must be called as object method (\$self is <$self>)" if not blessed($self); + return $self->SUPER::call({ + operation => 'ListPerson', + soap_action => 'http://www.example.org/benchmark/ListPerson', + style => 'document', + body => { + + 'use' => 'literal', + namespace => '', + encodingStyle => '', + parts => [qw( MyElements::ListPerson )], + }, + header => { + + }, + headerfault => { + + } + }, $body, $header); +} + + + +1; + + + +__END__ + +=pod + +=head1 NAME + + +MyInterfaces::TestService::TestPort - SOAP Interface for the TestService Web Service + +=head1 SYNOPSIS + + use MyInterfaces::TestService::TestPort; + my $interface = MyInterfaces::TestService::TestPort->new(); + + my $response; + $response = $interface->ListPerson(); + + + +=head1 DESCRIPTION + +SOAP Interface for the TestService web service +located at http://localhost:81/soap-wsdl-test/person.pl. + +=head1 SERVICE TestService + + + +=head2 Port TestPort + + + +=head1 METHODS + +=head2 General methods + +=head3 new + +Constructor. + +All arguments are forwarded to L. + +=head2 SOAP Service methods + +Method synopsis is displayed with hash refs as parameters. + +The commented class names in the method's parameters denote that objects +of the corresponding class can be passed instead of the marked hash ref. + +You may pass any combination of objects, hash and list refs to these +methods, as long as you meet the structure. + + + +=head3 ListPerson + + + + $interface->ListPerson( { + in => { # MyTypes::Person + PersonID => { # MyTypes::PersonID + ID => $some_value, # int + }, + Salutation => $some_value, # string + Name => $some_value, # string + GivenName => $some_value, # string + DateOfBirth => $some_value, # date + HomeAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + WorkAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + Contracts => { # MyTypes::ArrayOfContract + Contract => { # MyTypes::Contract + ContractID => $some_value, # long + ContractName => $some_value, # string + }, + }, + }, + },, + ); + + + +=head1 AUTHOR + +Generated by SOAP::WSDL on Mon Dec 3 22:20:49 2007 + +=pod \ No newline at end of file diff --git a/example/lib/MyServer/TestService/TestPort.pm b/example/lib/MyServer/TestService/TestPort.pm new file mode 100644 index 0000000..35ff18a --- /dev/null +++ b/example/lib/MyServer/TestService/TestPort.pm @@ -0,0 +1,145 @@ +package MyServer::TestService::TestPort; +use strict; +use warnings; +use Class::Std::Fast::Storable; +use Scalar::Util qw(blessed); +use base qw(SOAP::WSDL::Client::Base); + +# only load if it hasn't been loaded before +require MyTypemaps::TestService + if not MyTypemaps::TestService->can('get_class'); + +my %transport_class_of :ATTR(:name :default); +my %transport_of :ATTR(:name :default<()>); +my %dispatch_to :ATTR(:name); + +my $action_map_ref = { + 'http://www.example.org/benchmark/ListPerson' => 'ListPerson', + +}; + +sub START { + my ($self, $ident, $arg_ref) = @_; + eval "require $transport_class_of{ $ident }" + or die "Cannot load transport class $transport_class_of{ $ident }: $@"; + $transport_of{ $ident } = $transport_class_of{ $ident }->new({ + action_map_ref => $action_map_ref, + class_resolver => 'MyTypemaps::TestService', + dispatch_to => $dispatch_to{ $ident }, + }); +} + +sub handle { + $transport_of{ ${ $_[0] } }->handle(); +} + +1; + + + +__END__ + +=pod + +=head1 NAME + +MyInterfaces::TestService::TestPort - SOAP Server Class for the TestService Web Service + +=head1 SYNOPSIS + + use MyServer::TestService::TestPort; + my $server = MyServer::TestService::TestPort->new({ + dispatch_to => 'My::Handler::Class', + transport_class => 'SOAP::WSDL::Server::CGI', # optional, default + }); + $server->handle(); + + +=head1 DESCRIPTION + +SOAP Server handler for the TestService web service +located at http://localhost:81/soap-wsdl-test/person.pl. + +=head1 SERVICE TestService + + + +=head2 Port TestPort + + + +=head1 METHODS + +=head2 General methods + +=head3 new + +Constructor. + +The C argument is mandatory. It must be a class or object +implementing the SOAP Service methods listed below. + +=head2 SOAP Service methods + +Your dispatch_to class has to implement the following methods: + +The examples below serve as copy-and-paste prototypes to use in your +class. + +=head3 ListPerson + + + + sub ListPerson { + my ($self, $body, $header) = @_; + # body is a ??? object - sorry, POD not implemented yet + # header is a ??? object - sorry, POD not implemented yet + + # do something with body and header... + + return MyElements::ListPersonResponse->new( { + out => { # MyTypes::ArrayOfPerson + NewElement => { # MyTypes::Person + PersonID => { # MyTypes::PersonID + ID => $some_value, # int + }, + Salutation => $some_value, # string + Name => $some_value, # string + GivenName => $some_value, # string + DateOfBirth => $some_value, # date + HomeAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + WorkAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + Contracts => { # MyTypes::ArrayOfContract + Contract => { # MyTypes::Contract + ContractID => $some_value, # long + ContractName => $some_value, # string + }, + }, + }, + }, + }, + ); + + } + + + +=head1 AUTHOR + +Generated by SOAP::WSDL on Mon Dec 3 22:20:32 2007 + +=pod \ No newline at end of file diff --git a/example/lib/MyTypemaps/TestService.pm b/example/lib/MyTypemaps/TestService.pm new file mode 100644 index 0000000..de7c4f7 --- /dev/null +++ b/example/lib/MyTypemaps/TestService.pm @@ -0,0 +1,92 @@ +package MyTypemaps::TestService; +use strict; +use warnings; + +our $typemap_1 = { + 'ListPersonResponse/out/NewElement/WorkAddress/Street' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPerson/in/Contracts' => 'MyTypes::ArrayOfContract', + 'ListPerson/in/HomeAddress/PhoneNumber' => 'MyTypes::PhoneNumber', + 'ListPersonResponse/out/NewElement/HomeAddress' => 'MyTypes::Address', + 'ListPersonResponse/out/NewElement/Contracts/Contract' => 'MyTypes::Contract', + 'ListPersonResponse/out/NewElement/HomeAddress/ZIP' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPerson/in/WorkAddress/City' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPerson/in/HomeAddress' => 'MyTypes::Address', + 'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI', + 'ListPerson/in/HomeAddress/City' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/WorkAddress/PhoneNumber' => 'MyTypes::PhoneNumber', + 'ListPerson/in/WorkAddress/ZIP' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/Contracts' => 'MyTypes::ArrayOfContract', + 'ListPerson/in/WorkAddress/Street' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPerson/in' => 'MyTypes::Person', + 'ListPersonResponse/out/NewElement/GivenName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/HomeAddress/PhoneNumber' => 'MyTypes::PhoneNumber', + 'ListPersonResponse/out/NewElement/HomeAddress/City' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement' => 'MyTypes::Person', + 'ListPerson/in/PersonID/ID' => 'SOAP::WSDL::XSD::Typelib::Builtin::int', + 'ListPerson/in/HomeAddress/Street' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/PersonID/ID' => 'SOAP::WSDL::XSD::Typelib::Builtin::int', + 'ListPerson/in/HomeAddress/Country' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPerson/in/GivenName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPerson/in/HomeAddress/MobilePhoneNumber' => 'MyTypes::PhoneNumber', + 'ListPerson/in/Name' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/PersonID' => 'MyTypes::PersonID', + 'ListPersonResponse/out/NewElement/WorkAddress/MobilePhoneNumber' => 'MyTypes::PhoneNumber', + 'ListPersonResponse/out' => 'MyTypes::ArrayOfPerson', + 'ListPerson/in/Contracts/Contract' => 'MyTypes::Contract', + 'ListPersonResponse/out/NewElement/Name' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/WorkAddress/ZIP' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPerson/in/DateOfBirth' => 'SOAP::WSDL::XSD::Typelib::Builtin::date', + 'ListPersonResponse/out/NewElement/HomeAddress/MobilePhoneNumber' => 'MyTypes::PhoneNumber', + 'ListPersonResponse/out/NewElement/HomeAddress/Country' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/HomeAddress/Street' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/Contracts/Contract/ContractName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11', + 'ListPerson/in/Contracts/Contract/ContractName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse' => 'MyElements::ListPersonResponse', + 'ListPersonResponse/out/NewElement/Salutation' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/WorkAddress/City' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::token', + 'ListPerson' => 'MyElements::ListPerson', + 'ListPerson/in/Salutation' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPerson/in/WorkAddress/MobilePhoneNumber' => 'MyTypes::PhoneNumber', + 'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPerson/in/WorkAddress/Country' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPerson/in/PersonID' => 'MyTypes::PersonID', + 'ListPerson/in/HomeAddress/ZIP' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/WorkAddress' => 'MyTypes::Address', + 'ListPersonResponse/out/NewElement/DateOfBirth' => 'SOAP::WSDL::XSD::Typelib::Builtin::date', + 'ListPerson/in/WorkAddress/PhoneNumber' => 'MyTypes::PhoneNumber', + 'ListPersonResponse/out/NewElement/WorkAddress/Country' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + 'ListPersonResponse/out/NewElement/Contracts/Contract/ContractID' => 'SOAP::WSDL::XSD::Typelib::Builtin::long', + 'ListPerson/in/Contracts/Contract/ContractID' => 'SOAP::WSDL::XSD::Typelib::Builtin::long', + 'ListPerson/in/WorkAddress' => 'MyTypes::Address' + }; +; + +sub get_class { + my $name = join '/', @{ $_[1] }; + exists $typemap_1->{ $name } or die "Cannot resolve $name via " . __PACKAGE__; + return $typemap_1->{ $name }; +} + +sub get_typemap { + return $typemap_1; +} + +1; + +__END__ + +=pod + +=head1 NAME + +MyTypemaps::TestService; - typemap for ::TestService; + +=head1 DESCRIPTION + +Typemap created by SOAP::WSDL for map-based SOAP message parsers. + +=cut + diff --git a/example/lib/MyTypes/Address.pm b/example/lib/MyTypes/Address.pm new file mode 100644 index 0000000..220f949 --- /dev/null +++ b/example/lib/MyTypes/Address.pm @@ -0,0 +1,98 @@ +package MyTypes::Address; +use strict; +use warnings; +use Class::Std::Fast::Storable constructor => 'none'; +use base qw(SOAP::WSDL::XSD::Typelib::ComplexType); + +Class::Std::initialize(); + +{ # BLOCK to scope variables + +my %Street_of :ATTR(:get); +my %ZIP_of :ATTR(:get); +my %City_of :ATTR(:get); +my %Country_of :ATTR(:get); +my %PhoneNumber_of :ATTR(:get); +my %MobilePhoneNumber_of :ATTR(:get); + +__PACKAGE__->_factory( + [ qw( + Street + ZIP + City + Country + PhoneNumber + MobilePhoneNumber + ) ], + { + Street => \%Street_of, + ZIP => \%ZIP_of, + City => \%City_of, + Country => \%Country_of, + PhoneNumber => \%PhoneNumber_of, + MobilePhoneNumber => \%MobilePhoneNumber_of, + }, + { + Street => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + ZIP => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + City => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + Country => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + PhoneNumber => 'MyTypes::PhoneNumber', + MobilePhoneNumber => 'MyTypes::PhoneNumber', + } +); + +} # end BLOCK + + + + + + +1; + +=pod + +=head1 NAME + +MyTypes::Address + +=head1 DESCRIPTION + +Perl data type class for the XML Schema defined complextype +Address from the namespace http://www.example.org/benchmark/. + +=head2 PROPERTIES + +The following properties may be accessed using get_PROPERTY / set_PROPERTY +methods: + + Street + ZIP + City + Country + PhoneNumber + MobilePhoneNumber + + +=head1 METHODS + +=head2 new + +Constructor. The following data structure may be passed to new(): + + { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + +=head1 AUTHOR + +Generated by SOAP::WSDL + +=cut + diff --git a/example/lib/MyTypes/ArrayOfContract.pm b/example/lib/MyTypes/ArrayOfContract.pm new file mode 100644 index 0000000..5b2c0a9 --- /dev/null +++ b/example/lib/MyTypes/ArrayOfContract.pm @@ -0,0 +1,71 @@ +package MyTypes::ArrayOfContract; +use strict; +use warnings; +use Class::Std::Fast::Storable constructor => 'none'; +use base qw(SOAP::WSDL::XSD::Typelib::ComplexType); + +Class::Std::initialize(); + +{ # BLOCK to scope variables + +my %Contract_of :ATTR(:get); + +__PACKAGE__->_factory( + [ qw( + Contract + ) ], + { + Contract => \%Contract_of, + }, + { + Contract => 'MyTypes::Contract', + } +); + +} # end BLOCK + + + + + + +1; + +=pod + +=head1 NAME + +MyTypes::ArrayOfContract + +=head1 DESCRIPTION + +Perl data type class for the XML Schema defined complextype +ArrayOfContract from the namespace http://www.example.org/benchmark/. + +=head2 PROPERTIES + +The following properties may be accessed using get_PROPERTY / set_PROPERTY +methods: + + Contract + + +=head1 METHODS + +=head2 new + +Constructor. The following data structure may be passed to new(): + + { # MyTypes::ArrayOfContract + Contract => { # MyTypes::Contract + ContractID => $some_value, # long + ContractName => $some_value, # string + }, + }, + +=head1 AUTHOR + +Generated by SOAP::WSDL + +=cut + diff --git a/example/lib/MyTypes/ArrayOfPerson.pm b/example/lib/MyTypes/ArrayOfPerson.pm new file mode 100644 index 0000000..9b6ae50 --- /dev/null +++ b/example/lib/MyTypes/ArrayOfPerson.pm @@ -0,0 +1,98 @@ +package MyTypes::ArrayOfPerson; +use strict; +use warnings; +use Class::Std::Fast::Storable constructor => 'none'; +use base qw(SOAP::WSDL::XSD::Typelib::ComplexType); + +Class::Std::initialize(); + +{ # BLOCK to scope variables + +my %NewElement_of :ATTR(:get); + +__PACKAGE__->_factory( + [ qw( + NewElement + ) ], + { + NewElement => \%NewElement_of, + }, + { + NewElement => 'MyTypes::Person', + } +); + +} # end BLOCK + + + + + + +1; + +=pod + +=head1 NAME + +MyTypes::ArrayOfPerson + +=head1 DESCRIPTION + +Perl data type class for the XML Schema defined complextype +ArrayOfPerson from the namespace http://www.example.org/benchmark/. + +=head2 PROPERTIES + +The following properties may be accessed using get_PROPERTY / set_PROPERTY +methods: + + NewElement + + +=head1 METHODS + +=head2 new + +Constructor. The following data structure may be passed to new(): + + { # MyTypes::ArrayOfPerson + NewElement => { # MyTypes::Person + PersonID => { # MyTypes::PersonID + ID => $some_value, # int + }, + Salutation => $some_value, # string + Name => $some_value, # string + GivenName => $some_value, # string + DateOfBirth => $some_value, # date + HomeAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + WorkAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + Contracts => { # MyTypes::ArrayOfContract + Contract => { # MyTypes::Contract + ContractID => $some_value, # long + ContractName => $some_value, # string + }, + }, + }, + }, + +=head1 AUTHOR + +Generated by SOAP::WSDL + +=cut + diff --git a/example/lib/MyTypes/Contract.pm b/example/lib/MyTypes/Contract.pm new file mode 100644 index 0000000..4e0ead0 --- /dev/null +++ b/example/lib/MyTypes/Contract.pm @@ -0,0 +1,74 @@ +package MyTypes::Contract; +use strict; +use warnings; +use Class::Std::Fast::Storable constructor => 'none'; +use base qw(SOAP::WSDL::XSD::Typelib::ComplexType); + +Class::Std::initialize(); + +{ # BLOCK to scope variables + +my %ContractID_of :ATTR(:get); +my %ContractName_of :ATTR(:get); + +__PACKAGE__->_factory( + [ qw( + ContractID + ContractName + ) ], + { + ContractID => \%ContractID_of, + ContractName => \%ContractName_of, + }, + { + ContractID => 'SOAP::WSDL::XSD::Typelib::Builtin::long', + ContractName => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + } +); + +} # end BLOCK + + + + + + +1; + +=pod + +=head1 NAME + +MyTypes::Contract + +=head1 DESCRIPTION + +Perl data type class for the XML Schema defined complextype +Contract from the namespace http://www.example.org/benchmark/. + +=head2 PROPERTIES + +The following properties may be accessed using get_PROPERTY / set_PROPERTY +methods: + + ContractID + ContractName + + +=head1 METHODS + +=head2 new + +Constructor. The following data structure may be passed to new(): + + { # MyTypes::Contract + ContractID => $some_value, # long + ContractName => $some_value, # string + }, + +=head1 AUTHOR + +Generated by SOAP::WSDL + +=cut + diff --git a/example/lib/MyTypes/Person.pm b/example/lib/MyTypes/Person.pm new file mode 100644 index 0000000..fb0ea82 --- /dev/null +++ b/example/lib/MyTypes/Person.pm @@ -0,0 +1,131 @@ +package MyTypes::Person; +use strict; +use warnings; +use Class::Std::Fast::Storable constructor => 'none'; +use base qw(SOAP::WSDL::XSD::Typelib::ComplexType); + +Class::Std::initialize(); + +{ # BLOCK to scope variables + +my %PersonID_of :ATTR(:get); +my %Salutation_of :ATTR(:get); +my %Name_of :ATTR(:get); +my %GivenName_of :ATTR(:get); +my %DateOfBirth_of :ATTR(:get); +my %HomeAddress_of :ATTR(:get); +my %WorkAddress_of :ATTR(:get); +my %Contracts_of :ATTR(:get); + +__PACKAGE__->_factory( + [ qw( + PersonID + Salutation + Name + GivenName + DateOfBirth + HomeAddress + WorkAddress + Contracts + ) ], + { + PersonID => \%PersonID_of, + Salutation => \%Salutation_of, + Name => \%Name_of, + GivenName => \%GivenName_of, + DateOfBirth => \%DateOfBirth_of, + HomeAddress => \%HomeAddress_of, + WorkAddress => \%WorkAddress_of, + Contracts => \%Contracts_of, + }, + { + PersonID => 'MyTypes::PersonID', + Salutation => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + Name => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + GivenName => 'SOAP::WSDL::XSD::Typelib::Builtin::string', + DateOfBirth => 'SOAP::WSDL::XSD::Typelib::Builtin::date', + HomeAddress => 'MyTypes::Address', + WorkAddress => 'MyTypes::Address', + Contracts => 'MyTypes::ArrayOfContract', + } +); + +} # end BLOCK + + + + + + +1; + +=pod + +=head1 NAME + +MyTypes::Person + +=head1 DESCRIPTION + +Perl data type class for the XML Schema defined complextype +Person from the namespace http://www.example.org/benchmark/. + +=head2 PROPERTIES + +The following properties may be accessed using get_PROPERTY / set_PROPERTY +methods: + + PersonID + Salutation + Name + GivenName + DateOfBirth + HomeAddress + WorkAddress + Contracts + + +=head1 METHODS + +=head2 new + +Constructor. The following data structure may be passed to new(): + + { # MyTypes::Person + PersonID => { # MyTypes::PersonID + ID => $some_value, # int + }, + Salutation => $some_value, # string + Name => $some_value, # string + GivenName => $some_value, # string + DateOfBirth => $some_value, # date + HomeAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + WorkAddress => { # MyTypes::Address + Street => $some_value, # string + ZIP => $some_value, # string + City => $some_value, # string + Country => $some_value, # string + PhoneNumber => $some_value, # PhoneNumber + MobilePhoneNumber => $some_value, # PhoneNumber + }, + Contracts => { # MyTypes::ArrayOfContract + Contract => { # MyTypes::Contract + ContractID => $some_value, # long + ContractName => $some_value, # string + }, + }, + }, + +=head1 AUTHOR + +Generated by SOAP::WSDL + +=cut + diff --git a/example/lib/MyTypes/PersonID.pm b/example/lib/MyTypes/PersonID.pm new file mode 100644 index 0000000..55ce4c3 --- /dev/null +++ b/example/lib/MyTypes/PersonID.pm @@ -0,0 +1,68 @@ +package MyTypes::PersonID; +use strict; +use warnings; +use Class::Std::Fast::Storable constructor => 'none'; +use base qw(SOAP::WSDL::XSD::Typelib::ComplexType); + +Class::Std::initialize(); + +{ # BLOCK to scope variables + +my %ID_of :ATTR(:get); + +__PACKAGE__->_factory( + [ qw( + ID + ) ], + { + ID => \%ID_of, + }, + { + ID => 'SOAP::WSDL::XSD::Typelib::Builtin::int', + } +); + +} # end BLOCK + + + + + + +1; + +=pod + +=head1 NAME + +MyTypes::PersonID + +=head1 DESCRIPTION + +Perl data type class for the XML Schema defined complextype +PersonID from the namespace http://www.example.org/benchmark/. + +=head2 PROPERTIES + +The following properties may be accessed using get_PROPERTY / set_PROPERTY +methods: + + ID + + +=head1 METHODS + +=head2 new + +Constructor. The following data structure may be passed to new(): + + { # MyTypes::PersonID + ID => $some_value, # int + }, + +=head1 AUTHOR + +Generated by SOAP::WSDL + +=cut + diff --git a/example/lib/MyTypes/PhoneNumber.pm b/example/lib/MyTypes/PhoneNumber.pm new file mode 100644 index 0000000..58bea0b --- /dev/null +++ b/example/lib/MyTypes/PhoneNumber.pm @@ -0,0 +1,56 @@ +package MyTypes::PhoneNumber; +use strict; +use warnings; + +sub get_xmlns { 'http://www.example.org/benchmark/'}; + +# derivation by restriction +use base qw( + SOAP::WSDL::XSD::Typelib::Builtin::string +); + + + +1; + +=pod + +=head1 MyTypes::PhoneNumber + +=head1 DESCRIPTION + +Perl data type class for the XML Schema defined simpleType +PhoneNumber from the namespace http://www.example.org/benchmark/. + +This clase is derived from SOAP::WSDL::XSD::Typelib::Builtin::string +. SOAP::WSDL's schema implementation does not validate data, so you can use it exactly +like it's base type. + +# Description of restrictions not implemented yet. + +=head1 METHODS + +=head2 new + +Constructor. + +=head2 get_value / set_value + +Getter and setter for the simpleType's value. + +=head1 OVERLOADING + +Depending on the simple type's base type, the following operations are overloaded + + Stringification + Numerification + Boolification + +Check L for more information. + +=head1 AUTHOR + +Generated by SOAP::WSDL + +=cut + diff --git a/example/person.pl b/example/person.pl new file mode 100644 index 0000000..fc526f4 --- /dev/null +++ b/example/person.pl @@ -0,0 +1,10 @@ +use lib 'lib'; +use MyInterfaces::TestService::TestPort; + +my $soap = MyInterfaces::TestService::TestPort->new(); +$soap->outputxml(1); +my $result = $soap->ListPerson({}); + +# print "Found " . scalar @{ $result->get_out->get_NewElement } . " persons\n"; + +print $result; diff --git a/example/person_compile.pl b/example/person_compile.pl new file mode 100644 index 0000000..df9f63b --- /dev/null +++ b/example/person_compile.pl @@ -0,0 +1,21 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use XML::Compile::WSDL11; +use XML::Compile::Transport::SOAPHTTP; + +my $wsdl = XML::Compile::WSDL11->new('wsdl/Person.wsdl'); + +# I have to lookup the methods from the WSDL +my $call = $wsdl->compileClient('ListPerson'); + +# I have to lookup the parameters from the WSDL +my $result = $call->({ in => undef}); + +die "Error calling soap method" if not defined $result; + +# I have to lookup the output parameters from the WSDL - or try Dumper +#use Data::Dumper; +#print Dumper $result; + +print "Found ", scalar @{ $result->{ parameters }->{ out }->{ seq_NewElement }->[0]->{ NewElement } } , " persons\n"; diff --git a/example/wsdl/Person.wsdl b/example/wsdl/Person.wsdl new file mode 100644 index 0000000..a46b6a2 --- /dev/null +++ b/example/wsdl/Person.wsdl @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/lib/SOAP/WSDL/Definitions.pm b/lib/SOAP/WSDL/Definitions.pm index bf4bde7..d771094 100644 --- a/lib/SOAP/WSDL/Definitions.pm +++ b/lib/SOAP/WSDL/Definitions.pm @@ -18,7 +18,7 @@ my %binding_of :ATTR(:name :default<()>); my %service_of :ATTR(:name :default<()>); my %namespace_of :ATTR(:name :default<()>); -# must be attr for Class::Std::Storable +# must be attr for Class::Std::Fast::Storable my %attributes_of :ATTR(); %attributes_of = ( binding => \%binding_of, @@ -118,9 +118,9 @@ Martin Kutter Emartin.kutter fen-net.deE =head1 REPOSITORY INFORMATION - $Rev: 427 $ + $Rev: 431 $ $LastChangedBy: kutterma $ - $Id: Definitions.pm 427 2007-12-02 22:20:24Z kutterma $ + $Id: Definitions.pm 431 2007-12-03 19:39:11Z kutterma $ $HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Definitions.pm $ =cut diff --git a/lib/SOAP/WSDL/Factory/Transport.pm b/lib/SOAP/WSDL/Factory/Transport.pm index cf59618..b427509 100644 --- a/lib/SOAP/WSDL/Factory/Transport.pm +++ b/lib/SOAP/WSDL/Factory/Transport.pm @@ -37,8 +37,10 @@ sub get_transport { $scheme =~s{ \A ([^\:]+) \: .+ }{$1}smx; if ($registered_transport_of{ $scheme }) { - eval "require $registered_transport_of{ $scheme }" - or die "Cannot load transport class $registered_transport_of{ $scheme } : $@"; + no strict qw(refs); + *{ $registered_transport_of{ $scheme } . '::' }{ CODE } + or eval "require $registered_transport_of{ $scheme }" + or die "Cannot load transport class $registered_transport_of{ $scheme } : $@"; # try "foo::Client" class first - SOAP::Tranport always requires # a package withoug the ::Client appended, and then @@ -68,8 +70,10 @@ sub get_transport { } if (exists $SOAP_WSDL_TRANSPORT_OF{ $scheme }) { - eval "require $SOAP_WSDL_TRANSPORT_OF{ $scheme }" - or die "Cannot load transport class $SOAP_WSDL_TRANSPORT_OF{ $scheme } : $@"; + no strict qw(refs); + *{ $SOAP_WSDL_TRANSPORT_OF{ $scheme } . '::' }{ CODE } + 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 ); } @@ -236,9 +240,9 @@ Martin Kutter Emartin.kutter fen-net.deE =head1 REPOSITORY INFORMATION - $Rev: 427 $ + $Rev: 435 $ $LastChangedBy: kutterma $ - $Id: Transport.pm 427 2007-12-02 22:20:24Z kutterma $ + $Id: Transport.pm 435 2007-12-03 22:31:00Z kutterma $ $HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Transport.pm $ =cut diff --git a/lib/SOAP/WSDL/Generator/Template/XSD/Server/POD/Operation.tt b/lib/SOAP/WSDL/Generator/Template/XSD/Server/POD/Operation.tt index a1bff2c..4bca2cc 100644 --- a/lib/SOAP/WSDL/Generator/Template/XSD/Server/POD/Operation.tt +++ b/lib/SOAP/WSDL/Generator/Template/XSD/Server/POD/Operation.tt @@ -4,7 +4,7 @@ port_op = type.find_operation( definitions.get_targetNamespace, operation.get_name ); port_op.get_documentation %] - sub [% operation.get_name %]( + sub [% operation.get_name %] { my ($self, $body, $header) = @_; # body is a ??? object - sorry, POD not implemented yet # header is a ??? object - sorry, POD not implemented yet diff --git a/lib/SOAP/WSDL/Generator/Template/XSD/complexType/extension.tt b/lib/SOAP/WSDL/Generator/Template/XSD/complexType/extension.tt index 3f48111..4067616 100644 --- a/lib/SOAP/WSDL/Generator/Template/XSD/complexType/extension.tt +++ b/lib/SOAP/WSDL/Generator/Template/XSD/complexType/extension.tt @@ -8,12 +8,15 @@ element_from = complexType.get_element; # # Sanity check: All original elements must be noted first # +element_list = base_type.get_element; FOREACH element = base_type.get_element; IF element_from.${ 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 ); -%] use base qw([% type_prefix %]::[% base_name.1.replace('\.', '::') %]); diff --git a/lib/SOAP/WSDL/Generator/Visitor/Typemap.pm b/lib/SOAP/WSDL/Generator/Visitor/Typemap.pm index e066661..b046bc3 100644 --- a/lib/SOAP/WSDL/Generator/Visitor/Typemap.pm +++ b/lib/SOAP/WSDL/Generator/Visitor/Typemap.pm @@ -123,7 +123,7 @@ sub visit_Part { # TODO: auto-generate element for RPC bindings if ( my $type_name = $part->get_type ) { # FIXME support RPC-style calls - die "unsupported global type <$type_name> found in part"; + die "unsupported global type <$type_name> found in part ". $part->get_name(); } # TODO factor out iterator or replace by lookup (probably better) diff --git a/lib/SOAP/WSDL/Server/CGI.pm b/lib/SOAP/WSDL/Server/CGI.pm index a02d3c9..f40cb99 100644 --- a/lib/SOAP/WSDL/Server/CGI.pm +++ b/lib/SOAP/WSDL/Server/CGI.pm @@ -9,11 +9,10 @@ use HTTP::Headers; use Scalar::Util qw(blessed); use Class::Std::Fast::Storable; -# use Class::Std::Storable; use base qw(SOAP::WSDL::Server); -our $VERSION=q{2.00_25}; +our $VERSION=q{2.00_26}; # 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,6 +79,10 @@ sub handle { 'Content-type' => 'text/xml; charset="utf-8"' ); $response->content( $response_message ); + { + use bytes; + $response->header('Content-length', length $response_message); + } } $self->_output($response); diff --git a/t/008_client_wsdl_complexType.t b/t/008_client_wsdl_complexType.t index 4b26c45..21cc21e 100644 --- a/t/008_client_wsdl_complexType.t +++ b/t/008_client_wsdl_complexType.t @@ -3,16 +3,19 @@ use strict; use warnings; use Test::More qw/no_plan/; # TODO: change to tests => N; use lib '../lib'; +use File::Basename; +use File::Spec; -use Cwd; - -my $path = cwd; -$path =~s|\/t\/?$||; # allow running from t/ and above (Build test) +my $path = File::Spec->rel2abs( dirname __FILE__ ); +my ($volume, $dir) = File::Spec->splitpath($path, 1); +my @dir_from = File::Spec->splitdir($dir); +unshift @dir_from, $volume if $volume; +my $url = join '/', @dir_from; use_ok(qw/SOAP::WSDL/); my $soap = SOAP::WSDL->new( - wsdl => 'file:///' . $path .'/t/acceptance/wsdl/008_complexType.wsdl' + wsdl => 'file://' . $url .'/acceptance/wsdl/008_complexType.wsdl' )->wsdlinit(); my $wsdl = $soap->get_definitions; diff --git a/t/009_data_classes.t b/t/009_data_classes.t index 8f04778..ab19752 100644 --- a/t/009_data_classes.t +++ b/t/009_data_classes.t @@ -11,8 +11,14 @@ use Cwd; use SOAP::WSDL; use SOAP::WSDL::XSD::Typelib::Builtin; -my $path = cwd; -$path =~s|\/t\/?$||; # allow running from t/ and above (Build test) +use File::Basename; +use File::Spec; + +my $path = File::Spec->rel2abs( dirname __FILE__ ); +my ($volume, $dir) = File::Spec->splitpath($path, 1); +my @dir_from = File::Spec->splitdir($dir); +unshift @dir_from, $volume if $volume; +my $url = join '/', @dir_from; my $parser; @@ -37,7 +43,7 @@ else # TODO factor out into different test my $soap = SOAP::WSDL->new( - wsdl => 'file:///' . $path .'/t/acceptance/wsdl/006_sax_client.wsdl', + wsdl => 'file://' . $url .'/acceptance/wsdl/006_sax_client.wsdl', )->wsdlinit(); $soap->servicename('MessageGateway'); diff --git a/t/013_complexType.t b/t/013_complexType.t index 078814e..fb04327 100644 --- a/t/013_complexType.t +++ b/t/013_complexType.t @@ -23,7 +23,7 @@ is $obj, 'testtest2', # try on the fly factory @MyComplexType2::ISA = ('SOAP::WSDL::XSD::Typelib::ComplexType'); { - use Class::Std::Storable; + use Class::Std::Fast::Storable; my %MyTestName_of; MyComplexType2->_factory( diff --git a/t/SOAP/WSDL/02_port.t b/t/SOAP/WSDL/02_port.t index c2d9f30..28826cf 100644 --- a/t/SOAP/WSDL/02_port.t +++ b/t/SOAP/WSDL/02_port.t @@ -3,17 +3,23 @@ use strict; use warnings; use diagnostics; use Cwd; +use lib '../lib'; + use File::Basename; use File::Spec; -use lib '../lib'; + +my $path = File::Spec->rel2abs( dirname __FILE__ ); +my ($volume, $dir) = File::Spec->splitpath($path, 1); +my @dir_from = File::Spec->splitdir($dir); +unshift @dir_from, $volume if $volume; +my $url = join '/', @dir_from; use_ok(qw/SOAP::WSDL/); -my $path = File::Spec->rel2abs( dirname __FILE__ ); my $soap; #2 ok( $soap = SOAP::WSDL->new( - wsdl => 'file:///' . $path . '/../../acceptance/wsdl/02_port.wsdl' + wsdl => 'file://' . $url . '/../../acceptance/wsdl/02_port.wsdl' ), 'Instantiated object' ); ok( ($soap->servicename('testService') ), 'set service' ); diff --git a/t/SOAP/WSDL/04_element-simpleType.t b/t/SOAP/WSDL/04_element-simpleType.t index ffe6a1c..3cf6172 100644 --- a/t/SOAP/WSDL/04_element-simpleType.t +++ b/t/SOAP/WSDL/04_element-simpleType.t @@ -6,16 +6,21 @@ use lib 't/lib'; use File::Basename; use File::Spec; + +my $path = File::Spec->rel2abs( dirname __FILE__ ); +my ($volume, $dir) = File::Spec->splitpath($path, 1); +my @dir_from = File::Spec->splitdir($dir); +unshift @dir_from, $volume if $volume; +my $url = join '/', @dir_from; + use_ok(qw/SOAP::WSDL/); my $xml; my $soap = undef; -my $path = File::Spec->rel2abs( dirname __FILE__ ); - ok( $soap = SOAP::WSDL->new( - wsdl => 'file:///' . $path . '/../../acceptance/wsdl/04_element-simpleType.wsdl' + wsdl => 'file://' . $url . '/../../acceptance/wsdl/04_element-simpleType.wsdl' ), 'Instantiated object' ); # won't work without - would require SOAP::WSDL::Deserializer::SOM, diff --git a/t/SOAP/WSDL/05_simpleType-list.t b/t/SOAP/WSDL/05_simpleType-list.t index 8f1dacb..0301609 100644 --- a/t/SOAP/WSDL/05_simpleType-list.t +++ b/t/SOAP/WSDL/05_simpleType-list.t @@ -2,19 +2,22 @@ use Test::More tests => 8; use strict; use lib '../lib'; use lib 't/lib'; -use File::Spec; use File::Basename; +use File::Spec; + +my $path = File::Spec->rel2abs( dirname __FILE__ ); +my ($volume, $dir) = File::Spec->splitpath($path, 1); +my @dir_from = File::Spec->splitdir($dir); +unshift @dir_from, $volume if $volume; +my $url = join '/', @dir_from; use_ok(qw/SOAP::WSDL/); my ($soap, $xml, $xml2); -# chdir to my location -my $path = File::Spec->rel2abs( dirname __FILE__ ); - #2 ok( $soap = SOAP::WSDL->new( - wsdl => 'file:///' . $path . '/../../acceptance/wsdl/05_simpleType-list.wsdl' + wsdl => 'file://' . $url . '/../../acceptance/wsdl/05_simpleType-list.wsdl' ), 'Instantiated object' ); # won't work without - would require SOAP::WSDL::Deserializer::SOM, diff --git a/t/SOAP/WSDL/05_simpleType-restriction.t b/t/SOAP/WSDL/05_simpleType-restriction.t index 3567303..65f7409 100644 --- a/t/SOAP/WSDL/05_simpleType-restriction.t +++ b/t/SOAP/WSDL/05_simpleType-restriction.t @@ -7,16 +7,23 @@ use File::Basename; use lib '../lib'; use lib 't/lib'; +use File::Basename; +use File::Spec; + +my $path = File::Spec->rel2abs( dirname __FILE__ ); +my ($volume, $dir) = File::Spec->splitpath($path, 1); +my @dir_from = File::Spec->splitdir($dir); +unshift @dir_from, $volume if $volume; +my $url = join '/', @dir_from; + use_ok(qw/SOAP::WSDL/); my $xml; -my $path = File::Spec->rel2abs( dirname __FILE__ ); - my $soap; #2 ok( $soap = SOAP::WSDL->new( - wsdl => 'file:///' . $path . '/../../acceptance/wsdl/05_simpleType-restriction.wsdl' + wsdl => 'file://' . $url . '/../../acceptance/wsdl/05_simpleType-restriction.wsdl' ), 'Instantiated object' ); #3 diff --git a/t/SOAP/WSDL/06_keep_alive.t b/t/SOAP/WSDL/06_keep_alive.t index 627e572..0427381 100644 --- a/t/SOAP/WSDL/06_keep_alive.t +++ b/t/SOAP/WSDL/06_keep_alive.t @@ -2,19 +2,23 @@ use Test::More tests => 6; use strict; use warnings; use diagnostics; -use Cwd; +use lib '../lib'; use File::Basename; use File::Spec; -use lib '../lib'; + +my $path = File::Spec->rel2abs( dirname __FILE__ ); +my ($volume, $dir) = File::Spec->splitpath($path, 1); +my @dir_from = File::Spec->splitdir($dir); +unshift @dir_from, $volume if $volume; +my $url = join '/', @dir_from; use_ok(qw/SOAP::WSDL/); -my $path = File::Spec->rel2abs( dirname __FILE__ ); my $soap; #2 ok( $soap = SOAP::WSDL->new( - wsdl => 'file:///' . $path . '/../../acceptance/wsdl/02_port.wsdl', - keep_alive => 1, + wsdl => 'file://' . $url . '/../../acceptance/wsdl/02_port.wsdl', + keep_alive => 1, ), 'Instantiated object' ); ok( ($soap->servicename('testService') ), 'set service' ); diff --git a/t/SOAP/WSDL/11_helloworld.NET.t b/t/SOAP/WSDL/11_helloworld.NET.t index 155248b..c521cd0 100644 --- a/t/SOAP/WSDL/11_helloworld.NET.t +++ b/t/SOAP/WSDL/11_helloworld.NET.t @@ -13,9 +13,14 @@ use strict; use Test::More tests => 4; use lib '../../../lib/'; -use File::Spec; use File::Basename; +use File::Spec; +my $path = File::Spec->rel2abs( dirname __FILE__ ); +my ($volume, $dir) = File::Spec->splitpath($path, 1); +my @dir_from = File::Spec->splitdir($dir); +unshift @dir_from, $volume if $volume; +my $url = join '/', @dir_from; use_ok q/SOAP::WSDL/; @@ -23,19 +28,16 @@ use_ok q/SOAP::WSDL/; print "# Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n"; print "# Acceptance test against sample output with simple WSDL\n"; - - my $data = { - name => 'test', - givenName => 'test', + name => 'test', + givenName => 'test', }; my $soap = undef; -my $path = File::Spec->rel2abs( dirname __FILE__ ); ok $soap = SOAP::WSDL->new( - wsdl => 'file:///'.$path.'/../../acceptance/wsdl/11_helloworld.wsdl', - no_dispatch => 1 + wsdl => 'file://'.$url.'/../../acceptance/wsdl/11_helloworld.wsdl', + no_dispatch => 1 ), 'Create SOAP::WSDL object'; # won't work without - would require SOAP::WSDL::Deserializer::SOM, diff --git a/t/SOAP/WSDL/12_binding.t b/t/SOAP/WSDL/12_binding.t index 9d8a5b7..6d9268a 100644 --- a/t/SOAP/WSDL/12_binding.t +++ b/t/SOAP/WSDL/12_binding.t @@ -2,9 +2,15 @@ use strict; use lib '../../../lib'; use Test::More tests => 4; use SOAP::WSDL; -use File::Spec; -use Data::Dumper; use File::Basename; +use File::Spec; + +my $path = File::Spec->rel2abs( dirname __FILE__ ); +my ($volume, $dir) = File::Spec->splitpath($path, 1); +my @dir_from = File::Spec->splitdir($dir); +unshift @dir_from, $volume if $volume; +my $url = join '/', @dir_from; + print "# Using SOAP::WSDL Version $SOAP::WSDL::VERSION\n"; @@ -13,13 +19,13 @@ my $soap = undef; my $path = File::Spec->rel2abs( dirname __FILE__ ); -my $url = 'http://127.0.0.1/testPort'; +my $proxy = 'http://127.0.0.1/testPort'; ok( $soap = SOAP::WSDL->new( - wsdl => 'file:///' . $path . '/../../acceptance/wsdl/02_port.wsdl' + wsdl => 'file://' . $url . '/../../acceptance/wsdl/02_port.wsdl' ) ); -ok $soap->wsdlinit( url => $url ); +ok $soap->wsdlinit( url => $proxy ); ok $soap->servicename('testService'); ok $soap->portname('testPort'); diff --git a/t/contributed.wsdl b/t/contributed.wsdl new file mode 100644 index 0000000..74b4396 --- /dev/null +++ b/t/contributed.wsdl @@ -0,0 +1,206 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +