Compare commits

...
2 Commits
Author SHA1 Message Date
Martin Kutter a78d6d15b5 import SOAP-WSDL 2.00_05 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_05
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_05.tar.gz
2009-12-12 19:47:43 -08:00
Martin Kutter 5c42b1d8f6 import SOAP-WSDL 2.00_04 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_04
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_04.tar.gz
2009-12-12 19:47:43 -08:00
39 changed files with 608 additions and 380 deletions
+2 -1
View File
@@ -2,7 +2,7 @@ use Module::Build;
Module::Build->new( Module::Build->new(
dist_abstract => 'SOAP with WSDL support', dist_abstract => 'SOAP with WSDL support',
dist_name => 'SOAP-WSDL', dist_name => 'SOAP-WSDL',
dist_version => '2.00_03', dist_version => '2.00_05',
module_name => 'SOAP::WSDL', module_name => 'SOAP::WSDL',
license => 'artistic', license => 'artistic',
requires => { requires => {
@@ -30,4 +30,5 @@ Module::Build->new(
'XML::SAX::ParserFactory' => 0, 'XML::SAX::ParserFactory' => 0,
}, },
recursive_test_files => 1,
)->create_build_script; )->create_build_script;
+19 -19
View File
@@ -123,25 +123,6 @@ t/acceptance/wsdl/contributed/ETest.wsdl
t/acceptance/wsdl/contributed/OITest.wsdl t/acceptance/wsdl/contributed/OITest.wsdl
t/acceptance/wsdl/contributed/tools.wsdl t/acceptance/wsdl/contributed/tools.wsdl
t/acceptance/wsdl/email_account.wsdl t/acceptance/wsdl/email_account.wsdl
t/attic/01_use.t
t/attic/02_port.t
t/attic/03_complexType-all.t
t/attic/03_complexType-choice.t
t/attic/03_complexType-complexContent.t
t/attic/03_complexType-group.t
t/attic/03_complexType-sequence.t
t/attic/03_complexType-simpleContent.t
t/attic/04_element-complexType.t
t/attic/04_element-simpleType.t
t/attic/04_element.t
t/attic/05_simpleType-list.t
t/attic/05_simpleType-restriction.t
t/attic/05_simpleType-union.t
t/attic/10_performance.t
t/attic/11_helloworld.NET.t
t/attic/12_binding.pl
t/attic/97_pod.t
t/attic/98_pod_coverage.t
t/lib/MyComplexType.pm t/lib/MyComplexType.pm
t/lib/MyElement.pm t/lib/MyElement.pm
t/lib/MySimpleType.pm t/lib/MySimpleType.pm
@@ -149,3 +130,22 @@ t/lib/Test/SOAPMessage.pm
t/lib/Typelib/Base.pm t/lib/Typelib/Base.pm
t/lib/Typelib/TEnqueueMessage.pm t/lib/Typelib/TEnqueueMessage.pm
t/lib/Typelib/TMessage.pm t/lib/Typelib/TMessage.pm
t/SOAP/WSDL/01_use.t
t/SOAP/WSDL/02_port.t
t/SOAP/WSDL/03_complexType-all.t
t/SOAP/WSDL/03_complexType-choice.t
t/SOAP/WSDL/03_complexType-complexContent.t
t/SOAP/WSDL/03_complexType-group.t
t/SOAP/WSDL/03_complexType-sequence.t
t/SOAP/WSDL/03_complexType-simpleContent.t
t/SOAP/WSDL/04_element-complexType.t
t/SOAP/WSDL/04_element-simpleType.t
t/SOAP/WSDL/04_element.t
t/SOAP/WSDL/05_simpleType-list.t
t/SOAP/WSDL/05_simpleType-restriction.t
t/SOAP/WSDL/05_simpleType-union.t
t/SOAP/WSDL/10_performance.t
t/SOAP/WSDL/11_helloworld.NET.t
t/SOAP/WSDL/12_binding.pl
t/SOAP/WSDL/97_pod.t
t/SOAP/WSDL/XSD/Typelib/Builtin/001_string.t
+2 -2
View File
@@ -1,6 +1,6 @@
--- ---
name: SOAP-WSDL name: SOAP-WSDL
version: 2.00_03 version: 2.00_05
author: author:
abstract: SOAP with WSDL support abstract: SOAP with WSDL support
license: artistic license: artistic
@@ -19,7 +19,7 @@ meta-spec:
provides: provides:
SOAP::WSDL: SOAP::WSDL:
file: lib/SOAP/WSDL.pm file: lib/SOAP/WSDL.pm
version: 2.00_03 version: 2.00_05
SOAP::WSDL::Base: SOAP::WSDL::Base:
file: lib/SOAP/WSDL/Base.pm file: lib/SOAP/WSDL/Base.pm
SOAP::WSDL::Binding: SOAP::WSDL::Binding:
+139 -47
View File
@@ -8,7 +8,7 @@ use SOAP::WSDL::SAX::WSDLHandler;
use base qw(SOAP::Lite); use base qw(SOAP::Lite);
use Data::Dumper; use Data::Dumper;
our $VERSION='2.00_03'; our $VERSION='2.00_05';
BEGIN { BEGIN {
eval { eval {
@@ -231,7 +231,7 @@ sub call {
if (blessed $data if (blessed $data
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType')) && $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
{ {
$envelope = SOAP::WSDL::Envelope->serialize( $method, $data , { readable => 1 }); $envelope = SOAP::WSDL::Envelope->serialize( $method, $data );
# TODO replace by something derived from binding - this is just a # TODO replace by something derived from binding - this is just a
# workaround... # workaround...
@@ -263,13 +263,12 @@ sub call {
}; };
if ( $self->no_dispatch() ) if ( $self->no_dispatch() ) {
{ return $envelope;
return $envelope; } ## end if ( $self->no_dispatch...
} ## end if ( $self->no_dispatch...
# get response via transport layer # get response via transport layer
# TODO remove dependency from SOAP::Lite and use a # TODO remove dependency from SOAP::Lite and use a
# SAX-based filter using XML::LibXML to get the # SAX-based filter using XML::LibXML to get the
# result. # result.
# Filter should have the following methods: # Filter should have the following methods:
@@ -279,14 +278,14 @@ sub call {
# - fault: returns the result of the call if a SOAP fault is sent back # - fault: returns the result of the call if a SOAP fault is sent back
# by the server. Retuns undef (nothing) if the call has been # by the server. Retuns undef (nothing) if the call has been
# processed without errors. # processed without errors.
my $response = $self->transport->send_receive( my $response = $self->transport->send_receive(
context => $self, # this is provided for context context => $self, # this is provided for context
endpoint => $self->endpoint(), endpoint => $self->endpoint(),
action => $methodInfo->{ soap_action }, # SOAPAction from binding action => $methodInfo->{ soap_action }, # SOAPAction from binding
envelope => $envelope, # use custom content envelope => $envelope, # use custom content
); );
return $response if ($self->outputxml() ); return $response if ($self->outputxml() );
if ($self->outputtree()) { if ($self->outputtree()) {
@@ -336,30 +335,28 @@ sub call {
return $handler->get_data(); return $handler->get_data();
} }
# deserialize and store result # deserialize and store result
my $result = $self->{ '_call' } = my $result = $self->{ '_call' } =
eval { $self->deserializer->deserialize( $response ) } eval { $self->deserializer->deserialize( $response ) }
if $response; if $response;
if ( if (
!$self->transport->is_success || # transport fault !$self->transport->is_success || # transport fault
$@ || # not deserializible $@ || # not deserializible
# fault message even if transport OK # fault message even if transport OK
# or no transport error (for example, fo TCP, POP3, IO implementations) # or no transport error (for example, fo TCP, POP3, IO implementations)
UNIVERSAL::isa( $result => 'SOAP::SOM' ) && $result->fault UNIVERSAL::isa( $result => 'SOAP::SOM' ) && $result->fault
) ) {
{ return $self->{ '_call' } = (
return $self->{ '_call' } = ( $self->on_fault->( $self, ($@)
$self->on_fault->( ? $@ . ( $response || '' )
$self, $@ ? $@ . ( $response || '' ) : $result : $result
) ) || $result
|| $result );
); } ## end if ( !$self->transport...
# ? # trick editors
} ## end if ( !$self->transport...
return unless $response; # nothing to do for one-ways return unless $response; # nothing to do for one-ways
return $result; return $result;
} ## end sub call } ## end sub call
sub explain { sub explain {
@@ -440,30 +437,114 @@ SOAP::Lite's transport mechanism.
=head1 METHODS =head1 METHODS
=head2 wsdlinit
Reads the WSDL file and initializes SOAP::WSDL for working with it.
Must be called after the wsdl URL has been set, and before calling one of
servicename
portname
call
You may set servicename and portname by passing them as attributes to
wsdlinit:
$soap->wsdlinit(
servicename => 'MyService',
portname => 'MyPort'
);
=head2 call
Performs a SOAP call. The result is either an object tree (with outputtree),
a hash reference (with outputhash), plain XML (with outputxml) or a SOAP::SOM
object (with neither of the above set).
my $result = $soap->call('method', %data);
=head1 CONFIGURATION METHODS
=head2 outputtree
When outputtree is set, SOAP::WSDL will return an object tree instead of a
SOAP::SOM object.
You have to specify a class_resolver for this to work. See
<class_resolver|class_resolver>
=head2 class_resolver
Set the class resolver class (or object).
Class resolvers must implement the method get_class which has to return the
name of the class name for deserializing a XML node at the current XPath
location.
Class resolvers are typically generated by using the to_typemap method on a
SOAP::WSDL::Definitions objects.
Example:
XML structure (SOAP body content):
<Person>
<Name>Smith</Name>
<FirstName>John</FirstName>
</Person>
Class resolver
package MyResolver;
my %typemap = (
'Person' => 'MyPersonClass',
'Person/Name' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
'Person/FirstName' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
);
sub get_class { return $typemap{ $_[1] } };
1;
You'll need a MyPersonClass module in your search path for this to work - see
SOAP::WSDL::XSD::ComplexType on how to build / generate one.
=head2 servicename =head2 servicename
$soap->servicname('Name'); $soap->servicename('Name');
Sets the service to operate on. If no service is set via servicename, the Sets the service to operate on. If no service is set via servicename, the
first service found is used. first service found is used.
Must be called after calling wsdlinit().
Returns the soap object, so you can chain calls like Returns the soap object, so you can chain calls like
$soap->servicename->('Name')->portname('Port'); $soap->servicename->('Name')->portname('Port');
=head2 portname
$soap->portname('Name');
Sets the port to operate on. If no port is set via portname, the
first port found is used.
Must be called after calling wsdlinit().
Returns the soap object, so you can chain calls like
$soap->portname('Port')->call('MyMethod', %data);
=head2 no_dispatch
When set, call() returns the plain request XML instead of dispatching the
SOAP call to the SOAP service. Handy for testing/debugging.
=head2 _wsdl_init_methods =head2 _wsdl_init_methods
=over
=item DESCRIPTION
Creates a lookup table containing the information required for all methods Creates a lookup table containing the information required for all methods
specified for the service/port selected. specified for the service/port selected.
The lookup table is used by L<call|call>. The lookup table is used by L<call|call>.
=back
=head1 Differences to previous versions =head1 Differences to previous versions
@@ -480,11 +561,22 @@ The object tree has two main functions: It knows how to serialize data passed
as hash ref, and how to render the WSDL elements found into perl classes. as hash ref, and how to render the WSDL elements found into perl classes.
Yup your're right, there's a builting code generation facility. Yup your're right, there's a builting code generation facility.
=item * no_dispatch
call() with outputtxml set to true now returns the complete SOAP
envelope, not only the body's content.
=item * outputxml =item * outputxml
call() with outputtxml set to true now returns the complete SOAP call() with outputxml set to true now returns the complete SOAP
envelope, not only the body's content. envelope, not only the body's content.
=item * servicename/portname
Both servicename and portname can only be called B<after> calling wsdlinit().
You may pass the servicename and portname as attributes to wsdlinit, though.
=back =back
+13 -2
View File
@@ -1,11 +1,13 @@
package SOAP::WSDL::Client; package SOAP::WSDL::Client;
use strict; use strict;
use warnings; use warnings;
use Carp;
use Scalar::Util qw(blessed); use Scalar::Util qw(blessed);
use SOAP::WSDL::Envelope; use SOAP::WSDL::Envelope;
use SOAP::Lite; use SOAP::Lite;
use Class::Std::Storable; use Class::Std::Storable;
use SOAP::WSDL::SAX::MessageHandler; use SOAP::WSDL::SAX::MessageHandler;
use SOAP::WSDL::SOAP::Typelib::Fault11;
# Package globals for speed... # Package globals for speed...
my $PARSER; my $PARSER;
@@ -101,11 +103,20 @@ sub call {
# if we had no success (Transport layer error status code) # if we had no success (Transport layer error status code)
# or if transport layer failed # or if transport layer failed
if (! $soap->transport->is_success() ) { if (! $soap->transport->is_success() ) {
# TODO Fix deserializing message - there's something wrong with Fault11
# Try deserializing response - there may be some # Try deserializing response - there may be some
if ($response) { if ($response) {
eval { $PARSER->parse_string( $response ) };
return $MESSAGE_HANDLER->get_data if not $@; eval { $PARSER->parse_string( $response ); };
if ($@) {
warn "could not deserialize response: $@";
}
else {
return $MESSAGE_HANDLER->get_data();
}
}; };
require SOAP::WSDL::SOAP::Typelib::Fault11; require SOAP::WSDL::SOAP::Typelib::Fault11;
# generate & return fault if we cannot serialize response # generate & return fault if we cannot serialize response
+121 -1
View File
@@ -53,10 +53,130 @@ sub explain {
sub to_typemap { sub to_typemap {
my $self = shift; my $self = shift;
my $opt = shift; my $opt = shift;
$opt->{ wsdl } ||= $self;
$opt->{ prefix } ||= q{}; $opt->{ prefix } ||= q{};
$opt->{ wsdl } ||= $self;
$opt->{ type_prefix } ||= $opt->{ prefix };
$opt->{ element_prefix } ||= $opt->{ prefix };
return join "\n", return join "\n",
map { $_->to_typemap( $opt ) } @{ $service_of{ ident $self } }; map { $_->to_typemap( $opt ) } @{ $service_of{ ident $self } };
} }
1; 1;
=pod
=head1 NAME
SOAP::WSDL::Definitions - model a WSDL E<gt>definitionsE<lt> element
=head1 DESCRIPTION
=head1 METHODS
=head2 first_service get_service set_service push_service
Accessors/Mutators for accessing / setting the E<gt>serviceE<lt> child
element(s).
=head2 find_service
Returns the service matching the namespace/localname pair passed as arguments.
my $service = $wsdl->find_service($namespace, $localname);
=head2 first_binding get_binding set_binding push_binding
Accessors/Mutators for accessing / setting the E<gt>bindingE<lt> child
element(s).
=head2 find_service
Returns the binding matching the namespace/localname pair passed as arguments.
my $binding = $wsdl->find_binding($namespace, $localname);
=head2 first_portType get_portType set_portType push_portType
Accessors/Mutators for accessing / setting the E<gt>portTypeE<lt> child
element(s).
=head2 find_portType
Returns the portType matching the namespace/localname pair passed as arguments.
my $portType = $wsdl->find_portType($namespace, $localname);
=head2 first_message get_message set_message push_message
Accessors/Mutators for accessing / setting the E<gt>messageE<lt> child
element(s).
=head2 find_service
Returns the message matching the namespace/localname pair passed as arguments.
my $message = $wsdl->find_message($namespace, $localname);
=head2 first_types get_types set_types push_types
Accessors/Mutators for accessing / setting the E<gt>typesE<lt> child
element(s).
=head2 explain
Returns a POD string describing how to call the methods of the service(s)
described in the WSDL.
=head2 to_typemap
Creates a typemap for use with a generated type class library.
Options:
NAME DESCRIPTION
-------------------------------------------------------------------------
prefix Prefix to use for all classes
type_prefix Prefix to use for all (Complex/Simple)Type classes
element_prefix Prefix to use for all Element classes (with atomic types)
As some webservices tend to use globally unique type definitions, but
locally unique elements with atomic types, type and element classes may
be separated by specifying type_prefix and element_prefix instead of
prefix.
The typemap is plain text which can be used as snipped for building a
SOAP::WSDL class_resolver perl class.
Try something like this for creating typemap classes:
my $parser = XML::LibXML->new();
my $handler = SOAP::WSDL::SAX::WSDLHandler->new()
$parser->set_handler( $handler );
$parser->parse_url('file:///path/to/wsdl');
my $wsdl = $handler->get_data();
my $typemap = $wsdl->to_typemap();
print <<"EOT"
package MyTypemap;
my \%typemap = (
$typemap
);
sub get_class { return \$typemap{\$_[1] } };
1;
"EOT"
=head1 LICENSE
Copyright 2004-2007 Martin Kutter.
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself
=head1 AUTHOR
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=cut
+56 -3
View File
@@ -15,13 +15,13 @@ use base qw(
my %faultcode_of :ATTR(:get<faultcode>); my %faultcode_of :ATTR(:get<faultcode>);
my %faultstring_of :ATTR(:get<faultstring>); my %faultstring_of :ATTR(:get<faultstring>);
my %faultactor_of :ATTR(:get<faultactor>); my %faultactor_of :ATTR(:get<faultactor>);
my %detail_of :ATTR(:get<faultdetail>); my %detail_of :ATTR(:get<detail>);
# always return false in boolean context - a fault is never true... # always return false in boolean context - a fault is never true...
sub as_bool :BOOLIFY { return; } sub as_bool :BOOLIFY { return; }
__PACKAGE__->_factory( __PACKAGE__->_factory(
[ qw(faultcode faultstring faultactor faultdetail) ], [ qw(faultcode faultstring faultactor detail) ],
{ {
faultcode => \%faultcode_of, faultcode => \%faultcode_of,
faultstring => \%faultstring_of, faultstring => \%faultstring_of,
@@ -44,4 +44,57 @@ __PACKAGE__->__set_minOccurs();
__PACKAGE__->__set_maxOccurs(); __PACKAGE__->__set_maxOccurs();
__PACKAGE__->__set_ref(''); __PACKAGE__->__set_ref('');
1; 1;
=pod
=head1 NAME
SOAP::WSDL::SOAP::Typelib::Fault11 - SOAP 1.1 Fault class
=head1 DESCRIPTION
Models a SOAP 1.1 Fault.
SOAP::WSDL::SOAP::Typelib::Fault11 objects are false in boolean context
and serialize to XML on stringification.
This means you can do something like:
my $soap = SOAP::WSDL::Client->new();
# ...
my $result = $soap->call($method, $data);
if (not $result) {
die "Error calling SOAP method: ", $result->get_faultstring();
}
=head1 METHODS
=head2 get_faultcode / set_faultcode
Getter/setter for object's the faultcode property.
=head2 get_faultstring / set_faultstring
Getter/setter for object's the faultstring property.
=head2 get_faultactor / set_faultactor
Getter/setter for object's the faultactor property.
=head2 get_detail / set_detail
Getter/setter for detail object's detail property.
=head1 LICENSE
Copyright 2007 Martin Kutter.
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself
=head1 AUTHOR
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=cut
+13 -4
View File
@@ -153,6 +153,7 @@ sub to_typemap {
my $type; my $type;
push @{ $opt->{path} }, $self->get_name(); push @{ $opt->{path} }, $self->get_name();
# referenced types need type_prefix
if ( my $typename = $self->get_type() ) { if ( my $typename = $self->get_type() ) {
my ($prefix, $localname) = split /:/, $self->get_type(); my ($prefix, $localname) = split /:/, $self->get_type();
my $ns = $nsmap{ $prefix }; my $ns = $nsmap{ $prefix };
@@ -165,12 +166,18 @@ sub to_typemap {
else else
{ {
$type = $opt->{ wsdl }->first_types()->find_type( $ns, $localname ); $type = $opt->{ wsdl }->first_types()->find_type( $ns, $localname );
$typeclass = $opt->{ prefix } . $type->get_name(); # referenced types need type_prefix (may be globally unique)
$typeclass = $opt->{ type_prefix } . $type->get_name();
$txt .= $type->to_typemap($opt); $txt .= $type->to_typemap($opt);
} }
$txt .= q{'} . join( q{/}, @{ $opt->{path} } ) . "' => '$typeclass',\n"; $txt .= q{'} . join( q{/}, @{ $opt->{path} } ) . "' => '$typeclass',\n";
} }
# atomic types need element prefix
elsif ($type = $self->first_simpleType() ) { elsif ($type = $self->first_simpleType() ) {
# atomic types need element prefix (may be locally unique)
# TODO fix simpletype Typemap
my $typeclass = $opt->{ element_prefix } . $self->get_name();
$txt .= q{'} . join( q{/}, @{ $opt->{path} } ) . "' => '$typeclass',\n";
my $flavor = $type->get_flavor(); my $flavor = $type->get_flavor();
if ( $flavor eq 'sequence' ) { if ( $flavor eq 'sequence' ) {
$txt .= "# atomic simple type (sequence)\n"; $txt .= "# atomic simple type (sequence)\n";
@@ -185,7 +192,7 @@ sub to_typemap {
} }
elsif ($type = $self->first_complexType() ) { elsif ($type = $self->first_complexType() ) {
my $typeclass = $opt->{ prefix } . $self->get_name(); my $typeclass = $opt->{ element_prefix } . $self->get_name();
$txt .= q{'} . join( q{/}, @{ $opt->{path} } ) . "' => '$typeclass',\n"; $txt .= q{'} . join( q{/}, @{ $opt->{path} } ) . "' => '$typeclass',\n";
my $flavor = $type->get_flavor(); my $flavor = $type->get_flavor();
if ( $flavor eq 'sequence' ) { if ( $flavor eq 'sequence' ) {
@@ -223,6 +230,7 @@ use base qw(
[% type.base_class($class_prefix) %] [% type.base_class($class_prefix) %]
); );
[% ELSIF (type = self.first_complexType) %] [% ELSIF (type = self.first_complexType) %]
# atomic complexType
# <element name="[% self.get_name %]"><complexType> definition # <element name="[% self.get_name %]"><complexType> definition
use SOAP::WSDL::XSD::Typelib::ComplexType; use SOAP::WSDL::XSD::Typelib::ComplexType;
use base qw( use base qw(
@@ -250,7 +258,7 @@ __PACKAGE__->_factory(
IF nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema' %] IF nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema' %]
[% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% localname %]', [% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% localname %]',
[% ELSE %] [% ELSE %]
[% element.get_name %] => '[% class_prefix %]::[% localname %]', [% element.get_name %] => '[% type_prefix %]::[% localname %]',
[% END %] [% END %]
[% END %] [% END %]
} }
@@ -266,7 +274,7 @@ __PACKAGE__->_factory(
[% IF (nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema'); [% IF (nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema');
base_class = 'SOAP::WSDL::XSD::Typelib::Builtin::' _ localname ; base_class = 'SOAP::WSDL::XSD::Typelib::Builtin::' _ localname ;
ELSE; ELSE;
base_class = class_prefix _ '::' _ localname; base_class = type_prefix _ '::' _ localname;
-%] -%]
use [% base_class %]; use [% base_class %];
@@ -298,6 +306,7 @@ EOT
); );
my $code = $tt->process( \$template, { my $code = $tt->process( \$template, {
class_prefix => $opt->{ prefix }, class_prefix => $opt->{ prefix },
type_prefix => $opt->{ type_prefix },
self => $self, self => $self,
nsmap => { reverse %{ $opt->{ wsdl }->get_xmlns() } }, nsmap => { reverse %{ $opt->{ wsdl }->get_xmlns() } },
}, },
@@ -25,6 +25,8 @@ sub serialize {
sub as_bool :BOOLIFY { sub as_bool :BOOLIFY {
return $value_of { ident $_[0] }; return $value_of { ident $_[0] };
} }
Class::Std::initialize(); # make :BOOLIFY overloading serializable
1; 1;
@@ -3,6 +3,8 @@ use strict;
use warnings; use warnings;
use Class::Std::Storable; use Class::Std::Storable;
my %xmlns_of :ATTR(:name<xmlns> :default<()>);
# use $_[1] for performance # use $_[1] for performance
sub start_tag { sub start_tag {
my $opt = $_[1] ||= {}; my $opt = $_[1] ||= {};
@@ -20,6 +22,8 @@ sub end_tag {
sub serialize_qualified :STRINGIFY { sub serialize_qualified :STRINGIFY {
return $_[0]->serialize( { qualified => 1 } ); return $_[0]->serialize( { qualified => 1 } );
} }
Class::Std::initialize(); # make :STRINGIFY overloading serializable
1; 1;
@@ -33,6 +33,8 @@ sub set_value {
: 0; : 0;
} }
Class::Std::initialize(); # make :BOOLIFY overloading serializable
1; 1;
__END__ __END__
@@ -18,6 +18,7 @@ sub as_num :NUMERIFY :BOOLIFY {
return $_[0]->get_value(); return $_[0]->get_value();
} }
Class::Std::initialize(); # make :NUMERIFY :BOOLIFY overloading serializable
1; 1;
@@ -8,6 +8,7 @@ sub as_num :NUMERIFY {
return $_[0]->get_value(); return $_[0]->get_value();
} }
Class::Std::initialize(); # make :NUMERIFY overloading serializable
1; 1;
@@ -16,6 +16,8 @@ my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
sub as_num :NUMERIFY { sub as_num :NUMERIFY {
return $_[0]->get_value(); return $_[0]->get_value();
} }
Class::Std::initialize(); # make :NUMERIFY overloading serializable
1; 1;
@@ -7,6 +7,8 @@ use base qw(SOAP::WSDL::XSD::Typelib::Builtin::decimal);
sub as_num :NUMERIFY { sub as_num :NUMERIFY {
return $_[0]->get_value(); return $_[0]->get_value();
} }
Class::Std::initialize(); # make :NUMERIFY overloading serializable
1; 1;
@@ -2,6 +2,7 @@ package SOAP::WSDL::XSD::Typelib::Builtin::string;
use strict; use strict;
use warnings; use warnings;
use Class::Std::Storable; use Class::Std::Storable;
# use HTML::Entities qw(encode_entities);
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType); use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %length_of :ATTR(:name<length> :default<()>); my %length_of :ATTR(:name<length> :default<()>);
@@ -10,6 +11,31 @@ my %maxLength_of :ATTR(:name<maxLength> :default<()>);
my %pattern_of :ATTR(:name<pattern> :default<()>); my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>); my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>); my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %char2entity = (
q{&} => q{&amp;},
q{<} => q{&lt;},
q{>} => q{&gt;},
q{"} => q{&qout;},
q{'} => q{&apos;},
);
sub serialize {
my ($self, $opt) = @_;
my $ident = ident $self;
$opt ||= {};
my $value = $self->get_value();
return $self->start_tag({ %$opt, nil => 1})
if not defined $value;
# HTML::Entities does the same - and more, thus it's around 1/3 slower...
$value =~ s{([&<>"'])}{$char2entity{$1}}xgmso;
return join q{}, $self->start_tag($opt, $value)
#, encode_entities( $value, q{&<>"'} )
, $value
, $self->end_tag($opt);
}
1; 1;
@@ -20,6 +46,11 @@ __END__
=head1 NAME =head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::string - string objects SOAP::WSDL::XSD::Typelib::Builtin::string - string objects
=head1 DESCRIPTION
String objects. XML entities (&, E<lt> E<gt> " ') are encoded on
serialization.
=head1 LICENSE =head1 LICENSE
+33 -21
View File
@@ -84,12 +84,18 @@ sub START {
# iterate over keys of arguments # iterate over keys of arguments
# and call set appropriate field in clase # and call set appropriate field in clase
map { ($ATTRIBUTES_OF{ $class }->{ $_ }) ? map { ($ATTRIBUTES_OF{ $class }->{ $_ })
do { ? do {
my $method = "set_$_"; my $method = "set_$_";
$self->$method( $args_of->{ $_ } ); $self->$method( $args_of->{ $_ } );
} }
: croak "unknown field $_" : $_ =~ m{ \A # beginning of string
xmlns # xmlns
}xms
? do {}
: croak "unknown field $_ in $class";
# TODO maybe only warn for unknown fields ?
} keys %$args_of; } keys %$args_of;
}; };
@@ -114,24 +120,30 @@ sub _serialize {
# get_elements is inlined for performance. # get_elements is inlined for performance.
return join q{} , map { return join q{} , map {
my $element = $ATTRIBUTES_OF{ $class }->{ $_ }->{ $ident }; my $element = $ATTRIBUTES_OF{ $class }->{ $_ }->{ $ident };
$element = [ $element ]
if not ref $element eq 'ARRAY'; if (defined $element) {
my $name = $_; $element = [ $element ]
if not ref $element eq 'ARRAY';
map { my $name = $_;
# serialize element elements with their own serializer
# but name them like they're named here. map {
if ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) { # serialize element elements with their own serializer
$_->serialize( { name => $_ } ); # but name them like they're named here.
} if ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) {
# serialize complextype elments (of other types) with their $_->serialize( { name => $_ } );
# serializer, but add element tags around. }
else { # serialize complextype elments (of other types) with their
join q{}, $_->start_tag({ name => $name }) # serializer, but add element tags around.
, $_->serialize() else {
, $_->end_tag({ name => $name }); join q{}, $_->start_tag({ name => $name })
} , $_->serialize()
} @{ $element } , $_->end_tag({ name => $name });
}
} @{ $element }
}
else {
q{};
}
} (@{ $ELEMENTS_FROM{ $class } }); } (@{ $ELEMENTS_FROM{ $class } });
} }
+1
View File
@@ -56,5 +56,6 @@ sub get_class {
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string', 'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyType', 'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyType',
); );
return $class_list{ $_[1] };
} }
+1 -1
View File
@@ -19,7 +19,7 @@ chdir $path;
$path = cwd; $path = cwd;
$path =~s{/attic}{}xms; $path =~s{/SOAP/WSDL}{}xms;
#2 #2
ok( $soap = SOAP::WSDL->new( ok( $soap = SOAP::WSDL->new(
@@ -1,4 +1,4 @@
use Test::More tests => 8; use Test::More tests => 7;
use strict; use strict;
use warnings; use warnings;
use lib '../lib'; use lib '../lib';
@@ -15,11 +15,11 @@ if ($@)
} }
my $path = cwd(); my $path = cwd();
my $name = $0; my $name = basename $0;
$name =~s/\.t$//; $name =~s/\.t$//;
$name =~s/^t\///; $name =~s/^t\///;
$path =~s{/attic}{}xms; $path =~s{(/t)?/SOAP/WSDL}{}xms;
use_ok(qw/SOAP::WSDL/); use_ok(qw/SOAP::WSDL/);
@@ -30,30 +30,27 @@ my $soap;
#2 #2
ok( $soap = SOAP::WSDL->new( ok( $soap = SOAP::WSDL->new(
wsdl => 'file://' . $path . '/acceptance/wsdl/' . $name . '.wsdl', wsdl => 'file://' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl',
readable =>1, readable =>1,
), 'Instantiated object' ); ), 'Instantiated object' );
#3 #3
ok $soap->wsdlinit( checkoccurs => 1, ), 'parse WSDL'; ok $soap->wsdlinit(
checkoccurs => 1,
servicename => 'testService',
), 'parse WSDL';
ok $soap->no_dispatch(1), 'set no dispatch'; ok $soap->no_dispatch(1), 'set no dispatch';
ok ($xml = $soap->call('test', ok ($xml = $soap->call('test',
Test1 => 'Test 1', testAll => {
Test2 => 'Test 2', Test1 => 'Test 1',
Test2 => [ 'Test 2', 'Test 3' ]
}
), 'Serialized complexType' ); ), 'Serialized complexType' );
open (my $fh, $path . '/acceptance/results/' . $name . '.xml') # print $xml;
|| die "Cannot open acceptance results file";
my $testXML = <$fh>;
close $fh;
SKIP: {
skip( $SKIP, 1 ) if ($SKIP);
eval { soap_eq_or_diff( $xml, $testXML, 'Got expected result') };
};
# $soap->wsdl_checkoccurs(1); # $soap->wsdl_checkoccurs(1);
@@ -1,17 +1,15 @@
BEGIN BEGIN {
{ use Test::More tests => 6;
chdir 't/' if (-d 't/'); use lib '../lib';
use Test::More tests => 7;; use lib 't/lib';
use lib '../lib'; use lib 'lib';
use lib 't/lib'; use Cwd;
use lib 'lib'; use File::Basename;
use Cwd;
use File::Basename; our $SKIP;
eval "use Test::SOAPMessage";
our $SKIP; if ($@)
eval "use Test::SOAPMessage"; {
if ($@)
{
$SKIP = "Test::Differences required for testing. $@"; $SKIP = "Test::Differences required for testing. $@";
} }
} }
@@ -21,19 +19,20 @@ use_ok(qw/SOAP::WSDL/);
my $xml; my $xml;
my $path = cwd(); my $path = cwd();
my $name = $0; my $name = basename $0;
$name =~s/\.t$//; $name =~s/\.t$//;
$path=~s{/attic}{}xms; $path=~s{(/t)?/SOAP/WSDL}{}xms;
#2 #2
ok( $soap = SOAP::WSDL->new( ok( $soap = SOAP::WSDL->new(
wsdl => 'file://' . $path . '/acceptance/wsdl/' . $name . '.wsdl' wsdl => 'file://' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' ); ), 'Instantiated object' );
#3 #3
ok( $soap->wsdlinit( ok( $soap->wsdlinit(
checkoccurs => 1, checkoccurs => 1,
servicename => 'testService',
), 'parsed WSDL' ); ), 'parsed WSDL' );
$soap->no_dispatch(1); $soap->no_dispatch(1);
$soap->serializer()->envprefix('SOAP-ENV'); $soap->serializer()->envprefix('SOAP-ENV');
@@ -48,17 +47,6 @@ ok $xml = $soap->call('test',
), 'Serialized complexType'; ), 'Serialized complexType';
#5 #5
open (my $fh, $path . '/acceptance/results/' . $name . '.xml')
|| die "Cannot open acceptance results file";
my $testXML = <$fh>;
close $fh;
SKIP:
{
skip( $SKIP, 1 ) if ($SKIP);
soap_eq_or_diff( $xml, $testXML, 'Got expected result');
}
#6
eval eval
{ {
$xml = $soap->serializer->method( $xml = $soap->serializer->method(
@@ -73,7 +61,7 @@ ok( ($@),
"Died on illegal number of elements" "Died on illegal number of elements"
); );
#7 #6
eval eval
{ {
$xml = $soap->serializer->method( $xml = $soap->serializer->method(
@@ -1,40 +1,34 @@
use Test::More; use Test::More tests => 6;
use strict; use strict;
use warnings; use warnings;
plan qw/no_plan/;
use lib '../lib'; use lib '../lib';
use lib 't/lib'; use lib 't/lib';
use lib 'lib'; use lib 'lib';
use Cwd; use Cwd;
use File::Basename; use File::Basename;
our $SKIP;
eval "use Test::SOAPMessage";
if ($@) {
$SKIP = "Test::Differences required for testing.";
}
use_ok(qw/SOAP::WSDL/); use_ok(qw/SOAP::WSDL/);
my $xml; my $xml;
my $soap = undef; my $soap = undef;
my $name = basename( $0 ); my $name = basename $0;
$name =~s/\.(t|pl)$//; $name =~s/\.(t|pl)$//;
my $path = cwd; my $path = cwd;
$path =~s{/attic}{}xms; $path =~s{(/t)?/SOAP/WSDL}{}xms;
#2 #2
ok( $soap = SOAP::WSDL->new( ok( $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl' wsdl => 'file:///' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' ); ), 'Instantiated object' );
#3 #3
$soap->readable(1); $soap->readable(1);
ok( $soap->wsdlinit(), 'parsed WSDL' ); ok( $soap->wsdlinit(
servicename => 'testService',
), 'parsed WSDL' );
$soap->no_dispatch(1); $soap->no_dispatch(1);
ok ( $xml = $soap->call('test', testElement1 => 1 ) , ok ( $xml = $soap->call('test', testElement1 => 1 ) ,
@@ -43,17 +37,6 @@ ok ( $xml = $soap->call('test', testElement1 => 1 ) ,
# print $xml, "\n"; # print $xml, "\n";
open (my $fh, $path . '/acceptance/results/' . $name . '.xml')
|| die 'Cannot open acceptance file '
. $path . '/acceptance/results/' . $name . '.xml';
my $testXML = <$fh>;
close $fh;
SKIP: {
skip($SKIP, 1) if ($SKIP);
soap_eq_or_diff( $xml, $testXML, 'Got expected result');
}
TODO: { TODO: {
local $TODO="implement min/maxOccurs checks"; local $TODO="implement min/maxOccurs checks";
@@ -1,4 +1,4 @@
use Test::More tests => 7;; use Test::More tests => 6;
use strict; use strict;
use warnings; use warnings;
use lib '../lib'; use lib '../lib';
@@ -18,39 +18,27 @@ use_ok(qw/SOAP::WSDL/);
my $soap; my $soap;
my $xml; my $xml;
my $path = cwd(); my $path = cwd();
my $name = $0; my $name = basename $0;
$name =~s/\.t$//; $name =~s/\.t$//;
$path =~s{/attic}{}xsm; $path =~s{(/t)?/SOAP/WSDL}{}xsm;
#2 #2
ok( $soap = SOAP::WSDL->new( ok( $soap = SOAP::WSDL->new(
wsdl => 'file://' . $path . '/acceptance/wsdl/' . $name . '.wsdl' wsdl => 'file://' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' ); ), 'Instantiated object' );
#3 #3
$soap->readable(1); $soap->readable(1);
ok( $soap->wsdlinit(), 'parsed WSDL' ); ok( $soap->wsdlinit(
servicename => 'testService',
), 'parsed WSDL' );
$soap->no_dispatch(1); $soap->no_dispatch(1);
ok ($xml = $soap->call('test', ok ($xml = $soap->call('test',
testElement1 => 'Test' testElement1 => 'Test'
), 'Serialized (simple) element' ); ), 'Serialized (simple) element' );
open (my $fh, $path . '/acceptance/results/' . $name . '.xml')
|| die "Cannot open acceptance results file";
my $testXML = <$fh>;
close $fh;
SKIP: {
if ($SKIP){
print $xml;
skip( $SKIP, 1 );
}
soap_eq_or_diff( $xml, $testXML, 'Got expected result');
};
TODO: { TODO: {
local $TODO="implement min/maxOccurs checks"; local $TODO="implement min/maxOccurs checks";
@@ -15,24 +15,24 @@ my $name = basename( $0 );
$name =~s/\.(t|pl)$//; $name =~s/\.(t|pl)$//;
my $path = cwd; my $path = cwd;
$path =~s{/attic}{}xms; $path =~s{(/t)/SOAP/WSDL}{}xms;
#2 #2
ok( $soap = SOAP::WSDL->new( ok( $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl' wsdl => 'file:///' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' ); ), 'Instantiated object' );
$soap->readable(1); $soap->readable(1);
#3 #3
ok( $soap->wsdlinit(), 'parsed WSDL' ); ok( $soap->wsdlinit(
servicename => 'testService',
), 'parsed WSDL' );
$soap->no_dispatch(1); $soap->no_dispatch(1);
#4 #4
ok $xml = $soap->call('test', testAll => [ 1, 2 ] ), 'Serialize list call'; ok $xml = $soap->call('test', testAll => [ 1, 2 ] ), 'Serialize list call';
print $xml, "\n";
#5 #5
ok ( $xml2 = $soap->call('test', testAll => "1 2" ) , 'Serialized scalar call' ); ok ( $xml2 = $soap->call('test', testAll => "1 2" ) , 'Serialized scalar call' );
#6 #6
@@ -12,21 +12,23 @@ use_ok(qw/SOAP::WSDL/);
my $xml; my $xml;
my $name = basename( $0 ); my $name = basename $0;
$name =~s/\.(t|pl)$//; $name =~s/\.(t|pl)$//;
my $path = cwd; my $path = cwd;
$path =~s{/attic}{}xms; $path =~s{(/t)/SOAP/WSDL}{}xms;
my $soap; my $soap;
#2 #2
ok( $soap = SOAP::WSDL->new( ok( $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl' wsdl => 'file:///' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' ); ), 'Instantiated object' );
#3 #3
$soap->readable(1); $soap->readable(1);
ok( $soap->wsdlinit(), 'parsed WSDL' ); ok( $soap->wsdlinit(
servicename => 'testService',
), 'parsed WSDL' );
$soap->no_dispatch(1); $soap->no_dispatch(1);
$soap->autotype(0); $soap->autotype(0);
@@ -15,11 +15,11 @@ $name =~s/\.(t|pl)$//;
my $path = cwd; my $path = cwd;
$path =~s{/attic}{}xms; $path =~s{(/t)?/SOAP/WSDL}{}xms;
#2 #2
ok $soap = SOAP::WSDL->new( ok $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl' wsdl => 'file:///' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object'; ), 'Instantiated object';
#3 #3
@@ -30,18 +30,6 @@ $soap->no_dispatch(1);
#4 #4
ok $xml = $soap->call('test', testAll => 1 ) , 'Serialized call'; ok $xml = $soap->call('test', testAll => 1 ) , 'Serialized call';
print $xml, "\n";
SKIP: {
open (my $fh, $path . '/acceptance/results/' . $name . '.xml')
|| skip("Cannot open acceptance results file ". $name . '.xml', 1);
my $testXML = <$fh>;
close $fh;
is( $xml, $testXML, 'Got expected result');
}
# 6 # 6
eval { eval {
$xml = $soap->serializer->method( $xml = $soap->serializer->method(
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w #!/usr/bin/perl -w
use strict; use strict;
use Test::More tests=> 6; use Test::More tests=> 5;
use Time::HiRes qw( gettimeofday tv_interval ); use Time::HiRes qw( gettimeofday tv_interval );
use lib '../..'; use lib '../..';
use Data::Dumper; use Data::Dumper;
@@ -9,24 +9,22 @@ use File::Basename;
use_ok qw/ SOAP::WSDL /; use_ok qw/ SOAP::WSDL /;
use Benchmark; use Benchmark;
# print "Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n"; print "# Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n";
# print "Performance test with simple WSDL file\n"; print "# Performance test with simple WSDL file\n";
my $soap;
my $data = { my $data = {
sayHello => {
name => 'Mein Name', name => 'Mein Name',
givenName => 'Vorname' givenName => 'Vorname',
}
}; };
# chdir to my location
my $cwd = cwd;
my $path = dirname( $0 );
my $soap = undef;
my $name = basename( $0 ); my $name = basename( $0 );
$name =~s/\.(t|pl)$//; $name =~s/\.(t|pl)$//;
chdir $path;
$path = cwd; my $path = cwd;
$path=~s{(/t)?/SOAP/WSDL}{}xms;
my $cacheDir; my $cacheDir;
if ($^O =~ m/Win/) if ($^O =~ m/Win/)
@@ -42,7 +40,7 @@ else
my $t0 = [gettimeofday]; my $t0 = [gettimeofday];
ok( ok(
$soap=SOAP::WSDL->new( $soap=SOAP::WSDL->new(
wsdl => "file://$path/acceptance/wsdl/10_helloworld.asmx.xml", wsdl => "file://$path/t/acceptance/wsdl/10_helloworld.asmx.xml",
no_dispatch => 1 no_dispatch => 1
), ),
"Create SOAP::WSDL object (".tv_interval ( $t0, [gettimeofday]) ."ms)" ); "Create SOAP::WSDL object (".tv_interval ( $t0, [gettimeofday]) ."ms)" );
@@ -51,8 +49,10 @@ $soap->proxy('http://helloworld/helloworld.asmx');
$t0 = [gettimeofday]; $t0 = [gettimeofday];
eval{ eval{
$soap->wsdlinit(caching => 1, $soap->wsdlinit(
cache_directory => $cacheDir ) }; caching => 1,
cache_directory => $cacheDir,
servicename => 'Service1' ) };
unless ($@) { unless ($@) {
pass("wsdl file init (".tv_interval ( $t0, [gettimeofday]) ."s)"); pass("wsdl file init (".tv_interval ( $t0, [gettimeofday]) ."s)");
@@ -69,7 +69,7 @@ $t0 = [gettimeofday];
ok($soap->call(sayHello => %{ $data }), ok($soap->call(sayHello => %{ $data }),
"1 x call pre-work (".tv_interval ( $t0, [gettimeofday]) ."s)" ); "1 x call pre-work (".tv_interval ( $t0, [gettimeofday]) ."s)" );
timethis 500, sub { $soap->call(sayHello => %{ $data }) }; timethis 1000, sub { $soap->call(sayHello => %{ $data }) };
__END__ __END__
+56
View File
@@ -0,0 +1,56 @@
#!/usr/bin/perl -w
#######################################################################################
#
# 2_helloworld.t
#
# Acceptance test for message encoding, based on .NET wsdl and example code.
# SOAP::WSDL's encoding doesn't I<exactly> match the .NET example, because
# .NET doesn't always specify types (SOAP::WSDL does), and the namespace
# prefixes chosen are different (maybe the encoding style, too ? this would be a bug !)
#
########################################################################################
use strict;
use Test::More tests => 4;
use lib '../..';
use Cwd;
use File::Basename;
use_ok q/SOAP::WSDL/;
### test vars END
print "# Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n";
print "# Acceptance test against sample output with simple WSDL\n";
my $data = {
name => 'test',
givenName => 'test',
};
my $soap = undef;
my $name = basename( $0 );
$name =~s/\.(t|pl)$//;
my $path = cwd;
$path =~s{(/t)?/SOAP/WSDL}{}xms;
ok $soap = SOAP::WSDL->new(
wsdl => 'file:///'.$path.'/t/acceptance/wsdl/11_helloworld.wsdl',
no_dispatch => 1
), 'Create SOAP::WSDL object';
$soap->serializer()->namespace('SOAP-ENV');
$soap->serializer()->encodingspace('SOAP-ENC');
$soap->proxy('http://helloworld/helloworld.asmx');
ok $soap->wsdlinit(
servicename => 'Service1',
), 'wsdlinit';
ok $soap->call('sayHello', 'sayHello' => $data), 'soap call';
@@ -1,36 +1,34 @@
use strict;
use lib '../lib'; use lib '../lib';
use Test; use Test::More tests => 4;
use SOAP::WSDL; use SOAP::WSDL;
use Cwd; use Cwd;
use Data::Dumper; use Data::Dumper;
use File::Basename;
plan tests => 9;
print "# Using SOAP::WSDL Version $SOAP::WSDL::VERSION\n"; print "# Using SOAP::WSDL Version $SOAP::WSDL::VERSION\n";
my $name = '02_port'; my $name = '02_port';
# chdir to my location # chdir to my location
my $cwd = cwd; my $soap = undef;
my $path = cwd;
if (-d 't') $path =~s{(/t)?/SOAP/WSDL}{}xms;
{
$cwd .= '/t';
}
my $url = 'http://127.0.0.1/testPort'; my $url = 'http://127.0.0.1/testPort';
ok(1);
ok( $soap = SOAP::WSDL->new( ok( $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $cwd . '/acceptance/wsdl/' . $name . '.wsdl' wsdl => 'file:///' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
) ); ) );
ok( ($soap->servicename('testService') eq 'testService' ) );
ok( ($soap->portname('testPort') eq 'testPort' ) );
ok( $soap->wsdlinit( url => $url ) ); ok $soap->wsdlinit( url => $url );
ok $soap->servicename('testService');
ok $soap->portname('testPort');
__END__ __END__
@@ -0,0 +1,20 @@
use Test::More tests => 4;
use strict;
use warnings;
use diagnostics;
use lib '../lib';
use Benchmark;
use_ok('SOAP::WSDL::XSD::Typelib::Builtin::string');
my $obj;
ok $obj = SOAP::WSDL::XSD::Typelib::Builtin::string->new(
{ value => '& "Aber" <test>'})
, "Object creation";
is $obj, '&amp; &qout;Aber&qout; &lt;test&gt;'
, 'escape text on serialization';
is $obj->serialize({ name => 'test'})
, '<test >&amp; &qout;Aber&qout; &lt;test&gt;</test >'
, 'Serialization with name';
-107
View File
@@ -1,107 +0,0 @@
#!/usr/bin/perl -w
#######################################################################################
#
# 2_helloworld.t
#
# Acceptance test for message encoding, based on .NET wsdl and example code.
# SOAP::WSDL's encoding doesn't I<exactly> match the .NET example, because
# .NET doesn't always specify types (SOAP::WSDL does), and the namespace
# prefixes chosen are different (maybe the encoding style, too ? this would be a bug !)
#
########################################################################################
use strict;
use diagnostics;
use Test;
plan tests => 5;
use Time::HiRes qw( gettimeofday tv_interval );
use lib '../..';
use Cwd;
use File::Basename;
use SOAP::WSDL;
ok 1; # if we made it this far, we're ok
### test vars END
print "Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n";
print "Acceptance test against sample output with simple WSDL\n";
my $data = {
name => 'test',
givenName => 'test',
};
my $t0 = [gettimeofday];
# chdir to my location
my $cwd = cwd;
my $path = dirname( $0 );
my $soap = undef;
my $name = basename( $0 );
$name =~s/\.(t|pl)$//;
chdir $path;
$path = cwd;
$path =~s{/attic}{}xms;
ok( $soap=SOAP::WSDL->new(
wsdl => 'file:///'.$path.'/acceptance/wsdl/11_helloworld.wsdl',
no_dispatch => 1
) );
$soap->serializer()->namespace('SOAP-ENV');
$soap->serializer()->encodingspace('SOAP-ENC');
print "Create SOAP::WSDL object (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
$soap->proxy('http://helloworld/helloworld.asmx');
$t0 = [gettimeofday];
ok($soap->wsdlinit());
print "WSDL init (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
$t0 = [gettimeofday];
do {
my $xml = $soap->call('sayHello', 'sayHello' => %{ $data });
open (FILE, "../acceptance/results/11_helloworld.xml")
|| open (FILE, "t/acceptance/results/11_helloworld.xml") || die "can't open acceptance file";
my $xml_test=<FILE>;
close FILE;
$xml=~s/^.+\<([^\/]+?)\:Body\>//;
$xml=~s/\<\/$1\:Body\>.*//;
$xml_test=~s/^.+\<([^\/]+?)\:Body\>//;
$xml_test=~s/\<\/$1\:Body\>.*//;
if ( ($xml) && ($xml eq $xml_test) ) {
ok 1;
print "Message encoding (" .tv_interval ( $t0, [gettimeofday]) ."s)\n"
} else {
ok 0;
print "Message encoding (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
print "$xml\n$xml_test\n"; };
};
$t0 = [gettimeofday];
do {
my $xml = $soap->call(sayHello => %{ $data });
open (FILE, "../acceptance/results/11_helloworld.xml")
|| open FILE, ("t/acceptance/results/11_helloworld.xml") || die "can't open acceptance file";
my $xml_test=<FILE>;
close FILE;
$xml=~s/^.+\<([^\/]+?)\:Body\>//;
$xml=~s/\<\/$1\:Body\>.*//;
$xml_test=~s/^.+\<([^\/]+?)\:Body\>//;
$xml_test=~s/\<\/$1\:Body\>.*//;
if ( ($xml) && ($xml eq $xml_test) ) {
ok 1;
print "Message encoding (" .tv_interval ( $t0, [gettimeofday]) ."s)\n";
} else {
ok 0;
print "Message encoding (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
print "$xml\n$xml_test\n"; };
};
chdir $cwd;
-29
View File
@@ -1,29 +0,0 @@
use Test::More;
eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD" if $@;
BEGIN
{
if (-d 't') # chdir into test directory if we
{ # are not there (make test)
chdir 't';
@dirs = '../blib/lib';
}
else
{
@dirs = ('../lib');
use lib '../lib'; # use our lib if we are in t/ (if we are, we're)
# not run from "make test" / "Build test"
}
}
@files = all_modules( @dirs );
plan tests => scalar @files;
foreach (@files)
{
s/^\.\.::blib::lib:://;
s/^\.\.::lib:://;
pod_coverage_ok( $_ );
}