Compare commits
2 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
a78d6d15b5 | ||
|
|
5c42b1d8f6 |
3
Build.PL
3
Build.PL
@@ -2,7 +2,7 @@ use Module::Build;
|
||||
Module::Build->new(
|
||||
dist_abstract => 'SOAP with WSDL support',
|
||||
dist_name => 'SOAP-WSDL',
|
||||
dist_version => '2.00_03',
|
||||
dist_version => '2.00_05',
|
||||
module_name => 'SOAP::WSDL',
|
||||
license => 'artistic',
|
||||
requires => {
|
||||
@@ -30,4 +30,5 @@ Module::Build->new(
|
||||
'XML::SAX::ParserFactory' => 0,
|
||||
|
||||
},
|
||||
recursive_test_files => 1,
|
||||
)->create_build_script;
|
||||
|
||||
38
MANIFEST
38
MANIFEST
@@ -123,25 +123,6 @@ t/acceptance/wsdl/contributed/ETest.wsdl
|
||||
t/acceptance/wsdl/contributed/OITest.wsdl
|
||||
t/acceptance/wsdl/contributed/tools.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/MyElement.pm
|
||||
t/lib/MySimpleType.pm
|
||||
@@ -149,3 +130,22 @@ t/lib/Test/SOAPMessage.pm
|
||||
t/lib/Typelib/Base.pm
|
||||
t/lib/Typelib/TEnqueueMessage.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
|
||||
|
||||
4
META.yml
4
META.yml
@@ -1,6 +1,6 @@
|
||||
---
|
||||
name: SOAP-WSDL
|
||||
version: 2.00_03
|
||||
version: 2.00_05
|
||||
author:
|
||||
abstract: SOAP with WSDL support
|
||||
license: artistic
|
||||
@@ -19,7 +19,7 @@ meta-spec:
|
||||
provides:
|
||||
SOAP::WSDL:
|
||||
file: lib/SOAP/WSDL.pm
|
||||
version: 2.00_03
|
||||
version: 2.00_05
|
||||
SOAP::WSDL::Base:
|
||||
file: lib/SOAP/WSDL/Base.pm
|
||||
SOAP::WSDL::Binding:
|
||||
|
||||
186
lib/SOAP/WSDL.pm
186
lib/SOAP/WSDL.pm
@@ -8,7 +8,7 @@ use SOAP::WSDL::SAX::WSDLHandler;
|
||||
use base qw(SOAP::Lite);
|
||||
use Data::Dumper;
|
||||
|
||||
our $VERSION='2.00_03';
|
||||
our $VERSION='2.00_05';
|
||||
|
||||
BEGIN {
|
||||
eval {
|
||||
@@ -231,7 +231,7 @@ sub call {
|
||||
if (blessed $data
|
||||
&& $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
|
||||
# workaround...
|
||||
@@ -263,13 +263,12 @@ sub call {
|
||||
};
|
||||
|
||||
|
||||
if ( $self->no_dispatch() )
|
||||
{
|
||||
return $envelope;
|
||||
} ## end if ( $self->no_dispatch...
|
||||
if ( $self->no_dispatch() ) {
|
||||
return $envelope;
|
||||
} ## end if ( $self->no_dispatch...
|
||||
|
||||
# get response via transport layer
|
||||
# TODO remove dependency from SOAP::Lite and use a
|
||||
# get response via transport layer
|
||||
# TODO remove dependency from SOAP::Lite and use a
|
||||
# SAX-based filter using XML::LibXML to get the
|
||||
# result.
|
||||
# Filter should have the following methods:
|
||||
@@ -279,14 +278,14 @@ sub call {
|
||||
# - fault: returns the result of the call if a SOAP fault is sent back
|
||||
# by the server. Retuns undef (nothing) if the call has been
|
||||
# processed without errors.
|
||||
my $response = $self->transport->send_receive(
|
||||
context => $self, # this is provided for context
|
||||
endpoint => $self->endpoint(),
|
||||
action => $methodInfo->{ soap_action }, # SOAPAction from binding
|
||||
envelope => $envelope, # use custom content
|
||||
);
|
||||
my $response = $self->transport->send_receive(
|
||||
context => $self, # this is provided for context
|
||||
endpoint => $self->endpoint(),
|
||||
action => $methodInfo->{ soap_action }, # SOAPAction from binding
|
||||
envelope => $envelope, # use custom content
|
||||
);
|
||||
|
||||
return $response if ($self->outputxml() );
|
||||
return $response if ($self->outputxml() );
|
||||
|
||||
if ($self->outputtree()) {
|
||||
|
||||
@@ -336,30 +335,28 @@ sub call {
|
||||
return $handler->get_data();
|
||||
}
|
||||
|
||||
# deserialize and store result
|
||||
my $result = $self->{ '_call' } =
|
||||
eval { $self->deserializer->deserialize( $response ) }
|
||||
if $response;
|
||||
# deserialize and store result
|
||||
my $result = $self->{ '_call' } =
|
||||
eval { $self->deserializer->deserialize( $response ) }
|
||||
if $response;
|
||||
|
||||
if (
|
||||
!$self->transport->is_success || # transport fault
|
||||
$@ || # not deserializible
|
||||
# fault message even if transport OK
|
||||
# or no transport error (for example, fo TCP, POP3, IO implementations)
|
||||
UNIVERSAL::isa( $result => 'SOAP::SOM' ) && $result->fault
|
||||
)
|
||||
{
|
||||
return $self->{ '_call' } = (
|
||||
$self->on_fault->(
|
||||
$self, $@ ? $@ . ( $response || '' ) : $result
|
||||
)
|
||||
|| $result
|
||||
);
|
||||
# ? # trick editors
|
||||
} ## end if ( !$self->transport...
|
||||
if (
|
||||
!$self->transport->is_success || # transport fault
|
||||
$@ || # not deserializible
|
||||
# fault message even if transport OK
|
||||
# or no transport error (for example, fo TCP, POP3, IO implementations)
|
||||
UNIVERSAL::isa( $result => 'SOAP::SOM' ) && $result->fault
|
||||
) {
|
||||
return $self->{ '_call' } = (
|
||||
$self->on_fault->( $self, ($@)
|
||||
? $@ . ( $response || '' )
|
||||
: $result
|
||||
) || $result
|
||||
);
|
||||
} ## end if ( !$self->transport...
|
||||
|
||||
return unless $response; # nothing to do for one-ways
|
||||
return $result;
|
||||
return unless $response; # nothing to do for one-ways
|
||||
return $result;
|
||||
} ## end sub call
|
||||
|
||||
sub explain {
|
||||
@@ -440,30 +437,114 @@ SOAP::Lite's transport mechanism.
|
||||
|
||||
=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
|
||||
|
||||
$soap->servicname('Name');
|
||||
$soap->servicename('Name');
|
||||
|
||||
Sets the service to operate on. If no service is set via servicename, the
|
||||
first service found is used.
|
||||
|
||||
Must be called after calling wsdlinit().
|
||||
|
||||
Returns the soap object, so you can chain calls like
|
||||
|
||||
$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
|
||||
|
||||
=over
|
||||
|
||||
=item DESCRIPTION
|
||||
|
||||
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>.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=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.
|
||||
|
||||
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
|
||||
|
||||
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.
|
||||
|
||||
=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
|
||||
|
||||
|
||||
@@ -1,11 +1,13 @@
|
||||
package SOAP::WSDL::Client;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Scalar::Util qw(blessed);
|
||||
use SOAP::WSDL::Envelope;
|
||||
use SOAP::Lite;
|
||||
use Class::Std::Storable;
|
||||
use SOAP::WSDL::SAX::MessageHandler;
|
||||
use SOAP::WSDL::SOAP::Typelib::Fault11;
|
||||
|
||||
# Package globals for speed...
|
||||
my $PARSER;
|
||||
@@ -101,11 +103,20 @@ sub call {
|
||||
# if we had no success (Transport layer error status code)
|
||||
# or if transport layer failed
|
||||
if (! $soap->transport->is_success() ) {
|
||||
|
||||
# TODO Fix deserializing message - there's something wrong with Fault11
|
||||
# Try deserializing response - there may be some
|
||||
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;
|
||||
# generate & return fault if we cannot serialize response
|
||||
|
||||
@@ -53,10 +53,130 @@ sub explain {
|
||||
sub to_typemap {
|
||||
my $self = shift;
|
||||
my $opt = shift;
|
||||
$opt->{ wsdl } ||= $self;
|
||||
$opt->{ prefix } ||= q{};
|
||||
$opt->{ wsdl } ||= $self;
|
||||
$opt->{ type_prefix } ||= $opt->{ prefix };
|
||||
$opt->{ element_prefix } ||= $opt->{ prefix };
|
||||
return join "\n",
|
||||
map { $_->to_typemap( $opt ) } @{ $service_of{ ident $self } };
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
|
||||
@@ -15,13 +15,13 @@ use base qw(
|
||||
my %faultcode_of :ATTR(:get<faultcode>);
|
||||
my %faultstring_of :ATTR(:get<faultstring>);
|
||||
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...
|
||||
sub as_bool :BOOLIFY { return; }
|
||||
|
||||
__PACKAGE__->_factory(
|
||||
[ qw(faultcode faultstring faultactor faultdetail) ],
|
||||
[ qw(faultcode faultstring faultactor detail) ],
|
||||
{
|
||||
faultcode => \%faultcode_of,
|
||||
faultstring => \%faultstring_of,
|
||||
@@ -44,4 +44,57 @@ __PACKAGE__->__set_minOccurs();
|
||||
__PACKAGE__->__set_maxOccurs();
|
||||
__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
|
||||
|
||||
@@ -153,6 +153,7 @@ sub to_typemap {
|
||||
|
||||
my $type;
|
||||
push @{ $opt->{path} }, $self->get_name();
|
||||
# referenced types need type_prefix
|
||||
if ( my $typename = $self->get_type() ) {
|
||||
my ($prefix, $localname) = split /:/, $self->get_type();
|
||||
my $ns = $nsmap{ $prefix };
|
||||
@@ -165,12 +166,18 @@ sub to_typemap {
|
||||
else
|
||||
{
|
||||
$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 .= q{'} . join( q{/}, @{ $opt->{path} } ) . "' => '$typeclass',\n";
|
||||
}
|
||||
# atomic types need element prefix
|
||||
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();
|
||||
if ( $flavor eq 'sequence' ) {
|
||||
$txt .= "# atomic simple type (sequence)\n";
|
||||
@@ -185,7 +192,7 @@ sub to_typemap {
|
||||
|
||||
}
|
||||
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";
|
||||
my $flavor = $type->get_flavor();
|
||||
if ( $flavor eq 'sequence' ) {
|
||||
@@ -223,6 +230,7 @@ use base qw(
|
||||
[% type.base_class($class_prefix) %]
|
||||
);
|
||||
[% ELSIF (type = self.first_complexType) %]
|
||||
# atomic complexType
|
||||
# <element name="[% self.get_name %]"><complexType> definition
|
||||
use SOAP::WSDL::XSD::Typelib::ComplexType;
|
||||
use base qw(
|
||||
@@ -250,7 +258,7 @@ __PACKAGE__->_factory(
|
||||
IF nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema' %]
|
||||
[% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% localname %]',
|
||||
[% ELSE %]
|
||||
[% element.get_name %] => '[% class_prefix %]::[% localname %]',
|
||||
[% element.get_name %] => '[% type_prefix %]::[% localname %]',
|
||||
[% END %]
|
||||
[% END %]
|
||||
}
|
||||
@@ -266,7 +274,7 @@ __PACKAGE__->_factory(
|
||||
[% IF (nsmap.$prefix == 'http://www.w3.org/2001/XMLSchema');
|
||||
base_class = 'SOAP::WSDL::XSD::Typelib::Builtin::' _ localname ;
|
||||
ELSE;
|
||||
base_class = class_prefix _ '::' _ localname;
|
||||
base_class = type_prefix _ '::' _ localname;
|
||||
-%]
|
||||
|
||||
use [% base_class %];
|
||||
@@ -298,6 +306,7 @@ EOT
|
||||
);
|
||||
my $code = $tt->process( \$template, {
|
||||
class_prefix => $opt->{ prefix },
|
||||
type_prefix => $opt->{ type_prefix },
|
||||
self => $self,
|
||||
nsmap => { reverse %{ $opt->{ wsdl }->get_xmlns() } },
|
||||
},
|
||||
|
||||
@@ -25,6 +25,8 @@ sub serialize {
|
||||
sub as_bool :BOOLIFY {
|
||||
return $value_of { ident $_[0] };
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :BOOLIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
|
||||
@@ -3,6 +3,8 @@ use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
|
||||
my %xmlns_of :ATTR(:name<xmlns> :default<()>);
|
||||
|
||||
# use $_[1] for performance
|
||||
sub start_tag {
|
||||
my $opt = $_[1] ||= {};
|
||||
@@ -20,6 +22,8 @@ sub end_tag {
|
||||
sub serialize_qualified :STRINGIFY {
|
||||
return $_[0]->serialize( { qualified => 1 } );
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :STRINGIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
|
||||
@@ -33,6 +33,8 @@ sub set_value {
|
||||
: 0;
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :BOOLIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
@@ -18,6 +18,7 @@ sub as_num :NUMERIFY :BOOLIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :NUMERIFY :BOOLIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
|
||||
@@ -8,6 +8,7 @@ sub as_num :NUMERIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :NUMERIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
|
||||
@@ -16,6 +16,8 @@ my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
|
||||
sub as_num :NUMERIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :NUMERIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
|
||||
@@ -7,6 +7,8 @@ use base qw(SOAP::WSDL::XSD::Typelib::Builtin::decimal);
|
||||
sub as_num :NUMERIFY {
|
||||
return $_[0]->get_value();
|
||||
}
|
||||
|
||||
Class::Std::initialize(); # make :NUMERIFY overloading serializable
|
||||
|
||||
1;
|
||||
|
||||
|
||||
@@ -2,6 +2,7 @@ package SOAP::WSDL::XSD::Typelib::Builtin::string;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Storable;
|
||||
# use HTML::Entities qw(encode_entities);
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
|
||||
|
||||
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 %enumeration_of :ATTR(:name<enumeration> :default<()>);
|
||||
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
|
||||
|
||||
my %char2entity = (
|
||||
q{&} => q{&},
|
||||
q{<} => q{<},
|
||||
q{>} => q{>},
|
||||
q{"} => q{&qout;},
|
||||
q{'} => q{'},
|
||||
);
|
||||
|
||||
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;
|
||||
|
||||
@@ -20,6 +46,11 @@ __END__
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::XSD::Typelib::Builtin::string - string objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
String objects. XML entities (&, E<lt> E<gt> " ') are encoded on
|
||||
serialization.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
|
||||
@@ -84,12 +84,18 @@ sub START {
|
||||
|
||||
# iterate over keys of arguments
|
||||
# and call set appropriate field in clase
|
||||
map { ($ATTRIBUTES_OF{ $class }->{ $_ }) ?
|
||||
do {
|
||||
map { ($ATTRIBUTES_OF{ $class }->{ $_ })
|
||||
? do {
|
||||
my $method = "set_$_";
|
||||
$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;
|
||||
};
|
||||
|
||||
@@ -114,24 +120,30 @@ sub _serialize {
|
||||
# get_elements is inlined for performance.
|
||||
return join q{} , map {
|
||||
my $element = $ATTRIBUTES_OF{ $class }->{ $_ }->{ $ident };
|
||||
$element = [ $element ]
|
||||
if not ref $element eq 'ARRAY';
|
||||
my $name = $_;
|
||||
|
||||
map {
|
||||
# serialize element elements with their own serializer
|
||||
# but name them like they're named here.
|
||||
if ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) {
|
||||
$_->serialize( { name => $_ } );
|
||||
}
|
||||
# serialize complextype elments (of other types) with their
|
||||
# serializer, but add element tags around.
|
||||
else {
|
||||
join q{}, $_->start_tag({ name => $name })
|
||||
, $_->serialize()
|
||||
, $_->end_tag({ name => $name });
|
||||
}
|
||||
} @{ $element }
|
||||
|
||||
if (defined $element) {
|
||||
$element = [ $element ]
|
||||
if not ref $element eq 'ARRAY';
|
||||
my $name = $_;
|
||||
|
||||
map {
|
||||
# serialize element elements with their own serializer
|
||||
# but name them like they're named here.
|
||||
if ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) {
|
||||
$_->serialize( { name => $_ } );
|
||||
}
|
||||
# serialize complextype elments (of other types) with their
|
||||
# serializer, but add element tags around.
|
||||
else {
|
||||
join q{}, $_->start_tag({ name => $name })
|
||||
, $_->serialize()
|
||||
, $_->end_tag({ name => $name });
|
||||
}
|
||||
} @{ $element }
|
||||
}
|
||||
else {
|
||||
q{};
|
||||
}
|
||||
} (@{ $ELEMENTS_FROM{ $class } });
|
||||
}
|
||||
|
||||
|
||||
@@ -56,5 +56,6 @@ sub get_class {
|
||||
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyType',
|
||||
);
|
||||
return $class_list{ $_[1] };
|
||||
}
|
||||
|
||||
|
||||
@@ -19,7 +19,7 @@ chdir $path;
|
||||
|
||||
$path = cwd;
|
||||
|
||||
$path =~s{/attic}{}xms;
|
||||
$path =~s{/SOAP/WSDL}{}xms;
|
||||
|
||||
#2
|
||||
ok( $soap = SOAP::WSDL->new(
|
||||
@@ -1,4 +1,4 @@
|
||||
use Test::More tests => 8;
|
||||
use Test::More tests => 7;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib '../lib';
|
||||
@@ -15,11 +15,11 @@ if ($@)
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
use_ok(qw/SOAP::WSDL/);
|
||||
|
||||
@@ -30,30 +30,27 @@ my $soap;
|
||||
|
||||
#2
|
||||
ok( $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file://' . $path . '/acceptance/wsdl/' . $name . '.wsdl',
|
||||
wsdl => 'file://' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl',
|
||||
readable =>1,
|
||||
), 'Instantiated object' );
|
||||
|
||||
|
||||
#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 ($xml = $soap->call('test',
|
||||
Test1 => 'Test 1',
|
||||
Test2 => 'Test 2',
|
||||
ok ($xml = $soap->call('test',
|
||||
testAll => {
|
||||
Test1 => 'Test 1',
|
||||
Test2 => [ 'Test 2', 'Test 3' ]
|
||||
}
|
||||
), 'Serialized complexType' );
|
||||
|
||||
|
||||
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);
|
||||
eval { soap_eq_or_diff( $xml, $testXML, 'Got expected result') };
|
||||
};
|
||||
# print $xml;
|
||||
|
||||
# $soap->wsdl_checkoccurs(1);
|
||||
|
||||
@@ -1,17 +1,15 @@
|
||||
BEGIN
|
||||
{
|
||||
chdir 't/' if (-d 't/');
|
||||
use Test::More tests => 7;;
|
||||
use lib '../lib';
|
||||
use lib 't/lib';
|
||||
use lib 'lib';
|
||||
use Cwd;
|
||||
use File::Basename;
|
||||
|
||||
our $SKIP;
|
||||
eval "use Test::SOAPMessage";
|
||||
if ($@)
|
||||
{
|
||||
BEGIN {
|
||||
use Test::More tests => 6;
|
||||
use lib '../lib';
|
||||
use lib 't/lib';
|
||||
use lib 'lib';
|
||||
use Cwd;
|
||||
use File::Basename;
|
||||
|
||||
our $SKIP;
|
||||
eval "use Test::SOAPMessage";
|
||||
if ($@)
|
||||
{
|
||||
$SKIP = "Test::Differences required for testing. $@";
|
||||
}
|
||||
}
|
||||
@@ -21,19 +19,20 @@ use_ok(qw/SOAP::WSDL/);
|
||||
my $xml;
|
||||
|
||||
my $path = cwd();
|
||||
my $name = $0;
|
||||
my $name = basename $0;
|
||||
$name =~s/\.t$//;
|
||||
|
||||
$path=~s{/attic}{}xms;
|
||||
$path=~s{(/t)?/SOAP/WSDL}{}xms;
|
||||
|
||||
#2
|
||||
ok( $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file://' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
|
||||
wsdl => 'file://' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
|
||||
), 'Instantiated object' );
|
||||
|
||||
#3
|
||||
ok( $soap->wsdlinit(
|
||||
checkoccurs => 1,
|
||||
servicename => 'testService',
|
||||
), 'parsed WSDL' );
|
||||
$soap->no_dispatch(1);
|
||||
$soap->serializer()->envprefix('SOAP-ENV');
|
||||
@@ -48,17 +47,6 @@ ok $xml = $soap->call('test',
|
||||
), 'Serialized complexType';
|
||||
|
||||
#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
|
||||
{
|
||||
$xml = $soap->serializer->method(
|
||||
@@ -73,7 +61,7 @@ ok( ($@),
|
||||
"Died on illegal number of elements"
|
||||
);
|
||||
|
||||
#7
|
||||
#6
|
||||
eval
|
||||
{
|
||||
$xml = $soap->serializer->method(
|
||||
@@ -1,40 +1,34 @@
|
||||
use Test::More;
|
||||
use Test::More tests => 6;
|
||||
use strict;
|
||||
use warnings;
|
||||
plan qw/no_plan/;
|
||||
use lib '../lib';
|
||||
use lib 't/lib';
|
||||
use lib 'lib';
|
||||
use Cwd;
|
||||
use File::Basename;
|
||||
|
||||
our $SKIP;
|
||||
eval "use Test::SOAPMessage";
|
||||
if ($@) {
|
||||
$SKIP = "Test::Differences required for testing.";
|
||||
}
|
||||
|
||||
|
||||
use_ok(qw/SOAP::WSDL/);
|
||||
|
||||
my $xml;
|
||||
|
||||
my $soap = undef;
|
||||
my $name = basename( $0 );
|
||||
my $name = basename $0;
|
||||
$name =~s/\.(t|pl)$//;
|
||||
|
||||
my $path = cwd;
|
||||
|
||||
$path =~s{/attic}{}xms;
|
||||
$path =~s{(/t)?/SOAP/WSDL}{}xms;
|
||||
|
||||
#2
|
||||
ok( $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
|
||||
wsdl => 'file:///' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
|
||||
), 'Instantiated object' );
|
||||
|
||||
#3
|
||||
$soap->readable(1);
|
||||
ok( $soap->wsdlinit(), 'parsed WSDL' );
|
||||
ok( $soap->wsdlinit(
|
||||
servicename => 'testService',
|
||||
), 'parsed WSDL' );
|
||||
$soap->no_dispatch(1);
|
||||
|
||||
ok ( $xml = $soap->call('test', testElement1 => 1 ) ,
|
||||
@@ -43,17 +37,6 @@ ok ( $xml = $soap->call('test', testElement1 => 1 ) ,
|
||||
# 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: {
|
||||
local $TODO="implement min/maxOccurs checks";
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
use Test::More tests => 7;;
|
||||
use Test::More tests => 6;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib '../lib';
|
||||
@@ -18,39 +18,27 @@ use_ok(qw/SOAP::WSDL/);
|
||||
my $soap;
|
||||
my $xml;
|
||||
my $path = cwd();
|
||||
my $name = $0;
|
||||
my $name = basename $0;
|
||||
$name =~s/\.t$//;
|
||||
|
||||
$path =~s{/attic}{}xsm;
|
||||
$path =~s{(/t)?/SOAP/WSDL}{}xsm;
|
||||
|
||||
#2
|
||||
ok( $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file://' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
|
||||
wsdl => 'file://' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
|
||||
), 'Instantiated object' );
|
||||
|
||||
#3
|
||||
$soap->readable(1);
|
||||
ok( $soap->wsdlinit(), 'parsed WSDL' );
|
||||
ok( $soap->wsdlinit(
|
||||
servicename => 'testService',
|
||||
), 'parsed WSDL' );
|
||||
$soap->no_dispatch(1);
|
||||
|
||||
ok ($xml = $soap->call('test',
|
||||
testElement1 => 'Test'
|
||||
), 'Serialized (simple) element' );
|
||||
|
||||
open (my $fh, $path . '/acceptance/results/' . $name . '.xml')
|
||||
|| die "Cannot open acceptance results file";
|
||||
my $testXML = <$fh>;
|
||||
close $fh;
|
||||
|
||||
SKIP: {
|
||||
if ($SKIP){
|
||||
print $xml;
|
||||
skip( $SKIP, 1 );
|
||||
}
|
||||
|
||||
soap_eq_or_diff( $xml, $testXML, 'Got expected result');
|
||||
};
|
||||
|
||||
TODO: {
|
||||
local $TODO="implement min/maxOccurs checks";
|
||||
|
||||
@@ -15,24 +15,24 @@ my $name = basename( $0 );
|
||||
$name =~s/\.(t|pl)$//;
|
||||
|
||||
my $path = cwd;
|
||||
$path =~s{/attic}{}xms;
|
||||
$path =~s{(/t)/SOAP/WSDL}{}xms;
|
||||
|
||||
#2
|
||||
ok( $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
|
||||
wsdl => 'file:///' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
|
||||
), 'Instantiated object' );
|
||||
|
||||
$soap->readable(1);
|
||||
|
||||
#3
|
||||
ok( $soap->wsdlinit(), 'parsed WSDL' );
|
||||
ok( $soap->wsdlinit(
|
||||
servicename => 'testService',
|
||||
), 'parsed WSDL' );
|
||||
$soap->no_dispatch(1);
|
||||
|
||||
#4
|
||||
ok $xml = $soap->call('test', testAll => [ 1, 2 ] ), 'Serialize list call';
|
||||
|
||||
print $xml, "\n";
|
||||
|
||||
#5
|
||||
ok ( $xml2 = $soap->call('test', testAll => "1 2" ) , 'Serialized scalar call' );
|
||||
#6
|
||||
@@ -12,21 +12,23 @@ use_ok(qw/SOAP::WSDL/);
|
||||
|
||||
my $xml;
|
||||
|
||||
my $name = basename( $0 );
|
||||
my $name = basename $0;
|
||||
$name =~s/\.(t|pl)$//;
|
||||
|
||||
my $path = cwd;
|
||||
$path =~s{/attic}{}xms;
|
||||
$path =~s{(/t)/SOAP/WSDL}{}xms;
|
||||
|
||||
my $soap;
|
||||
#2
|
||||
ok( $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
|
||||
wsdl => 'file:///' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
|
||||
), 'Instantiated object' );
|
||||
|
||||
#3
|
||||
$soap->readable(1);
|
||||
ok( $soap->wsdlinit(), 'parsed WSDL' );
|
||||
ok( $soap->wsdlinit(
|
||||
servicename => 'testService',
|
||||
), 'parsed WSDL' );
|
||||
$soap->no_dispatch(1);
|
||||
$soap->autotype(0);
|
||||
|
||||
@@ -15,11 +15,11 @@ $name =~s/\.(t|pl)$//;
|
||||
|
||||
my $path = cwd;
|
||||
|
||||
$path =~s{/attic}{}xms;
|
||||
$path =~s{(/t)?/SOAP/WSDL}{}xms;
|
||||
|
||||
#2
|
||||
ok $soap = SOAP::WSDL->new(
|
||||
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
|
||||
wsdl => 'file:///' . $path . '/t/acceptance/wsdl/' . $name . '.wsdl'
|
||||
), 'Instantiated object';
|
||||
|
||||
#3
|
||||
@@ -30,18 +30,6 @@ $soap->no_dispatch(1);
|
||||
#4
|
||||
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
|
||||
eval {
|
||||
$xml = $soap->serializer->method(
|
||||
@@ -1,6 +1,6 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use Test::More tests=> 6;
|
||||
use Test::More tests=> 5;
|
||||
use Time::HiRes qw( gettimeofday tv_interval );
|
||||
use lib '../..';
|
||||
use Data::Dumper;
|
||||
@@ -9,24 +9,22 @@ use File::Basename;
|
||||
use_ok qw/ SOAP::WSDL /;
|
||||
use Benchmark;
|
||||
|
||||
# print "Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n";
|
||||
# print "Performance test with simple WSDL file\n";
|
||||
|
||||
print "# Testing SOAP::WSDL ". $SOAP::WSDL::VERSION."\n";
|
||||
print "# Performance test with simple WSDL file\n";
|
||||
my $soap;
|
||||
my $data = {
|
||||
sayHello => {
|
||||
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 );
|
||||
$name =~s/\.(t|pl)$//;
|
||||
chdir $path;
|
||||
|
||||
$path = cwd;
|
||||
my $path = cwd;
|
||||
|
||||
$path=~s{(/t)?/SOAP/WSDL}{}xms;
|
||||
|
||||
my $cacheDir;
|
||||
if ($^O =~ m/Win/)
|
||||
@@ -42,7 +40,7 @@ else
|
||||
my $t0 = [gettimeofday];
|
||||
ok(
|
||||
$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
|
||||
),
|
||||
"Create SOAP::WSDL object (".tv_interval ( $t0, [gettimeofday]) ."ms)" );
|
||||
@@ -51,8 +49,10 @@ $soap->proxy('http://helloworld/helloworld.asmx');
|
||||
|
||||
$t0 = [gettimeofday];
|
||||
eval{
|
||||
$soap->wsdlinit(caching => 1,
|
||||
cache_directory => $cacheDir ) };
|
||||
$soap->wsdlinit(
|
||||
caching => 1,
|
||||
cache_directory => $cacheDir,
|
||||
servicename => 'Service1' ) };
|
||||
|
||||
unless ($@) {
|
||||
pass("wsdl file init (".tv_interval ( $t0, [gettimeofday]) ."s)");
|
||||
@@ -69,7 +69,7 @@ $t0 = [gettimeofday];
|
||||
ok($soap->call(sayHello => %{ $data }),
|
||||
"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__
|
||||
|
||||
56
t/SOAP/WSDL/11_helloworld.NET.t
Normal file
56
t/SOAP/WSDL/11_helloworld.NET.t
Normal 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 Test;
|
||||
use Test::More tests => 4;
|
||||
use SOAP::WSDL;
|
||||
use Cwd;
|
||||
use Data::Dumper;
|
||||
|
||||
plan tests => 9;
|
||||
use File::Basename;
|
||||
|
||||
print "# Using SOAP::WSDL Version $SOAP::WSDL::VERSION\n";
|
||||
|
||||
my $name = '02_port';
|
||||
|
||||
# chdir to my location
|
||||
my $cwd = cwd;
|
||||
my $soap = undef;
|
||||
|
||||
my $path = cwd;
|
||||
|
||||
if (-d 't')
|
||||
{
|
||||
$cwd .= '/t';
|
||||
}
|
||||
|
||||
$path =~s{(/t)?/SOAP/WSDL}{}xms;
|
||||
|
||||
my $url = 'http://127.0.0.1/testPort';
|
||||
|
||||
|
||||
ok(1);
|
||||
|
||||
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__
|
||||
20
t/SOAP/WSDL/XSD/Typelib/Builtin/001_string.t
Normal file
20
t/SOAP/WSDL/XSD/Typelib/Builtin/001_string.t
Normal file
@@ -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, '& &qout;Aber&qout; <test>'
|
||||
, 'escape text on serialization';
|
||||
|
||||
is $obj->serialize({ name => 'test'})
|
||||
, '<test >& &qout;Aber&qout; <test></test >'
|
||||
, 'Serialization with name';
|
||||
@@ -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;
|
||||
@@ -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( $_ );
|
||||
}
|
||||
Reference in New Issue
Block a user