Compare commits

..

1 Commits

Author SHA1 Message Date
Martin Kutter
21b5330a8d import SOAP-WSDL 2.00_03 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_03
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_03.tar.gz
2009-12-12 19:47:42 -08:00
98 changed files with 3231 additions and 3156 deletions

View File

@@ -2,7 +2,7 @@ use Module::Build;
Module::Build->new(
dist_abstract => 'SOAP with WSDL support',
dist_name => 'SOAP-WSDL',
dist_version => '2.00_02',
dist_version => '2.00_03',
module_name => 'SOAP::WSDL',
license => 'artistic',
requires => {
@@ -14,7 +14,9 @@ Module::Build->new(
'XML::SAX::Base' => 0,
'XML::SAX::ParserFactory' => 0,
},
buildrequires => {
buildrequires => {
'Benchmark' => 0,
'Cwd' => 0,
'Test::More' => 0,
'SOAP::Lite' => 0,
'Class::Std' => 0.0.8,
@@ -24,5 +26,8 @@ Module::Build->new(
'XML::LibXML' => 0,
'XML::SAX::Base' => 0,
'XML::SAX::ParserFactory' => 0,
'Pod::Simple::Text' => 0,
'XML::SAX::ParserFactory' => 0,
},
)->create_build_script;

View File

@@ -28,6 +28,52 @@ lib/SOAP/WSDL/XSD/Schema.pm
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
lib/SOAP/WSDL/XSD/SimpleType.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
lib/SOAP/WSDL/XSD/Typelib/Element.pm
lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm
@@ -50,6 +96,8 @@ t/013_complexType.t
t/014_sax_typelib.t
t/015_to_typemap.t
t/016_client_object.t
t/020_storable.t
t/098_pod.t
t/acceptance/results/03_complexType-all.xml
t/acceptance/results/03_complexType-sequence.xml
t/acceptance/results/04_element-simpleType.xml

101
META.yml
View File

@@ -1,8 +1,7 @@
---
name: SOAP-WSDL
version: 2.00_02
version: 2.00_03
author:
- "Replace the whitespace in the e-mail adresses by '@'."
abstract: SOAP with WSDL support
license: artistic
requires:
@@ -20,7 +19,7 @@ meta-spec:
provides:
SOAP::WSDL:
file: lib/SOAP/WSDL.pm
version: 1.21
version: 2.00_03
SOAP::WSDL::Base:
file: lib/SOAP/WSDL/Base.pm
SOAP::WSDL::Binding:
@@ -75,97 +74,97 @@ provides:
SOAP::WSDL::XSD::Typelib::Builtin:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
SOAP::WSDL::XSD::Typelib::Builtin::ENTITY:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
SOAP::WSDL::XSD::Typelib::Builtin::ID:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/ID.pm
SOAP::WSDL::XSD::Typelib::Builtin::IDREF:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREF.pm
SOAP::WSDL::XSD::Typelib::Builtin::IDREFS:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/IDREFS.pm
SOAP::WSDL::XSD::Typelib::Builtin::NCName:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm
SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm
SOAP::WSDL::XSD::Typelib::Builtin::NMTOKENS:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm
SOAP::WSDL::XSD::Typelib::Builtin::NOTATION:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm
SOAP::WSDL::XSD::Typelib::Builtin::Name:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm
SOAP::WSDL::XSD::Typelib::Builtin::QName:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm
SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm
SOAP::WSDL::XSD::Typelib::Builtin::anyType:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm
SOAP::WSDL::XSD::Typelib::Builtin::anyURI:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm
SOAP::WSDL::XSD::Typelib::Builtin::base64Binary:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
SOAP::WSDL::XSD::Typelib::Builtin::boolean:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
SOAP::WSDL::XSD::Typelib::Builtin::byte:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
SOAP::WSDL::XSD::Typelib::Builtin::date:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm
SOAP::WSDL::XSD::Typelib::Builtin::dateTime:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm
SOAP::WSDL::XSD::Typelib::Builtin::decimal:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm
SOAP::WSDL::XSD::Typelib::Builtin::double:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm
SOAP::WSDL::XSD::Typelib::Builtin::duration:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm
SOAP::WSDL::XSD::Typelib::Builtin::float:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm
SOAP::WSDL::XSD::Typelib::Builtin::gDay:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm
SOAP::WSDL::XSD::Typelib::Builtin::gMonth:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm
SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm
SOAP::WSDL::XSD::Typelib::Builtin::gYear:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm
SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
SOAP::WSDL::XSD::Typelib::Builtin::hex64Binary:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm
SOAP::WSDL::XSD::Typelib::Builtin::hexBinary:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm
SOAP::WSDL::XSD::Typelib::Builtin::int:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm
SOAP::WSDL::XSD::Typelib::Builtin::integer:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm
SOAP::WSDL::XSD::Typelib::Builtin::language:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm
SOAP::WSDL::XSD::Typelib::Builtin::list:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm
SOAP::WSDL::XSD::Typelib::Builtin::long:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm
SOAP::WSDL::XSD::Typelib::Builtin::negativeInteger:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm
SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm
SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm
SOAP::WSDL::XSD::Typelib::Builtin::normalizedString:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm
SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
SOAP::WSDL::XSD::Typelib::Builtin::qName:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm
SOAP::WSDL::XSD::Typelib::Builtin::short:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm
SOAP::WSDL::XSD::Typelib::Builtin::string:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
SOAP::WSDL::XSD::Typelib::Builtin::time:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
SOAP::WSDL::XSD::Typelib::Builtin::token:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm
SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm
SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm
SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort:
file: lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
file: lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
SOAP::WSDL::XSD::Typelib::ComplexType:
file: lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
SOAP::WSDL::XSD::Typelib::Element:

File diff suppressed because it is too large Load Diff

View File

@@ -61,7 +61,8 @@ EOT
$input ? $input->explain($opt) : q{};
};
$txt .= <<"EOT";
$txt .= <<"EOT";
=over
=item * $operation_name

View File

@@ -1,276 +1,77 @@
package SOAP::WSDL::Client;
use strict;
use warnings;
use vars qw/$AUTOLOAD/;
use Scalar::Util qw(blessed);
use SOAP::WSDL::Envelope;
use SOAP::WSDL::SAX::WSDLHandler;
use SOAP::Lite;
use Class::Std::Storable;
use SOAP::WSDL::SAX::MessageHandler;
# Package globals for speed...
my $PARSER;
my $MESSAGE_HANDLER;
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
my %no_dispatch_of :ATTR(:name<no_dispatch> :default<()>);
my %outputxml_of :ATTR(:name<outputxml> :default<()>);
my %proxy_of :ATTR(:name<proxy> :default<()>);
# TODO remove when preparing 2.01
sub outputtree { warn 'outputtree is deprecated and'
. 'will be removed before reaching v2.01 !' }
SUBFACTORY: {
no strict qw(refs);
for (qw(class_resolver no_dispatch outputxml proxy)) {
my $setter = "set_$_";
my $getter = "get_$_";
*{ $_ } = sub { my $self = shift;
if (@_) {
$self->$setter(@_);
return $self;
}
return $self->$getter()
};
}
}
BEGIN {
eval {
use XML::LibXML;
eval {
require XML::LibXML;
$PARSER = XML::LibXML->new();
$MESSAGE_HANDLER = SOAP::WSDL::SAX::MessageHandler->new();
$PARSER->set_handler( $MESSAGE_HANDLER );
};
if ($@) {
use XML::SAX::ParserFactory;
require XML::SAX::ParserFactory;
$MESSAGE_HANDLER = SOAP::WSDL::SAX::MessageHandler->new({
base => 'XML::SAX::Base' });
$PARSER = XML::SAX::ParserFactory->parser(
handler => $MESSAGE_HANDLER );
}
}
use base qw/SOAP::Lite/;
sub outputtree {
my $self = shift;
return $self->{ _WSDL }->{ outputtree } if not @_;
return $self->{ _WSDL }->{ outputtree } = shift;
}
sub class_resolver {
my $self = shift;
return $self->{ _WSDL }->{ class_resolver } if not @_;
return $self->{ _WSDL }->{ class_resolver } = shift;
}
sub wsdlinit
{
my $self = shift;
my $wsdl_xml = SOAP::Schema->new( schema_url => $self->wsdl() )->access(
$self->wsdl()
);
my $filter;
my $parser = eval { XML::LibXML->new() };
if ($parser) {
$filter = SOAP::WSDL::SAX::WSDLHandler->new();
$parser->set_handler( $filter );
}
else {
$filter = SOAP::WSDL::SAX::WSDLHandler->new( base => 'XML::SAX::Base' );
$parser = XML::SAX::ParserFactory->parser( Handler => $filter );
}
$parser->parse_string( $wsdl_xml );
my $wsdl_definitions = $filter->get_data()
or die "unable to parse WSDL";
my $types = $wsdl_definitions->first_types()
or die "unable to extract schema from WSDL";
my $ns = $wsdl_definitions->get_xmlns()
or die "unable to extract XML Namespaces" . $wsdl_definitions->to_string;
( %{ $ns } ) or die "unable to extract XML Namespaces";
# setup lookup variables
$self->{ _WSDL }->{ wsdl_definitions } = $wsdl_definitions;
$self->{ _WSDL }->{ serialize_options } = {
autotype => 0,
readable => 1,
typelib => $types,
namespace => $ns,
};
$self->{ _WSDL }->{ explain_options } = {
readable => 1,
wsdl => $wsdl_definitions,
namespace => $ns,
typelib => $types,
};
return $self;
} ## end sub wsdlinit
sub _wsdl_get_service
{
my $self = shift;
my $service;
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
my $ns = $wsdl->get_targetNamespace();
if ( $self->{ _WSDL }->{ servicename } )
{
$service =
$wsdl->find_service( $ns, $self->{ _WSDL }->{ servicename } );
}
else
{
$service = $wsdl->get_service()->[ 0 ];
warn "no servicename specified - using " . $service->get_name();
}
return $self->{ _WSDL }->{ service } = $service;
} ## end sub _wsdl_get_service
sub _wsdl_get_port
{
my $self = shift;
my $service = $self->{ _WSDL }->{ service }
|| $self->_wsdl_get_service();
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
my $ns = $wsdl->get_targetNamespace();
my $port;
if ( $self->{ _WSDL }->{ portname } )
{
$port = $service->get_port( $ns, $self->{ _WSDL }->{ portname } );
}
else
{
$port = $service->get_port()->[ 0 ];
}
$self->{ _WSDL }->{ port } = $port;
# preload portType
$self->_wsdl_get_portType();
# Auto-set proxy - required before issuing call()
$self->proxy( $port->get_location() );
return $port;
} ## end sub _wsdl_get_port
sub _wsdl_get_binding
{
my $self = shift;
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
my $ns = $wsdl->get_targetNamespace();
my $port = $self->{ _WSDL }->{ port }
|| $self->_wsdl_get_port();
my ( $prefix, $localname ) = split /:/, $port->get_binding();
# TODO lookup $ns instead of just using
# the top element's targetns...
my $binding = $wsdl->find_binding( $ns, $localname )
or die "no binding found for ", $port->get_binding();
return $self->{ _WSDL }->{ binding } = $binding;
} ## end sub _wsdl_get_binding
sub _wsdl_get_portType
{
my $self = shift;
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
my $binding = $self->{ _WSDL }->{ binding }
|| $self->_wsdl_get_binding();
my $ns = $wsdl->get_targetNamespace();
my ( $prefix, $localname ) = split /:/, $binding->get_type();
my $portType = $wsdl->find_portType( $ns, $localname );
$self->{ _WSDL }->{ portType } = $portType;
return $portType;
} ## end sub _wsdl_get_portType
=pod
=head2 _wsdl_init_methods
=over
=item DESCRIPTION
Creates a lookup table containing the information required for all methods
specified for the service/port selected.
The lookup table is used by L<call|call>.
=back
=cut
sub _wsdl_init_methods {
my $self = shift;
my $wsdl = $self->{ _WSDL }->{ wsdl_definitions };
my $ns = $wsdl->get_targetNamespace();
# get bindings, portType, message, part(s)
# - use cached values where possible for speed,
# private methods if not for clear separation...
my $binding = $self->{ _WSDL }->{ binding }
|| $self->_wsdl_get_binding();
my $portType = $self->{ _WSDL }->{ portType }
|| $self->_wsdl_get_portType();
my $methodHashRef = {};
foreach my $binding_operation (@{ $binding->get_operation() })
{
my $method = {};
# get SOAP Action
# SOAP-Action is a required HTTP Header, so we need to look it up...
my $soap_binding_operation = $binding_operation->get_operation()->[0];
$method->{ soap_action } = $soap_binding_operation ?
$soap_binding_operation->get_soapAction() : $method;
# get parts
# 1. get operation from port
my $operation = $portType->find_operation( $ns,
$binding_operation->get_name() );
# 2. get input message name
my ( $prefix, $localname ) = split /:/,
$operation->get_input()->[0]->get_message();
# 3. get input message
my $message = $wsdl->find_message( $ns, $localname );
$method->{ parts } = $message->get_part();
# rpc / encoded methods may have a namespace specified.
# look it up and set it...
$method->{ namespace } = $binding_operation ?
$binding_operation->get_input()->[0]->get_namespace() : undef;
$methodHashRef->{ $binding_operation->get_name() } = $method;
}
$self->{ _WSDL }->{ methodInfo } = $methodHashRef;
return $methodHashRef;
}
sub call {
my $self = shift;
my $method = shift;
my $data = ref $_[0] ? $_[0] : { @_ };
my $data = ref $_[0] ? $_[0] : { @_ };
my $content = q{};
my $envelope;
my $methodInfo;
if (blessed $data
my ($envelope, $soap_action);
if (blessed $data
&& $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
{
$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...
$methodInfo->{ soap_action }
= join '/', $data->get_xmlns(), $method;
}
else {
my $methodLookup = $self->{ _WSDL }->{ methodInfo }
|| $self->_wsdl_init_methods();
$soap_action = join '/', $data->get_xmlns(), $method;
$methodInfo = $methodLookup->{ $method };
my $partListRef = $methodInfo->{ parts };
}
# set serializer options
# TODO allow custom options here
my $opt = $self->{ _WSDL }->{ serialize_options };
return $envelope if $self->no_dispatch();
# set response target namespace
# TODO make rpc-encoded encoding recognise this namespace
# $opt->{ targetNamespace } = $soap_binding_operation ?
# $operation->input()->namespace() : undef;
# serialize content
# TODO create surrounding element for rpc-encoded messages
foreach my $part ( @{ $partListRef } )
{
$content .= $part->serialize( $method, $data, $opt );
}
$envelope = SOAP::WSDL::Envelope->serialize(
$method, $content , $opt );
};
if ( $self->no_dispatch() )
{
return $envelope;
} ## end if ( $self->no_dispatch...
# warn $envelope;
# get response via transport layer
# TODO remove dependency from SOAP::Lite and use a
@@ -283,146 +84,114 @@ 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(
my $soap = SOAP::Lite->new()->proxy( $self->get_proxy() );
my $response = $soap->transport->send_receive(
context => $self, # this is provided for context
endpoint => $self->endpoint(),
action => $methodInfo->{ soap_action }, # SOAPAction from binding
endpoint => $soap->endpoint(),
action => $soap_action, # SOAPAction, should be from binding
envelope => $envelope, # use custom content
);
# warn 'Received ' . length($response) . ' bytes of content';
return $response if ($self->outputxml() );
if ($self->outputtree()) {
$MESSAGE_HANDLER->set_class_resolver( $self->get_class_resolver() );
my ($parser, $handler); # replace by globals - singleton is faster
if (not $parser) {
require SOAP::WSDL::SOAP::Typelib::Fault11;
require SOAP::WSDL::SAX::MessageHandler;
require XML::LibXML;
$handler = SOAP::WSDL::SAX::MessageHandler->new(
{ class_resolver => $self->class_resolver() },
);
$parser = XML::LibXML->new();
$parser->set_handler( $handler);
}
# if we had no success (Transport layer error status code)
# or if transport layer failed
if (! $soap->transport->is_success() ) {
# Try deserializing response - there may be some
if ($response) {
eval { $PARSER->parse_string( $response ) };
return $MESSAGE_HANDLER->get_data if not $@;
};
# if we had no success (Transport layer error status code)
# or if transport layer failed
if (! $self->transport->is_success() ) {
# Try deserializing response - there may be some
if ($response) {
eval { $parser->parse_string( $response ) };
return $handler->get_data if not $@;
};
require SOAP::WSDL::SOAP::Typelib::Fault11;
# generate & return fault if we cannot serialize response
# or have none...
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
faultcode => 'soap:Server',
faultactor => 'urn:localhost',
faultstring => 'Error sending / receiving message: '
. $soap->transport->message()
});
}
eval { $PARSER->parse_string( $response ) };
# generate & return fault if we cannot serialize response
# or have none...
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
faultcode => 'soap:Server',
faultactor => 'urn:localhost',
faultstring => 'Error sending / receiving message: '
. $self->transport->message()
});
}
eval { $parser->parse_string( $response ) };
# return fault if we cannot deserialize response
if ($@) {
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
faultcode => 'soap:Server',
faultactor => 'urn:localhost',
faultstring => "Error deserializing message: $@. \n"
. "Message was: \n$response"
});
}
return $handler->get_data();
# return fault if we cannot deserialize response
if ($@) {
return SOAP::WSDL::SOAP::Typelib::Fault11->new({
faultcode => 'soap:Server',
faultactor => 'urn:localhost',
faultstring => "Error deserializing message: $@. \n"
. "Message was: \n$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...
return unless $response; # nothing to do for one-ways
return $result;
return $MESSAGE_HANDLER->get_data();
} ## end sub call
sub explain
{
my $self = shift;
my $opt = $self->{ _WSDL }->{ explain_options };
return $self->{ _WSDL }->{ wsdl_definitions }->explain( $opt );
} ## end sub explain
sub _load_method
{
my $method = shift;
no strict "refs";
*$method = sub {
my $self = shift;
return ( @_ ) ? $self->{ _WSDL }->{ $method } = shift
: $self->{ _WSDL }->{ $method }
};
} ## end sub _load_method
&_load_method( 'no_dispatch' );
&_load_method( 'wsdl' );
sub servicename
{
my $self = shift;
return $self->{ _WSDL }->{ servicename } if ( not @_ );
$self->{ _WSDL }->{ servicename } = shift;
my $ns = $self->{ _WSDL }->{ wsdl_definitions }->get_targetNamespace();
$self->{ _WSDL }->{ service } =
$self->{ _WSDL }->{ wsdl_definitions }
->find_service( $ns, $self->{ _WSDL }->{ servicename } )
or die "No such service: " . $self->{ _WSDL }->{ servicename };
} ## end sub servicename
sub portname
{
my $self = shift;
return $self->{ _WSDL }->{ portname } if ( not @_ );
$self->{ _WSDL }->{ portname } = shift;
my $ns = $self->{ _WSDL }->{ wsdl_definitions }->targetNamespace();
$self->{ _WSDL }->{ port } =
$self->{ _WSDL }->{ service }
->get_port( $ns, $self->{ _WSDL }->{ portname } )
or die "No such port: " . $self->{ _WSDL }->{ portname };
} ## end sub portname
1;
=pod
=head1 Auto-Dispatching
=head2 Features different from SOAP::Lite
SOAP::WSDL does not aim to be a complete replacement for SOAP::Lite - the
SOAP::Lite module has it's strengths and weaknesses and SOAP::WSDL is
designed as a cure for the weakness of little WSDL support - nothing more,
nothing less.
Nonetheless SOAP::WSDL mimics part of SOAP::Lite's API and behaviour,
so SOAP::Lite users can switch without looking up every method call in the
documentation.
A few things are quite differentl from SOAP::Lite, though:
=head3 SOAP request data
SOAP request data may either be given as message object, or as hash ref (in
which case it will automatically be encoded into a message object).
=head3 Return values
The result from call() is not a SOAP::SOM object, but a message object.
Message objects' classes may be generated from WSDL definitions automatically
- see SOAP::WSDL::Generator::Typelib on how to generate your own WSDL based
message class library.
=head3 Fault handling
SOAP::WSDL::Client returns a fault object on errors, even on transport layer
errors.
The fault object is a SOAP1.1 fault object of the following
C<SOAP::WSDL::SOAP::Typelib::Fault11>.
SOAP::WSDL::SOAP::Typelib::Fault11 objects are false in boolean context, so
you can just do something like
my $result = $soap->call($method, $data);
if ($result) {
# handle result
}
else {
die $result->faultstring();
}
=head3 outputxml
SOAP::Lite returns only the content of the SOAP body when outputxml is set
to true. SOAP::WSDL::Client returns the complete XML response.
=head3 Auto-Dispatching
SOAP::WSDL::Client does B<does not> support auto-dispatching.
This is on purpose: You may easily create interface classes by using
This is on purpose: You may easily create interface classes by using
SOAP::WSDL::Client and implementing something like
sub mySoapMethod {
@@ -430,17 +199,9 @@ SOAP::WSDL::Client and implementing something like
$soap_wsdl_client->call( mySoapMethod, @_);
}
You may even do this in a class factory - SOAP::WSDL provides the methods
You may even do this in a class factory - SOAP::WSDL provides the methods
for generating such interfaces.
SOAP::Lite's autodispatching mechanism is - though convenient - a constant
source of errors: Every typo in a method name gets caught by AUTOLOAD and
may lead to unpredictable results.
=cut
sub AUTOLOAD
{
my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
die "$method not found";
}

View File

@@ -10,33 +10,33 @@ my %type_of :ATTR(:name<type> :default<()>);
sub serialize
{
my $self = shift;
my $name = shift;
my $data = shift;
my $opt = shift;
my $typelib = $opt->{ typelib } || die "No typelib";
my %ns_map = reverse %{ $opt->{ namespace } };
my $self = shift;
my $name = shift;
my $data = shift;
my $opt = shift;
my $typelib = $opt->{ typelib } || die "No typelib";
my %ns_map = reverse %{ $opt->{ namespace } };
my $item_name;
if ($item_name = $self->get_type() )
{
# resolve type
my ($prefix, $localname) = split /:/ , $item_name, 2;
my $type = $typelib->find_type(
$ns_map{ $prefix },
$localname
);
return $type->serialize( $self->get_name(), $data, $opt );
}
elsif ( $item_name = $self->get_element() )
{
if ($item_name = $self->get_type() ) {
# resolve type
my ($prefix, $localname) = split /:/ , $item_name, 2;
my $type = $typelib->find_type( $ns_map{ $prefix }, $localname )
or die "type $item_name , $ns_map{ $prefix } not found";
my $name = $self->get_name();
return $type->serialize( $name, $data->{ $name }, $opt );
}
elsif ( $item_name = $self->get_element() ) {
my ($prefix, $localname) = split /:/ , $item_name, 2;
my $element = $typelib->find_element(
$ns_map{ $prefix },
$localname
);
return $element->serialize( undef, $data, $opt );
}
my $element = $typelib->find_element(
$ns_map{ $prefix },
$localname
)
or die "element $item_name , $ns_map{ $prefix } not found";
$opt->{ qualify } = 1;
return $element->serialize( undef, $data->{ $element->get_name() }, $opt );
}
die "Neither type nor element - don't know what to do";
}

View File

@@ -7,7 +7,7 @@ use Class::Std::Storable;
use SOAP::WSDL::XSD::Typelib::Builtin;
my %characters_of :ATTR(:default<()>);
my %class_resolver_of :ATTR(:default<()> :init_attr<class_resolver>);
my %class_resolver_of :ATTR(:default<()> :name<class_resolver>);
my %current_of :ATTR(:default<()>);
my %ignore_of :ATTR(:default<()>);
my %list_of :ATTR(:default<()>);
@@ -70,7 +70,7 @@ my %data_of :ATTR(:default<()>);
}
$class_resolver_of{ ident $self } = $args->{ class_resolver }
or die "cannot parse message without type resolver";
if $args->{ class_resolver };
return bless $self, $class;
}
@@ -83,17 +83,16 @@ sub start_document {
$namespace_of{ $ident } = {};
$ignore_of{ $ident } = [ qw(Envelope Body) ]; # SOAP elements
$path_of{ $ident } = [];
$data_of{ $ident } = undef;
$data_of{ $ident } = undef;
}
sub start_element {
# use $_[n] for performance
my ($ident, $element) = (ident $_[0], $_[1]);
my $local_name = $element->{ LocalName };
# ignore top level elements
if (@{ $ignore_of{ $ident } }
&& $local_name eq $ignore_of{ $ident }->[0]) {
&& $element->{ LocalName } eq $ignore_of{ $ident }->[0]) {
shift @{ $ignore_of{ $ident } };
return;
}
@@ -101,7 +100,7 @@ sub start_element {
# empty characters
$characters_of{ $ident } = q{};
push @{ $path_of{ $ident } }, $local_name; # step down...
push @{ $path_of{ $ident } }, $element->{ LocalName }; # step down...
push @{ $list_of{ $ident } }, $current_of{ $ident }; # remember current
# resolve class of this element
@@ -111,26 +110,26 @@ sub start_element {
. " via "
. $class_resolver_of{ $ident };
# Check whether we have a primitive - we implement them as classes
# TODO replace with UNIVERSAL->isa() or maybe index - could be faster
# than m//
# TODO
if (not $class=~m{^SOAP::WSDL::XSD::Typelib::Builtin}xms) {
eval "require $class"; ## no critic qw(ProhibitStringyEval)
die $@ if $@;
# TODO replace with UNIVERSAL->isa()
# match is a bit faster if the string does not match, but WAY slower
# if $class matches...
# if (not $class=~m{^SOAP::WSDL::XSD::Typelib::Builtin}xms) {
if (index $class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
eval "require $class" ## no critic qw(ProhibitStringyEval)
or die $@;
}
# create object
my $obj = $class->new({
# set current object
$current_of{ $ident } = $class->new({
map { $_->{ Name } => $_->{ Value } }
values %{ $element->{ Attributes } }
});
# set current object
$current_of{ $ident } = $obj;
# remember top level element
$data_of{ $ident } = $obj if not defined $data_of{ $ident };
defined $data_of{ $ident }
or ($data_of{ $ident } = $current_of{ $ident });
}
sub characters {
@@ -142,7 +141,8 @@ sub end_element {
my ($ident, $element) = (ident $_[0], $_[1]);
# This one easily handles ignores for us, too...
return if $list_of{ $ident }->[-1] eq '__STOP__';
return if not ref $list_of{ $ident }->[-1];
if ( $current_of{ $ident }
->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType') ) {
$current_of{ $ident }->set_value( $characters_of{ $ident } );
@@ -156,7 +156,7 @@ sub end_element {
# step up in path
pop @{ $path_of{ $ident } };
# step up in object hierarchy...
$current_of{ $ident } = pop @{ $list_of{ $ident } };
}

View File

@@ -29,7 +29,7 @@ __PACKAGE__->_factory(
detail => \%detail_of,
},
{
faultcode => 'SOAP::WSDL::XSD::Typelib::Builtin::qName',
faultcode => 'SOAP::WSDL::XSD::Typelib::Builtin::QName',
faultstring => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
faultactor => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
detail => 'SOAP::WSDL::XSD::Typelib::Builtin::anyType',

View File

@@ -5,6 +5,7 @@ use Carp;
use Class::Std::Storable;
use Scalar::Util qw(blessed);
use base qw/SOAP::WSDL::Base/;
use Data::Dumper;
my %annotation_of :ATTR(:name<annotation> :default<()>);
my %element_of :ATTR(:name<element> :default<()>);
@@ -60,57 +61,63 @@ sub serialize
{
my ($self, $name, $value, $opt) = @_;
$opt->{ indent } ||= q{};
my $flavor = $self->get_flavor();
my $xml = '';
$opt->{ indent } ||= q{};
$opt->{ attributes } ||= [];
my $flavor = $self->get_flavor();
my $xml = ($opt->{ readable }) ? $opt->{ indent } : q{}; # add indentation
if ( $opt->{ qualify } ) {
$opt->{ attributes } = [ ' xmlns="' . $self->get_targetNamespace .'"' ];
delete $opt->{ qualify };
}
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
$xml .= "<$name";
if ( $opt->{ autotype })
{
my $ns = $self->get_targetNamespace();
my $prefix = $opt->{ namespace }->{ $ns }
|| die 'No prefix found for namespace '. $ns;
$xml .= join q{}, " type=\"$prefix:", $self->get_name(), '"'
if ($self->get_name() );
}
$xml .= '>';
$xml .= "\n" if ( $opt->{ readable } ); # add linebreak
if ( ($flavor eq "sequence") or ($flavor eq "all") )
{
$opt->{ indent } .= "\t";
for my $element (@{ $self->get_element() })
{
# might be list - listify
$value = [ $value ] if not ref $value eq 'ARRAY';
$xml .= join q{ } , "<$name" , @{ $opt->{ attributes } };
delete $opt->{ attributes }; # don't propagate...
if ( $opt->{ autotype }) {
my $ns = $self->get_targetNamespace();
my $prefix = $opt->{ namespace }->{ $ns }
|| die 'No prefix found for namespace '. $ns;
$xml .= join q{}, " type=\"$prefix:", $self->get_name(), '" '
if ($self->get_name() );
}
$xml .= '>';
$xml .= "\n" if ( $opt->{ readable } ); # add linebreak
if ( ($flavor eq "sequence") or ($flavor eq "all") )
{
$opt->{ indent } .= "\t";
for my $element (@{ $self->get_element() }) {
# might be list - listify
$value = [ $value ] if not ref $value eq 'ARRAY';
for my $single_value (@{ $value }) {
my $element_value;
if (blessed $single_value) {
my $method = 'get_' . $element->get_name();
$element_value = $single_value->$method();
my $element_value;
if (blessed $single_value) {
my $method = 'get_' . $element->get_name();
$element_value = $single_value->$method();
}
else {
$element_value = $single_value->{ $element->get_name() }
else {
$element_value = $single_value->{ $element->get_name() };
}
$element_value = [ $element_value ]
if not ref $element_value eq 'ARRAY';
$element_value = [ $element_value ]
if not ref $element_value eq 'ARRAY';
$xml .= join q{}
, map { $element->serialize( undef, $_, $opt ) }
@{ $element_value };
}
}
$opt->{ indent } =~s/\t$//;
}
else
{
die "sorry, we just handle all and sequence types yet...";
}
$xml .= $opt->{ indent } if ( $opt->{ readable } ); # add indentation
$xml .= '</' . $name . '>';
$xml .= "\n" if ($opt->{ readable } ); # add linebreak
return $xml;
$xml .= join q{}
, map { $element->serialize( undef, $_, $opt ) }
@{ $element_value };
}
}
$opt->{ indent } =~s/\t$//;
}
else {
die "sorry, we just handle all and sequence types yet...";
}
$xml .= $opt->{ indent } if ( $opt->{ readable } ); # add indentation
$xml .= '</' . $name . '>';
$xml .= "\n" if ($opt->{ readable } ); # add linebreak
return $xml;
}
sub explain
@@ -249,6 +256,6 @@ Handling of these child elements is not implemented yet
=item * explain may produce erroneous results
=over
=back
=cut

View File

@@ -3,6 +3,7 @@ use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::Base);
use Data::Dumper;
my %simpleType_of :ATTR(:name<simpleType> :default<()>);
my %complexType_of :ATTR(:name<complexType> :default<()>);
@@ -44,7 +45,7 @@ sub first_complexType {
# serialize type instead...
sub serialize
{
my ($self, $name, $value, $opt) = @_;
my ($self, $name, $value, $opt) = @_;
my $type;
my $typelib = $opt->{ typelib };
my %ns_map = reverse %{ $opt->{ namespace } };
@@ -59,13 +60,18 @@ sub serialize
# substitutionGroup ?
$name ||= $self->get_name();
if ( $opt->{ qualify } ) {
$opt->{ attributes } = [ ' xmlns="' . $self->get_targetNamespace .'"' ];
}
# set default and fixed - fixed overrides everything,
# default only empty (undefined) values
if (not defined $value) {
$value = $default_of{ ident $self } if $default_of{ ident $self };
}
$value = $fixed_of{ ident $self } if $fixed_of{ ident $self };
if (not defined $value) {
$value = $default_of{ ident $self } if $default_of{ ident $self };
}
$value = $fixed_of{ ident $self } if $fixed_of{ ident $self };
# TODO check nillable and serialize empty data correctly
@@ -76,18 +82,18 @@ sub serialize
}
# handle direct simpleType and complexType here
if ($type = $self->first_simpleType() ) { # simpleType
return $type->serialize( $name, $value, $opt );
}
elsif ($type = $self->first_complexType() ) { # complexType
return $type->serialize( $name, $value, $opt );
}
if ($type = $self->first_simpleType() ) { # simpleType
return $type->serialize( $name, $value, $opt );
}
elsif ($type = $self->first_complexType() ) { # complexType
return $type->serialize( $name, $value, $opt );
}
elsif (my $ref_name = $ref_of{ $ident }) { # ref
my ($prefix, $localname) = split /:/ , $ref_name;
my $ns = $ns_map{ $prefix };
$type = $typelib->find_type( $ns, $localname );
die "no type for $prefix:$localname" if (not $type);
return $type->serialize( $self->get_name(), $value, $opt );
return $type->serialize( $name, $value, $opt );
}
# lookup type
@@ -98,9 +104,9 @@ sub serialize
);
# safety check
die "no type for $prefix:$localname $ns_map{$prefix}" if (not $type);
return $type->serialize( $self->get_name(), $value, $opt );
die "no type for $prefix:$localname $ns_map{$prefix}" if (not $type);
return $type->serialize( $name, $value, $opt );
}
sub explain
@@ -333,7 +339,7 @@ Handling of the substitutionGroup attribute is not implemented yet
=item * explain may produce erroneous results
=over
=back
=head1 COPYING

View File

@@ -9,9 +9,11 @@ sub serialize
{
my ($self, $name, $value, $opt) = @_;
my $xml;
$opt->{ indent } ||= "";
$opt->{ indent } ||= "";
$opt->{ attributes } ||= [];
$xml .= $opt->{ indent } if ($opt->{ readable });
$xml .= '<' . $name;
$xml .= '<' . join ' ', $name, @{ $opt->{ attributes } };
if ( $opt->{ autotype })
{
my $ns = $self->get_targetNamespace();

View File

@@ -57,58 +57,59 @@ sub push_enumeration
}
}
sub serialize
{
my $self = shift;
my $name = shift;
my $value = shift;
my $opt = shift;
my $ident = ident $self;
$self->_check_value( $value );
sub serialize {
my $self = shift;
my $name = shift;
my $value = shift;
my $opt = shift;
my $ident = ident $self;
$opt->{ attributes } ||= [];
$opt->{ indent } ||= q{};
$self->_check_value( $value );
return $self->_serialize_single($name, $value , $opt)
if ( $flavor_of{ $ident } eq 'restriction'
or $flavor_of{ $ident } eq 'union'
or $flavor_of{ $ident } eq 'enumeration');
return $self->_serialize_single($name, $value , $opt)
if ( $flavor_of{ $ident } eq 'restriction'
or $flavor_of{ $ident } eq 'union'
or $flavor_of{ $ident } eq 'enumeration');
if ($flavor_of{ $ident } eq 'list' )
{
$value ||= [];
$value = [ $value ] if ( ref( $value) ne 'ARRAY' );
return $self->_serialize_single($name, join( q{ }, @{ $value } ), $opt);
}
if ($flavor_of{ $ident } eq 'list' )
{
$value ||= [];
$value = [ $value ] if ( ref( $value) ne 'ARRAY' );
return $self->_serialize_single($name, join( q{ }, @{ $value } ), $opt);
}
}
sub _serialize_single
{
my ($self, $name, $value, $opt) = @_;
my $xml = '';
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
$xml .= '<' . $name;
if ( $opt->{ autotype })
{
my $ns = $self->get_targetNamespace();
sub _serialize_single {
my ($self, $name, $value, $opt) = @_;
my $xml = '';
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
$xml .= '<' . join ' ', $name, @{ $opt->{ attributes } };
if ( $opt->{ autotype }) {
my $ns = $self->get_targetNamespace();
my $prefix = $opt->{ namespace }->{ $ns }
|| die 'No prefix found for namespace '. $ns;
$xml .= ' type="' . $prefix . ':'
. $self->get_name() .'"';
}
$xml .= '>';
$xml .= $value;
$xml .= '</' . $name . '>' ;
$xml .= "\n" if ($opt->{ readable });
return $xml;
|| die 'No prefix found for namespace '. $ns;
$xml .= ' type="' . $prefix . ':' . $self->get_name() .'"';
}
# nillabel ?
return $xml .'/>' if not defined $value;
$xml .= join q{}, '>' , $value , '</' , $name , '>';
$xml .= "\n" if ($opt->{ readable });
return $xml;
}
sub explain
{
my ($self, $opt, $name) = @_;
my $perl;
$opt->{ indent } ||= "";
$perl .= $opt->{ indent } if ($opt->{ readable });
$perl .= q{'} . $name . q{' => $someValue };
$perl .= "\n" if ($opt->{ readable });
return $perl;
sub explain {
my ($self, $opt, $name) = @_;
my $perl;
$opt->{ indent } ||= "";
$perl .= $opt->{ indent } if ($opt->{ readable });
$perl .= q{'} . $name . q{' => $someValue };
$perl .= "\n" if ($opt->{ readable });
return $perl;
}
sub _check_value {
@@ -173,6 +174,6 @@ union simpleType definitions probalbly serialize wrong
=item * explain may produce erroneous results
=over
=back
=cut

View File

@@ -2,368 +2,51 @@ package SOAP::WSDL::XSD::Typelib::Builtin;
use strict;
use warnings;
use Class::Std::Storable;
# derivation classes first...
package SOAP::WSDL::XSD::Typelib::Builtin::list;
use strict;
use warnings;
use Class::Std::Storable;
sub serialize {
my ($self, $opt) = @_;
my $value = $self->get_value();
return $self->start_tag({ %$opt, nil => 1 }) if not defined $value;
$value = [ $value ] if not ref $value;
return join q{}, $self->start_tag($opt, $value)
, join( q{ }, @{ $value } )
, $self->end_tag($opt, $value);
}
# Builtin classes
# Every XML schema type inherits from anyType...
package SOAP::WSDL::XSD::Typelib::Builtin::anyType;
use strict;
use warnings;
use Class::Std::Storable;
sub start_tag {
my ($self, $opt) = @_;
$opt ||= {};
return '<' . $opt->{name} . ' >' if $opt->{ name };
return q{}
}
sub end_tag {
my ($self, $opt) = @_;
$opt ||= {};
return '</' . $opt->{name} . ' >' if $opt->{ name };
return q{}
};
sub serialize_qualified :STRINGIFY {
return $_[0]->serialize( { qualified => 1 } );
}
# All builtin and all simpleType types inherit from anySimpleType
package SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
my %value_of :ATTR(:name<value> :default<()>);
sub serialize {
my ($self, $opt) = @_;
my $ident = ident $self;
$opt ||= {};
return $self->start_tag({ %$opt, nil => 1})
if not defined $value_of{ $ident };
return join q{}, $self->start_tag($opt, $value_of{ $ident })
, $value_of{ $ident }
, $self->end_tag($opt);
}
sub as_bool :BOOLIFY {
return $value_of { ident $_[0] };
}
package SOAP::WSDL::XSD::Typelib::Builtin::dateTime;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::duration;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::date;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::time;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::gYear;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::gMonth;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::gDay;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::boolean;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
sub serialize {
my ($self, $opt) = @_;
my $ident = ident $self;
$opt ||= {};
return $self->start_tag({ %$opt, nil => 1})
if not defined $value_of{ $ident };
return join q{}
, $self->start_tag($opt)
, $value_of{ $ident } ? 'true' : 'false'
, $self->end_tag($opt);
}
sub as_num :NUMERIFY {
return $_[0]->get_value();
}
sub set_value {
my ($self, $value) = @_;
$value_of{ ident $self } = defined $value
? ($value ne 'false' or ($value))
? 1 : 0
: 0;
}
package SOAP::WSDL::XSD::Typelib::Builtin::string;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::normalizedString;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::string);
package SOAP::WSDL::XSD::Typelib::Builtin::token;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::normalizedString);
package SOAP::WSDL::XSD::Typelib::Builtin::language;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
package SOAP::WSDL::XSD::Typelib::Builtin::Name;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
package SOAP::WSDL::XSD::Typelib::Builtin::NCName;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::Name);
package SOAP::WSDL::XSD::Typelib::Builtin::ID;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::NCName);
package SOAP::WSDL::XSD::Typelib::Builtin::IDREF;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::ID);
package SOAP::WSDL::XSD::Typelib::Builtin::IDREFS;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(
SOAP::WSDL::XSD::Typelib::Builtin::list
SOAP::WSDL::XSD::Typelib::Builtin::IDREF);
package SOAP::WSDL::XSD::Typelib::Builtin::ENTITY;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::NCName);
package SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
package SOAP::WSDL::XSD::Typelib::Builtin::NMTOKENS;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(
SOAP::WSDL::XSD::Typelib::Builtin::list
SOAP::WSDL::XSD::Typelib::Builtin::token);
package SOAP::WSDL::XSD::Typelib::Builtin::decimal;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
sub as_num :NUMERIFY :BOOLIFY {
return $_[0]->get_value();
}
package SOAP::WSDL::XSD::Typelib::Builtin::base64Binary;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::hex64Binary;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::float;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
sub as_num :NUMERIFY {
return $_[0]->get_value();
}
package SOAP::WSDL::XSD::Typelib::Builtin::double;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
sub as_num :NUMERIFY {
return $_[0]->get_value();
}
package SOAP::WSDL::XSD::Typelib::Builtin::anyURI;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::qName;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::NOTATION;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
package SOAP::WSDL::XSD::Typelib::Builtin::integer;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::decimal);
package SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
package SOAP::WSDL::XSD::Typelib::Builtin::negativeInteger;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger);
package SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger);
package SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger);
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong);
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt);
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort);
package SOAP::WSDL::XSD::Typelib::Builtin::long;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
package SOAP::WSDL::XSD::Typelib::Builtin::int;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::long);
package SOAP::WSDL::XSD::Typelib::Builtin::short;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::int);
package SOAP::WSDL::XSD::Typelib::Builtin::byte;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::short);
use SOAP::WSDL::XSD::Typelib::Builtin::anyType;
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
use SOAP::WSDL::XSD::Typelib::Builtin::anyURI;
use SOAP::WSDL::XSD::Typelib::Builtin::base64Binary;
use SOAP::WSDL::XSD::Typelib::Builtin::boolean;
use SOAP::WSDL::XSD::Typelib::Builtin::byte;
use SOAP::WSDL::XSD::Typelib::Builtin::date;
use SOAP::WSDL::XSD::Typelib::Builtin::dateTime;
use SOAP::WSDL::XSD::Typelib::Builtin::decimal;
use SOAP::WSDL::XSD::Typelib::Builtin::double;
use SOAP::WSDL::XSD::Typelib::Builtin::duration;
use SOAP::WSDL::XSD::Typelib::Builtin::ENTITY;
use SOAP::WSDL::XSD::Typelib::Builtin::float;
use SOAP::WSDL::XSD::Typelib::Builtin::gDay;
use SOAP::WSDL::XSD::Typelib::Builtin::gMonth;
use SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay;
use SOAP::WSDL::XSD::Typelib::Builtin::gYear;
use SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth;
use SOAP::WSDL::XSD::Typelib::Builtin::hexBinary;
use SOAP::WSDL::XSD::Typelib::Builtin::ID;
use SOAP::WSDL::XSD::Typelib::Builtin::IDREF;
use SOAP::WSDL::XSD::Typelib::Builtin::IDREFS;
use SOAP::WSDL::XSD::Typelib::Builtin::int;
use SOAP::WSDL::XSD::Typelib::Builtin::integer;
use SOAP::WSDL::XSD::Typelib::Builtin::language;
use SOAP::WSDL::XSD::Typelib::Builtin::list;
use SOAP::WSDL::XSD::Typelib::Builtin::long;
use SOAP::WSDL::XSD::Typelib::Builtin::Name;
use SOAP::WSDL::XSD::Typelib::Builtin::NCName;
use SOAP::WSDL::XSD::Typelib::Builtin::negativeInteger;
use SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger;
use SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger;
use SOAP::WSDL::XSD::Typelib::Builtin::normalizedString;
use SOAP::WSDL::XSD::Typelib::Builtin::NOTATION;
use SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger;
use SOAP::WSDL::XSD::Typelib::Builtin::QName;
use SOAP::WSDL::XSD::Typelib::Builtin::short;
use SOAP::WSDL::XSD::Typelib::Builtin::string;
use SOAP::WSDL::XSD::Typelib::Builtin::time;
use SOAP::WSDL::XSD::Typelib::Builtin::token;
use SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte;
use SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt;
use SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong;
use SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort;
1;
@@ -382,7 +65,13 @@ This module implements all builtin Types from the XML schema specification.
Objects of a class may be filled with values and serialize correctly.
These basic type classes are most useful when used as element or simpleType
base classes.
base classes.
The datatypes classes themselves are split up into
SOAP::WSDL::XSD::Typelib::Builtin::* modules.
Using SOAP::WSDL::XSD::Typelib::Builtin uses all of the builtin datatype
classes.
=head1 EXAMPLES
@@ -506,7 +195,9 @@ Replace whitespace by @ in e-mail address.
Martin Kutter E<gt>martin.kutter fen-net.deE<lt>
=head1 COPYING
=head1 Licenxe
Copyright 2004-2007 Martin Kutter.
This library is free software, you may distribute/modify it under the
same terms as perl itself

View File

@@ -0,0 +1,27 @@
package SOAP::WSDL::XSD::Typelib::Builtin::ENTITY;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::NCName);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::ENTITY - ENTITY objects
=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

View File

@@ -0,0 +1,26 @@
package SOAP::WSDL::XSD::Typelib::Builtin::ID;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::NCName);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::ID - ID objects
=head1 LICENSE
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

View File

@@ -0,0 +1,26 @@
package SOAP::WSDL::XSD::Typelib::Builtin::IDREF;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::ID);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::IDREF - IDREF objects
=head1 LICENSE
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

View File

@@ -0,0 +1,32 @@
package SOAP::WSDL::XSD::Typelib::Builtin::IDREFS;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(
SOAP::WSDL::XSD::Typelib::Builtin::list
SOAP::WSDL::XSD::Typelib::Builtin::IDREF);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::IDREFS - IDREFS objects
=head1 DESCRIPTION
IDREFS is a list datatype implemented by list derivation from IDREF.
=head1 LICENSE
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

View File

@@ -0,0 +1,26 @@
package SOAP::WSDL::XSD::Typelib::Builtin::NCName;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::Name);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::NCName - NCName objects
=head1 LICENSE
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

View File

@@ -0,0 +1,26 @@
package SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN - NMTOKEN objects
=head1 LICENSE
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

View File

@@ -0,0 +1,33 @@
package SOAP::WSDL::XSD::Typelib::Builtin::NMTOKENS;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(
SOAP::WSDL::XSD::Typelib::Builtin::list
SOAP::WSDL::XSD::Typelib::Builtin::NMTOKEN);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::NMTOKENS - NMTOKENS objects
=head1 DESCRIPTION
List of NMTOKEN objects.
Implemented by derivation via SOAP::WSDL::XSD::Typelib::Builtin::list.
=head1 LICENSE
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

View File

@@ -0,0 +1,45 @@
package SOAP::WSDL::XSD::Typelib::Builtin::NOTATION;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %length_of :ATTR(:name<length> :default<()>);
my %minLength_of :ATTR(:name<minLength> :default<()>);
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<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::NOTATION - NOTATION object
=head1 DESCRIPTION
NOTATION represents the NOTATION attribute type from
XML 1.0 (Second Edition)
=head1 BUGS AND LIMITATIONS
Facets are implemented but don't have any influence yet.
No constraints are implemented yet.
=head1 LICENSE
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

View File

@@ -0,0 +1,26 @@
package SOAP::WSDL::XSD::Typelib::Builtin::Name;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::Name - Name objects
=head1 LICENSE
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

View File

@@ -0,0 +1,45 @@
package SOAP::WSDL::XSD::Typelib::Builtin::QName;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %length_of :ATTR(:name<length> :default<()>);
my %minLength_of :ATTR(:name<minLength> :default<()>);
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<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::QName - qualified Name object
=head1 DESCRIPTION
QName represents XML qualified names. The <20>value space<63> of QName
is the set of tuples {namespace name, local part}, where namespace
name is an anyURI and local part is an NCName.
=head1 BUGS AND LIMITATIONS
Facets are implemented but don't have any influence yet.
No constraints are implemented yet.
=head1 LICENSE
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

View File

@@ -0,0 +1,64 @@
package SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
my %value_of :ATTR(:get<value> :init_arg<value> :default<()>);
## use $_[n] for speed - we get called zillions of times...
# and we don't need to return the last value...
sub set_value { $value_of{ ident $_[0] } = $_[1] }
sub serialize {
my ($self, $opt) = @_;
my $ident = ident $self;
$opt ||= {};
return $self->start_tag({ %$opt, nil => 1})
if not defined $value_of{ $ident };
return join q{}, $self->start_tag($opt, $value_of{ $ident })
, $value_of{ $ident }
, $self->end_tag($opt);
}
# TODO disallow serializing !
sub as_bool :BOOLIFY {
return $value_of { ident $_[0] };
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType - All builtin and all simpleType types inherit from anySimpleType
=head1 CAVEATS
=over
=item * set_value
In contrast to Class::Std-generated mutators (setters), set_value does
not return the last value.
This is for speed reasons: SOAP::WSDL never needs to know the last value
when calling set_calue, but calls it over and over again...
=back
=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

View File

@@ -0,0 +1,45 @@
package SOAP::WSDL::XSD::Typelib::Builtin::anyType;
use strict;
use warnings;
use Class::Std::Storable;
# use $_[1] for performance
sub start_tag {
my $opt = $_[1] ||= {};
return '<' . $opt->{name} . ' >' if $opt->{ name };
return q{}
}
# use $_[1] for performance
sub end_tag {
return $_[1] && defined $_[1]->{ name }
? "</$_[1]->{name} >"
: q{};
};
sub serialize_qualified :STRINGIFY {
return $_[0]->serialize( { qualified => 1 } );
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::anyType - Base of all XSD Types
=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

View File

@@ -0,0 +1,48 @@
package SOAP::WSDL::XSD::Typelib::Builtin::anyURI;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %length_of :ATTR(:name<length> :default<()>);
my %minLength_of :ATTR(:name<minLength> :default<()>);
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<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::anyURI - URI object
=head1 DESCRIPTION
anyURI represents a Uniform Resource Identifier Reference (URI).
An anyURI value can be absolute or relative, and may have an optional
fragment identifier (i.e., it may be a URI Reference).
=head1 BUGS AND LIMITATIONS
Facets are implemented but don't have any influence yet.
No constraints are implemented yet.
=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

View File

@@ -0,0 +1,35 @@
package SOAP::WSDL::XSD::Typelib::Builtin::base64Binary;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %length_of :ATTR(:name<length> :default<()>);
my %minLength_of :ATTR(:name<minLength> :default<()>);
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<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::base64Binary - base64 encoded binary objects
=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

View File

@@ -0,0 +1,67 @@
package SOAP::WSDL::XSD::Typelib::Builtin::boolean;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %value_of :ATTR(:get<value> :init_attr<value> :default<()>);
sub serialize {
my ($self, $opt) = @_;
my $ident = ident $self;
$opt ||= {};
return $self->start_tag({ %$opt, nil => 1})
if not defined $value_of{ $ident };
return join q{}
, $self->start_tag($opt)
, $value_of{ $ident } ? 'true' : 'false'
, $self->end_tag($opt);
}
sub as_num :NUMERIFY {
return $_[0]->get_value();
}
sub set_value {
my ($self, $value) = @_;
$value_of{ ident $self } = defined $value
? ($value ne 'false' or ($value))
? 1 : 0
: 0;
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::boolean - boolean objects
=head1 DESCRIPTION
Serializes to "true" or "false".
Everything true in perl and not "false" is deserialized as true.
Returns true/false in boolean context.
Returns 1 / 0 in numeric context.
=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

View File

@@ -0,0 +1,33 @@
package SOAP::WSDL::XSD::Typelib::Builtin::byte;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::short);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::byte - byte integer objects
=head1 DESCRIPTION
Subclass of short.
=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

View File

@@ -0,0 +1,36 @@
package SOAP::WSDL::XSD::Typelib::Builtin::date;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::date - date objects
=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

View File

@@ -0,0 +1,37 @@
package SOAP::WSDL::XSD::Typelib::Builtin::dateTime;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::dateTime - dateTime objects
=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

View File

@@ -0,0 +1,43 @@
package SOAP::WSDL::XSD::Typelib::Builtin::decimal;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %totalDigits_of :ATTR(:name<totalDigits> :default<()>);
my %fractionDigits_of :ATTR(:name<fractionDigits> :default<()>);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
sub as_num :NUMERIFY :BOOLIFY {
return $_[0]->get_value();
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::decimal - decimal object, base of all non-float numbers
=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

View File

@@ -0,0 +1,55 @@
package SOAP::WSDL::XSD::Typelib::Builtin::double;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
sub as_num :NUMERIFY {
return $_[0]->get_value();
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::double - double precision float objects
=head1 DESCRIPTION
The double datatype corresponds to IEEE double-precision 64-bit floating point type.
The basic <20>value space<63> of double consists of the values m <20> 2^e, where m is an
integer whose absolute value is less than 2^53, and e is an integer between
-1075 and 970, inclusive.
In addition to the basic <20>value space<63> described above, the <20>value space<63> of double
also contains the following special values: positive and negative zero, positive and
negative infinity and not-a-number. The <20>order-relation<6F> on double is:
x < y iff y - x is positive.
Positive zero is greater than negative zero.
Not-a-number equals itself and is greater than all double values including
positive infinity.
=head1 BUGS AND LIMITATIONS
None of the "special" behaviours and values are implemented yet.
=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

View File

@@ -0,0 +1,36 @@
package SOAP::WSDL::XSD::Typelib::Builtin::duration;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::duration - duration objects
=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

View File

@@ -0,0 +1,41 @@
package SOAP::WSDL::XSD::Typelib::Builtin::float;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
sub as_num :NUMERIFY {
return $_[0]->get_value();
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::float - float objects
=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

View File

@@ -0,0 +1,36 @@
package SOAP::WSDL::XSD::Typelib::Builtin::gDay;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::gDay - day objects
=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

View File

@@ -0,0 +1,36 @@
package SOAP::WSDL::XSD::Typelib::Builtin::gMonth;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::gMonth - month objects
=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

View File

@@ -0,0 +1,36 @@
package SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::gMonthDay - month day objects
=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

View File

@@ -0,0 +1,36 @@
package SOAP::WSDL::XSD::Typelib::Builtin::gYear;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::gYear - year objects
=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

View File

@@ -0,0 +1,34 @@
package SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::gYearMonth - year and month objects
=head1 LICENSE
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

View File

@@ -0,0 +1,33 @@
package SOAP::WSDL::XSD::Typelib::Builtin::hexBinary;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %length_of :ATTR(:name<length> :default<()>);
my %minLength_of :ATTR(:name<minLength> :default<()>);
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<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::hexBinary - hex encoded binary objects
=head1 LICENSE
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

View File

@@ -0,0 +1,31 @@
package SOAP::WSDL::XSD::Typelib::Builtin::int;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::long);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::int - int objects
=head1 DESCRIPTION
Subclass of long.
=head1 LICENSE
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

View File

@@ -0,0 +1,30 @@
package SOAP::WSDL::XSD::Typelib::Builtin::integer;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::decimal);
sub as_num :NUMERIFY {
return $_[0]->get_value();
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::integer - integer objects
=head1 LICENSE
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

View File

@@ -0,0 +1,26 @@
package SOAP::WSDL::XSD::Typelib::Builtin::language;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::token);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::language - language objects
=head1 LICENSE
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

View File

@@ -0,0 +1,41 @@
package SOAP::WSDL::XSD::Typelib::Builtin::list;
use strict;
use warnings;
use Class::Std::Storable;
sub serialize {
my ($self, $opt) = @_;
my $value = $self->get_value();
return $self->start_tag({ %$opt, nil => 1 }) if not defined $value;
$value = [ $value ] if not ref $value;
return join q{}, $self->start_tag($opt, $value)
, join( q{ }, @{ $value } )
, $self->end_tag($opt, $value);
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::list - list derivation base class
=head1 DESCRIPTION
To derive from some class by list, just inherit from list.
Make sure SOAP::WSDL::XSD::Typelib::Builtin::list is before the type
to derive from in the @ISA list.
=head1 LICENSE
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

View File

@@ -0,0 +1,31 @@
package SOAP::WSDL::XSD::Typelib::Builtin::long;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::long - long integer objects
=head1 DESCRIPTION
Subclass of integer.
=head1 LICENSE
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

View File

@@ -0,0 +1,30 @@
package SOAP::WSDL::XSD::Typelib::Builtin::negativeInteger;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::egativeInteger - negative integer objects
=head1 DESCRIPTION
Subclass of integer.
=head1 LICENSE
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

View File

@@ -0,0 +1,30 @@
package SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger - non negative integer objects
=head1 DESCRIPTION
Subclass of integer.
=head1 LICENSE
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

View File

@@ -0,0 +1,30 @@
package SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::integer);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::nonPositiveInteger - nonPositiveInteger objects
=head1 DESCRIPTION
Subclass of integer.
=head1 LICENSE
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

View File

@@ -0,0 +1,26 @@
package SOAP::WSDL::XSD::Typelib::Builtin::normalizedString;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::string);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::normalizedString - normalizedString objects
=head1 LICENSE
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

View File

@@ -0,0 +1,31 @@
package SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::positiveInteger - positive integer objects
=head1 DESCRIPTION
Subclass of nonNegativeInteger.
=head1 LICENSE
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

View File

@@ -0,0 +1,31 @@
package SOAP::WSDL::XSD::Typelib::Builtin::short;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::int);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::short - short int objects
=head1 DESCRIPTION
Subclass of int.
=head1 LICENSE
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

View File

@@ -0,0 +1,33 @@
package SOAP::WSDL::XSD::Typelib::Builtin::string;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %length_of :ATTR(:name<length> :default<()>);
my %minLength_of :ATTR(:name<minLength> :default<()>);
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<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::string - string objects
=head1 LICENSE
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

View File

@@ -0,0 +1,34 @@
package SOAP::WSDL::XSD::Typelib::Builtin::time;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
my %pattern_of :ATTR(:name<pattern> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<()>);
my %maxInclusive_of :ATTR(:name<maxInclusive> :default<()>);
my %maxExclusive_of :ATTR(:name<maxExclusive> :default<()>);
my %minInclusive_of :ATTR(:name<minInclusive> :default<()>);
my %minExclusive_of :ATTR(:name<minExclusive> :default<()>);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::time - time objects
=head1 LICENSE
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

View File

@@ -0,0 +1,26 @@
package SOAP::WSDL::XSD::Typelib::Builtin::token;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::normalizedString);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::token - token objects
=head1 LICENSE
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

View File

@@ -0,0 +1,31 @@
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::unsignedByte - unsigned byte objects
=head1 DESCRIPTION
Subclass of unsignedShort.
=head1 LICENSE
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

View File

@@ -0,0 +1,32 @@
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt - unsigned int objects
=head1 DESCRIPTION
Subclass of unsignedLong.
=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

View File

@@ -0,0 +1,31 @@
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::nonNegativeInteger);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::unsignedLong - unsigned long integer objects
=head1 DESCRIPTION
Subclass of nonNegativeInteger.
=head1 LICENSE
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

View File

@@ -0,0 +1,31 @@
package SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort;
use strict;
use warnings;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt);
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::XSD::Typelib::Builtin::unsignedShort - unsigned short integer objects
=head1 DESCRIPTION
Subclass of unsignedInt.
=head1 LICENSE
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

View File

@@ -27,22 +27,35 @@ sub _factory {
{
my $type = $CLASSES_OF{ $class }->{ $name }
or die "No class given for $name";
eval "require $type" if not eval { $type->isa('UNIVERSAL') };
croak $@ if $@;
$type->isa('UNIVERSAL')
or eval "require $type"
or croak $@;
*{ "$class\::set_$name" } = sub {
my ($self, $value) = @_;
# set to a) value if it's an object
# b) New object with value for simple vlues
# set to
# a) value if it's an object
# b) New object with value for simple values
# c) New object with value for list values and list type
# d) List ref of new objects with value for list values and non-list type
# e) New object with values passed to new for HASH references
#
# Die on non-ARRAY/HASH references - if you can define semantics
# for GLOB references, feel free to add them.
$attribute_ref->{ ident $self } = (blessed $value)
? $value
: (ref $value && ref $value eq 'ARRAY')
? $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list')
? $type->new({ value => $value })
: [ map { $type->new({ value => $_ }) } @{ $value } ]
: $type->new({ value => $value });
: (ref $value ) ?
(ref $value eq 'ARRAY')
? $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list')
? $type->new({ value => $value })
: [ map { $type->new({ value => $_ }) } @{ $value } ]
: (ref $value eq 'HASH')
? $type->new( $value )
: die "Cannot use non-ARRAY/HASH as data"
: $type->new({ value => $value });
};
*{ "$class\::add_$name" } = sub {
@@ -63,33 +76,22 @@ sub _factory {
return push @{ $attribute_ref->{ $ident } }, $value;
};
}
# we need our own destructor - on the fly generated classes
# don't necessarily go through Clas::Std::Storable's DEMOLISH
# calls.
# my $destructor_ref = *{ "$class\::DESTROY" };
# no warnings qw(redefine);
# *{ "$class\::DESTROY" } = sub {
# my $self = shift;
# my $class = shift;
# for (@{ $ELEMENTS_FROM{ $class } }) {
# delete $_->{ ident $self };
# }
# call original destructor.
# $destructor_ref->( $self, @_) if ref ($destructor_ref);
# };
#
}
sub START {
my ($self, $ident, $args_of) = @_;
my $class = ref $self;
for my $name (keys %{ $ATTRIBUTES_OF{ $class } } ) {
my $method = "set_$name";
$self->$method( $args_of->{ $name } )
if $args_of->{ $name };
}
}
# iterate over keys of arguments
# and call set appropriate field in clase
map { ($ATTRIBUTES_OF{ $class }->{ $_ }) ?
do {
my $method = "set_$_";
$self->$method( $args_of->{ $_ } );
}
: croak "unknown field $_"
} keys %$args_of;
};
sub _get_elements {
my $self = shift;
@@ -104,28 +106,22 @@ sub _get_elements {
# But what about choice, group, extension ?
#
sub _serialize {
my $self = shift;
my $ident = ident $self;
my $class = ref $self;
my $ident = ident $_[0];
my $class = ref $_[0];
# return concatenated return value of serialize call of all
# elements retrieved from get_elements expanding list refs.
# get_elements is inlined for performance.
return join q{} , map {
my $element = $ATTRIBUTES_OF{ $class }->{ $_ }->{$ident };
my $element = $ATTRIBUTES_OF{ $class }->{ $_ }->{ $ident };
$element = [ $element ]
if not ref $element eq 'ARRAY';
my $name = $_;
map {
# skip empty elements - complexTypes may have empty elements
# (minOccurs 0).
if (not $_) {
q{}
}
my $name = $_;
map {
# serialize element elements with their own serializer
# but name them like they're named here.
elsif ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) {
if ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) {
$_->serialize( { name => $_ } );
}
# serialize complextype elments (of other types) with their
@@ -141,11 +137,11 @@ sub _serialize {
sub serialize {
my ($self, $opt) = @_;
my $class = ref $self;
$opt ||= {};
# do we have a empty element ?
return $self->start_tag({ %$opt, empty => 1 })
if not @{ $ELEMENTS_FROM{ $class } };
if not @{ $ELEMENTS_FROM{ ref $self } };
return join q{}, $self->start_tag($opt),
$self->_serialize(), $self->end_tag();
}

View File

@@ -95,10 +95,12 @@ SOAP::WSDL::XSD::Builtin) or another simpleType class.
The slight inconsistency between the these variants is caused by the
restriction element, which has different meanings for simpleType and
complexType definitions.
=back
=head1 Bugs and limitations
=head1 BUGS AND LIMITATIONS
=over *
=over
=item * Thread safety

View File

@@ -3,8 +3,6 @@ use strict;
use warnings;
use diagnostics;
use Test::More tests => 17; # qw/no_plan/; # TODO: change to tests => N;
use Test::Differences;
use Data::Dumper;
use lib '../lib';
use XML::SAX::ParserFactory;
@@ -133,7 +131,8 @@ SKIP: {
}
ok($xml = $wsdl->find_message('urn:myNamespace', 'testRequest')
->get_part()->[0]->serialize(
undef, { length => { size => -13, unit => 'BLA' } , int => 3 },
undef,
{ test => { length => { size => -13, unit => 'BLA' } , int => 3 } },
$serializer_options ),
"serialize part"
);

View File

@@ -1,8 +1,6 @@
use Test::More qw/no_plan/; # TODO: change to tests => N;
use Test::Differences;
use Test::More tests => 11;
use Data::Dumper;
use lib '../lib';
use Benchmark;
use XML::LibXML;
use_ok(qw/SOAP::WSDL::SAX::WSDLHandler/);
@@ -59,7 +57,7 @@ $opt->{ readable } = 0;
is( $schema->find_type( 'myNamespace', 'length3')->serialize(
'TestComplex', { size => -13, unit => 'BLA' } ,
$opt ),
q{<TestComplex type="tns:length3">}
q{<TestComplex type="tns:length3" >}
. q{<size type="xsd:non-positive-integer">-13</size>}
. q{<unit type="xsd:NMTOKEN">BLA</unit></TestComplex>}
, "serialize complex type" );
@@ -67,7 +65,7 @@ is( $schema->find_type( 'myNamespace', 'length3')->serialize(
is( $schema->find_element( 'myNamespace', 'TestElementComplexType')->serialize(
undef, { size => -13, unit => 'BLA' } ,
$opt ),
q{<TestElementComplexType type="tns:length3">}
q{<TestElementComplexType type="tns:length3" >}
. q{<size type="xsd:non-positive-integer">-13</size>}
. q{<unit type="xsd:NMTOKEN">BLA</unit></TestElementComplexType>},
"element with complex type"
@@ -77,8 +75,8 @@ is( $schema->find_type( 'myNamespace', 'complex')->serialize(
'complexComplex',
{ 'length' => { size => -13, unit => 'BLA' }, 'int' => 1 },
$opt ),
q{<complexComplex type="tns:complex">}
. q{<length type="tns:length3">}
q{<complexComplex type="tns:complex" >}
. q{<length type="tns:length3" >}
. q{<size type="xsd:non-positive-integer">-13</size>}
. q{<unit type="xsd:NMTOKEN">BLA</unit></length>}
. q{<int type="xsd:int">1</int></complexComplex>},
@@ -86,10 +84,10 @@ is( $schema->find_type( 'myNamespace', 'complex')->serialize(
);
is( $wsdl->find_message('myNamespace', 'testRequest')->first_part()->serialize(
undef, { length => { size => -13, unit => 'BLA' } , int => 3 },
undef, { test => { length => { size => -13, unit => 'BLA' } , int => 3 } },
$opt ),
q{<test type="tns:complex">}
. q{<length type="tns:length3">}
q{<test type="tns:complex" >}
. q{<length type="tns:length3" >}
. q{<size type="xsd:non-positive-integer">-13</size>}
. q{<unit type="xsd:NMTOKEN">BLA</unit>}
. q{</length><int type="xsd:int">3</int></test>}

View File

@@ -1,13 +1,9 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More qw/no_plan/; # TODO: change to tests => N;
use Test::Differences;
# use Devel::Profiler;
use Data::Dumper;
use Test::More tests => 5;
use lib '../lib';
use XML::SAX::ParserFactory;
use Benchmark;
use diagnostics;
@@ -22,17 +18,10 @@ my $filter;
ok($filter = SOAP::WSDL::SAX::WSDLHandler->new(), "Object creation");
#my $parser = XML::SAX::ParserFactory->parser(
# Handler => $filter
#);
use XML::LibXML;
my $parser = XML::LibXML->new();
$parser->set_handler( $filter );
#timethis 10, sub { $parser->parse_string( xml() ) };
#__END__
eval { $parser->parse_string( xml() ) };
if ($@)
{
@@ -60,7 +49,7 @@ my $opt = {
indent => "",
};
my $data = {
my $data = { EnqueueMessage => {
MMessage => {
MRecipientURI => 'anyURI',
MSenderAddress => 'a string',
@@ -72,7 +61,10 @@ my $data = {
MKeepaliveErrorPolicy => ' ( suppress | report ) ',
}
}
}
};
SKIP: { skip_without_test_xml();
is_xml( $wsdl->find_message(
@@ -89,7 +81,7 @@ sub skip_without_test_xml {
sub xml_message {
return
q{<EnqueueMessage>
q{<EnqueueMessage xmlns="http://www.example.org/MessageGateway2/">
<MMessage>
<MRecipientURI>anyURI</MRecipientURI>
<MSenderAddress>a string</MSenderAddress>
@@ -116,10 +108,10 @@ sub xml {
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/">
<wsdl:types>
<xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:tns="http://www.example.org/MessageGateway2/"
targetNamespace="http://www.example.org/MessageGateway2/">
<xsd:element name="EnqueueMessage" type="tns:TEnqueueMessage">
<xsd:element name="EnqueueMessage" type="tns:TEnqueueMessage"
xmlns:tns="http://www.example.org/MessageGateway2/">
<xsd:annotation>
<xsd:documentation>Enqueue message request element</xsd:documentation>
</xsd:annotation>

View File

@@ -2,11 +2,9 @@
use strict;
use warnings;
use Test::More qw/no_plan/; # TODO: change to tests => N;
use Test::Differences;
use Data::Dumper;
use lib '../lib';
use XML::LibXML;
use Benchmark;
use diagnostics;

View File

@@ -3,8 +3,6 @@ use strict;
use warnings;
use Pod::Simple::Text;
use Test::More qw/no_plan/; # TODO: change to tests => N;
use Test::Differences;
use Data::Dumper;
use lib '../lib';
use XML::SAX::ParserFactory;
@@ -20,16 +18,16 @@ use Cwd;
my $path = cwd;
$path =~s|\/t\/?$||; # allow running from t/ and above (Build test)
use_ok(qw/SOAP::WSDL::Client/);
use_ok(qw/SOAP::WSDL/);
my $soap = SOAP::WSDL::Client->new(
my $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path .'/t/acceptance/wsdl/006_sax_client.wsdl',
readable => 1,
)->wsdlinit();
$soap->servicename('MessageGateway');
ok( $soap->no_dispatch( 1 ) , "Set no_dispatch" );
ok( $soap->readable( 1 ) , "Set readable");
ok( $soap->explain() );
@@ -42,10 +40,11 @@ $pod->parse_string_document( $soap->explain() );
SKIP: {
skip_without_test_xml();
is_xml( $soap->call( 'EnqueueMessage' ,
'MMessage' => {
'MRecipientURI' => 'mailto:test@example.com' ,
'MMessageContent' => 'TestContent for Message' ,
is_xml( $soap->call( 'EnqueueMessage' , EnqueueMessage => {
'MMessage' => {
'MRecipientURI' => 'mailto:test@example.com' ,
'MMessageContent' => 'TestContent for Message' ,
}
}
)
, q{<SOAP-ENV:Envelope
@@ -54,7 +53,7 @@ SKIP: {
xmlns:tns="http://www.example.org/MessageGateway2/"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" >
<SOAP-ENV:Body ><EnqueueMessage><MMessage>
<SOAP-ENV:Body ><EnqueueMessage xmlns="http://www.example.org/MessageGateway2/"><MMessage>
<MRecipientURI>mailto:test@example.com</MRecipientURI>
<MMessageContent>TestContent for Message</MMessageContent>
</MMessage></EnqueueMessage></SOAP-ENV:Body></SOAP-ENV:Envelope>}

View File

@@ -3,16 +3,15 @@ use strict;
use warnings;
use Test::More qw/no_plan/; # TODO: change to tests => N;
use lib '../lib';
use diagnostics;
use Cwd;
my $path = cwd;
$path =~s|\/t\/?$||; # allow running from t/ and above (Build test)
use_ok(qw/SOAP::WSDL::Client/);
use_ok(qw/SOAP::WSDL/);
my $soap = SOAP::WSDL::Client->new(
my $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path .'/t/acceptance/wsdl/008_complexType.wsdl'
)->wsdlinit();

View File

@@ -1,13 +1,6 @@
#!/usr/bin/perl -w
use Test::More qw/no_plan/; # TODO: change to tests => N;
#use Devel::Profiler bad_pkgs => [
# qw(UNIVERSAL Time::HiRes B Carp Exporter Cwd Config CORE DynaLoader
# XSLoader AutoLoader
# Class::Std SOAP::Lite) ];
use Scalar::Util;
use strict;
use Test::Differences;
use strict;
use Test::More tests => 5;
use lib 't/lib';
use lib '../lib';
use lib 'lib';
@@ -18,7 +11,7 @@ use Cwd;
use XML::LibXML::SAX;
use_ok(qw/SOAP::WSDL::SAX::MessageHandler/);
use SOAP::WSDL::Client;
use SOAP::WSDL;
use SOAP::WSDL::XSD::Typelib::Builtin;
my $path = cwd;
$path =~s|\/t\/?$||; # allow running from t/ and above (Build test)
@@ -46,7 +39,8 @@ else
fail "bool context overloading"
}
my $soap = SOAP::WSDL::Client->new(
my $soap = SOAP::WSDL->new(
readable => 1,
wsdl => 'file:///' . $path .'/t/acceptance/wsdl/006_sax_client.wsdl',
)->wsdlinit();
@@ -55,17 +49,9 @@ $soap->servicename('MessageGateway');
ok( $soap->no_dispatch( 1 ) , "Set no_dispatch" );
ok( $soap->readable( 0 ) , "Set readable");
# print $soap->call( 'EnqueueMessage'
# , MMessage => $filter->get_data()->get_MMessage() );
timethese 1000, {
timethese 100, {
'ClassParser' => sub { $parser->parse_string( xml() ); },
# 'HashParser' => sub { $hash_parser->parse_string( xml() ); },
'XML::Simple' => sub { return XMLin( xml() ) },
# 'SOAP::WSDL::Client->call' => sub {
# $soap->call( 'EnqueueMessage'
# , MMessage => $filter->get_data()->get_MMessage() );
# }
};
sub xml {

View File

@@ -4,7 +4,6 @@ use strict;
use lib 'lib/';
use lib '../lib/';
use lib 't/lib';
use Data::Dumper;
use_ok qw(SOAP::WSDL::XSD::Typelib::ComplexType);
use_ok qw( MyComplexType );

View File

@@ -1,13 +1,9 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More qw/no_plan/; # TODO: change to tests => N;
use Test::Differences;
# use Devel::Profiler;
use Data::Dumper;
use Test::More tests => 5;
use lib '../lib';
use XML::SAX::ParserFactory;
use Benchmark;
use diagnostics;

View File

@@ -1,13 +1,9 @@
#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More qw/no_plan/; # TODO: change to tests => N;
use Test::Differences;
# use Devel::Profiler;
use Data::Dumper;
use Test::More tests => 5;
use lib '../lib';
use XML::SAX::ParserFactory;
use Benchmark;
use diagnostics;

View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl
use Test::More qw(no_plan);
use Test::More tests => 9;
use strict;
use diagnostics;
use lib 'lib/';
use lib '../lib/';
use lib 't/lib';
@@ -13,17 +14,21 @@ use_ok qw( SOAP::WSDL::Client );
my $obj = MyAtomicComplexTypeElement->new({ test=> 'Test', test2 => 'Test2'});
ok $obj->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType')
, 'inherited class';
# print $obj->get_test;
ok $obj->get_test->isa('SOAP::WSDL::XSD::Typelib::Builtin::string')
, 'element isa';
, 'element isa';
is $obj, '<MyAtomicComplexTypeElement xmlns="urn:Test" ><MyTestElement >Test</MyTestElement>'
. '<MyTestElement2 >Test2</MyTestElement2></MyAtomicComplexTypeElement>'
, 'stringification';
my $soap = SOAP::WSDL::Client->new();
$soap->proxy('http://bla');
$soap->no_dispatch(1);
my $soap = SOAP::WSDL::Client->new( {
class_resolver => 'FakeResolver',
} )
->proxy('http://bla')
->no_dispatch(1);
is $soap->call('Test', $obj), q{<SOAP-ENV:Envelope }
. q{xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" }
@@ -32,4 +37,24 @@ is $soap->call('Test', $obj), q{<SOAP-ENV:Envelope }
. q{<MyTestElement >Test</MyTestElement>}
. q{<MyTestElement2 >Test2</MyTestElement2>}
. q{</MyAtomicComplexTypeElement></SOAP-ENV:Body></SOAP-ENV:Envelope>}
, 'SOAP Envelope generation with objects';
, 'SOAP Envelope generation with objects';
my $result = $soap->proxy('http://bla')
->no_dispatch(0)
->call('Test', $obj);
ok $result->isa('SOAP::WSDL::SOAP::Typelib::Fault11'),
'return fault on impossible call';
ok ! $result, 'fault is false in boolean context';
package FakeResolver;
sub get_class {
my %class_list = (
'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11',
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyType',
);
}

9
t/020_storable.t Normal file
View File

@@ -0,0 +1,9 @@
use Test::More tests => 1;
use lib '../lib';
eval "require SOAP::WSDL::XSD::Typelib::Builtin";
use Storable;
my $long = SOAP::WSDL::XSD::Typelib::Builtin::long->new( { value => 9 });
my $clone = Storable::thaw( Storable::freeze( $long ) );
is $clone->serialize, 9 , 'clone via freeze/thaw';

27
t/098_pod.t Normal file
View File

@@ -0,0 +1,27 @@
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
use Cwd;
my $dir = cwd;
if ( $dir =~ /t$/ )
{
@directories = ('../lib/');
}
else
{
@directories = ();
}
my @files = all_pod_files(
@directories
);
plan tests => scalar(@files);
foreach my $module (@files)
{
pod_file_ok( $module )
}

View File

@@ -1,7 +1,7 @@
<?xml version="1.0"?>
<definitions name="simpleType"
targetNamespace="simpleType"
xmlns:tns="simpleType"
<definitions name="urn:simpleType"
targetNamespace="urn:simpleType"
xmlns:tns="urn:simpleType"
xmlns:wsd="http://www.w3c.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
@@ -32,8 +32,8 @@
Test-Methode
</documentation>
<input message="testRequest"/>
<output message="testResponse"/>
<input message="tns:testRequest"/>
<output message="tns:testResponse"/>
</operation>
</portType>
<portType name="testPort2">
@@ -42,22 +42,23 @@
Test-Methode
</documentation>
<input message="testRequest"/>
<output message="testResponse"/>
<input message="tns:testRequest"/>
<output message="tns:testResponse"/>
</operation>
</portType>
<portType name="testPort2">
<portType name="testPort3">
<operation name="test">
<documentation>
Test-Methode
</documentation>
<input message="testRequest"/>
<output message="testResponse"/>
<input message="tns:testRequest"/>
<output message="tns:testResponse"/>
</operation>
</portType>
<binding type="testPort" name="testBinding">
<binding type="tns:testPort" name="testBinding">
<operation name="test">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:operation soapAction="test">
<input>
@@ -67,8 +68,10 @@
<soap:body use="literal"/>
</output>
</soap:operation>
</operation>
</binding>
<binding type="testPort2" name="testBinding2">
<binding type="tns:testPort2" name="testBinding2">
<operation name="test">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:operation soapAction="test">
<input>
@@ -78,26 +81,28 @@
<soap:body use="literal"/>
</output>
</soap:operation>
</operation>
</binding>
<binding type="testPort3" name="testBinding3">
<binding type="tns:testPort3" name="testBinding3">
<operation name="test">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:operation soapAction="test">
<input>
<soap:body use="literal"/>
</input>
<output>
<soap:body use="literal"/>
</output>
</soap:operation>
<soap:operation soapAction="test"/>
<input>
<soap:body use="literal"/>
</input>
<output>
<soap:body use="literal"/>
</output>
</operation>
</binding>
<service name="testService">
<port name="testPort" binding="testBinding">
<port name="testPort" binding="tns:testBinding">
<soap:address location="http://127.0.0.1/testPort" />
</port>
<port name="testPort2" binding="testBinding2">
<port name="testPort2" binding="tns:testBinding2">
<soap:address location="http://127.0.0.1/testPort2" />
</port>
<port name="testPort3" binding="testBinding3">
<port name="testPort3" binding="tns:testBinding3">
<soap:address location="http://127.0.0.1/testPort3" />
</port>

View File

@@ -1,24 +1,24 @@
<?xml version="1.0"?>
<definitions name="Test"
targetNamespace="Test"
xmlns:tns="Test"
<definitions name="urn:Test"
targetNamespace="urn:Test"
xmlns:tns="urn:Test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
>
<types>
<xsd:schema targetNamespace="Test">
<xsd:complexType name="testComplexTypeAll">
<xsd:annotation>
<xsd:documentation>
ComplexType Test
</xsd:documentation>
</xsd:annotation>
<xsd:all>
<xsd:element name="Test1" type="xsd:string"/>
<xsd:element name="Test2" type="xsd:string" minOccurs="1"/>
</xsd:all>
</xsd:complexType>
<types>
<xsd:schema targetNamespace="urn:Test">
<xsd:complexType name="testComplexTypeAll">
<xsd:annotation>
<xsd:documentation>
ComplexType Test
</xsd:documentation>
</xsd:annotation>
<xsd:all>
<xsd:element name="Test1" type="xsd:string"/>
<xsd:element name="Test2" type="xsd:string" minOccurs="1"/>
</xsd:all>
</xsd:complexType>
<xsd:complexType name="testComplexTypeSequence">
<xsd:annotation>
@@ -34,11 +34,11 @@
</xsd:schema>
</types>
<message name="testRequest">
<part name="testAll" type="tns:testComplexType1"/>
<message name="testRequest">
<part name="testAll" type="tns:testComplexTypeAll"/>
</message>
<message name="testResponse">
<part name="testAll" type="tns:testComplexType1"/>
<part name="testAll" type="tns:testComplexTypeAll"/>
</message>
<portType name="testPort">
<operation name="test">
@@ -53,8 +53,8 @@
<binding type="tns:testPort" name="testBinding">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<operation name="test">
<soap:operation soapAction="test">
<operation name="test">
<soap:operation soapAction="test">
<input>
<soap:body use="literal"/>
</input>
@@ -62,7 +62,7 @@
<soap:body use="literal"/>
</output>
</soap:operation>
</operation>
</operation>
</binding>
<service name="testService">
<port name="testPort" binding="tns:testBinding">

View File

@@ -58,8 +58,9 @@
</operation>
</portType>
<binding type="tns:testPort" name="testBinding">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<binding type="tns:testPort" name="testBinding">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<operation name="test">
<soap:operation soapAction="test">
<input>
<soap:body use="literal"/>
@@ -67,21 +68,26 @@
<output>
<soap:body use="literal"/>
</output>
</soap:operation>
</soap:operation>
</operation>
</binding>
<binding type="tns:testPort2" name="testBinding2">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:operation soapAction="test">
<operation name="test">
<soap:operation soapAction="test">
<input>
<soap:body use="literal"/>
</input>
<output>
<soap:body use="literal"/>
</output>
</soap:operation>
</soap:operation>
</operation>
</binding>
<binding type="tns:testPort3" name="testBinding3">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<operation name="test">
<soap:operation soapAction="test">
<input>
<soap:body use="literal"/>
@@ -90,7 +96,8 @@
<soap:body use="literal"/>
</output>
</soap:operation>
</binding>
</operation>
</binding>
<service name="testService">
<port name="testPort" binding="tns:testBinding">
<soap:address location="http://127.0.0.1/testPort" />

View File

@@ -1,13 +1,13 @@
<?xml version="1.0"?>
<definitions name="Test"
targetNamespace="Test"
xmlns:tns="Test"
<definitions name="urn:Test"
targetNamespace="urn:Test"
xmlns:tns="urn:Test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
>
<types>
<xsd:schema targetNamespace="Test">
<xsd:schema targetNamespace="urn:Test">
<xsd:element name="testElement1">
<xsd:simpleType>
<xsd:annotation>
@@ -32,12 +32,13 @@
Test-Methode
</documentation>
<input message="testRequest"/>
<output message="testResponse"/>
<input message="tns:testRequest"/>
<output message="tns:testResponse"/>
</operation>
</portType>
<binding type="testPort" name="testBinding">
<binding type="tns:testPort" name="testBinding">
<operation name="test">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:operation soapAction="test">
<input>
@@ -47,9 +48,10 @@
<soap:body use="literal"/>
</output>
</soap:operation>
</operation>
</binding>
<service name="testService">
<port name="testPort" binding="testBinding">
<port name="testPort" binding="tns:testBinding">
<soap:address location="http://127.0.0.1/testPort" />
</port>
</service>

View File

@@ -1,13 +1,13 @@
<?xml version="1.0"?>
<definitions name="Test"
targetNamespace="Test"
xmlns:tns="Test"
<definitions name="urn:Test"
targetNamespace="urn:Test"
xmlns:tns="urn:Test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
>
<types>
<xsd:schema targetNamespace="Test">
<xsd:schema targetNamespace="urn:Test">
<xsd:element name="testElement1" type="xsd:string" />
<xsd:element name="testElement2" type="xsd:int" />
</xsd:schema>
@@ -24,12 +24,13 @@
Test-Methode
</documentation>
<input message="testRequest"/>
<output message="testResponse"/>
<input message="tns:testRequest"/>
<output message="tns:testResponse"/>
</operation>
</portType>
<binding type="testPort" name="testBinding">
<binding type="tns:testPort" name="testBinding">
<operation name="test">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:operation soapAction="test">
<input>
@@ -39,9 +40,10 @@
<soap:body use="literal"/>
</output>
</soap:operation>
</operation>
</binding>
<service name="testService">
<port name="testPort" binding="testBinding">
<port name="testPort" binding="tns:testBinding">
<soap:address location="http://127.0.0.1/testPort" />
</port>
</service>

View File

@@ -1,13 +1,13 @@
<?xml version="1.0"?>
<definitions name="Test"
targetNamespace="Test"
xmlns:tns="Test"
targetNamespace="urn:Test"
xmlns:tns="urn:Test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
>
<types>
<xsd:schema targetNamespace="Test">
<xsd:schema targetNamespace="urn:Test">
<xsd:simpleType name="testSimpleType1">
<xsd:annotation>
<xsd:documentation>
@@ -44,13 +44,14 @@
<documentation>
Test-Methode
</documentation>
<input message="testRequest"/>
<output message="testResponse"/>
<input message="tns:testRequest"/>
<output message="tns:testResponse"/>
</operation>
</portType>
<binding type="testPort" name="testBinding">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<binding type="tns:testPort" name="testBinding">
<operation name="test">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:operation soapAction="test">
<input>
<soap:body use="literal"/>
@@ -59,9 +60,10 @@
<soap:body use="literal"/>
</output>
</soap:operation>
</operation>
</binding>
<service name="testService">
<port name="testPort" binding="testBinding">
<port name="testPort" binding="tns:testBinding">
<soap:address location="http://127.0.0.1/testPort" />
</port>
</service>

View File

@@ -1,13 +1,13 @@
<?xml version="1.0"?>
<definitions name="Test"
targetNamespace="Test"
xmlns:tns="Test"
<definitions name="urn:Test"
targetNamespace="urn:Test"
xmlns:tns="urn:Test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
>
<types>
<xsd:schema targetNamespace="Test">
<xsd:schema targetNamespace="urn:Test">
<xsd:simpleType name="testSimpleType1">
<xsd:annotation>
<xsd:documentation>
@@ -33,12 +33,13 @@
<documentation>
Test-Methode
</documentation>
<input message="testRequest"/>
<output message="testResponse"/>
<input message="tns:testRequest"/>
<output message="tnstestResponse"/>
</operation>
</portType>
<binding type="testPort" name="testBinding">
<binding type="tns:testPort" name="testBinding">
<operation name="test">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:operation soapAction="test">
<input>
@@ -48,9 +49,10 @@
<soap:body use="literal"/>
</output>
</soap:operation>
</operation>
</binding>
<service name="testService">
<port name="testPort" binding="testBinding">
<port name="testPort" binding="tns:testBinding">
<soap:address location="http://127.0.0.1/testPort" />
</port>
</service>

View File

@@ -1,13 +1,13 @@
<?xml version="1.0"?>
<definitions name="Test"
targetNamespace="Test"
xmlns:tns="Test"
targetNamespace="urn:Test"
xmlns:tns="urn:Test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
>
<types>
<xsd:schema targetNamespace="Test">
<xsd:schema targetNamespace="urn:Test">
<xsd:simpleType name="testSimpleType1">
<xsd:annotation>
<xsd:documentation>
@@ -58,22 +58,23 @@
Test-Methode
</documentation>
<input message="testRequest"/>
<output message="testResponse"/>
<input message="tns:testRequest"/>
<output message="tns:testResponse"/>
</operation>
<operation name="test2">
<documentation>
Test-Methode
</documentation>
<input message="testRequest2"/>
<output message="testResponse2"/>
<input message="tns:testRequest2"/>
<output message="tns:testResponse2"/>
</operation>
</portType>
<binding type="testPort" name="testBinding">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<binding type="tns:testPort" name="testBinding">
<soap:binding style="document" transport="http://schemas.xmlsoap.org/soap/http"/>
<operation name="test">
<soap:operation soapAction="test">
<input>
<soap:body use="literal"/>
@@ -82,7 +83,9 @@
<soap:body use="literal"/>
</output>
</soap:operation>
<soap:operation soapAction="test2">
</operation>
<operation name="test2">
<soap:operation soapAction="test2">
<input>
<soap:body use="literal"/>
</input>
@@ -90,9 +93,10 @@
<soap:body use="literal"/>
</output>
</soap:operation>
</operation>
</binding>
<service name="testService">
<port name="testPort" binding="testBinding">
<port name="testPort" binding="tns:testBinding">
<soap:address location="http://127.0.0.1/testPort" />
</port>
</service>

View File

@@ -1,38 +1,47 @@
use Test::More tests => 9;
use Cwd;
use File::Basename;
use Test::More tests => 10;
use strict;
use warnings;
use diagnostics;
use Cwd;
use File::Basename;
use Data::Dumper;
use lib '../lib';
use_ok(qw/SOAP::WSDL/);
# 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;
#2
ok( $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' );
ok( $soap->wsdlinit(), 'parsed WSDL' );
ok( ($soap->servicename('testService') ), 'set service' );
ok( ($soap->portname('testPort') ) ,'set portname');
ok( ($soap->portname() eq 'testPort' ),
"Found first port definition" );
ok( ($soap->portname('testPort2') ),
"Found second port definition (based on URL)" );
ok( ($soap->portname('testPort3') ),
"Found third port definition (based on Name)" );
ok( $soap->wsdlinit( servicename => 'testService', portname => 'testPort'), 'parsed WSDL' );
$soap->_wsdl_init_methods();
use lib '../lib';
use_ok(qw/SOAP::WSDL/);
# 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;
#2
ok( $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' );
ok( ($soap->servicename('testService') eq 'testService' ) );
ok( ($soap->portname('testPort') eq 'testPort' ) );
ok( $soap->wsdlinit(), 'parsed WSDL' );
ok( ($soap->portname() eq 'testPort' ),
"Found first port definition" );
ok( ($soap->portname('testPort2') eq 'testPort2' ),
"Found second port definition (based on URL)" );
ok( $soap->wsdlinit(), 'parsed WSDL' );
ok( ($soap->portname('testPort3') eq 'testPort3' ),
"Found third port definition (based on Name)" );
ok( $soap->wsdlinit( servicename => 'testService', portname => 'testPort'), 'parsed WSDL' );
ok( ($soap->portname() eq 'testPort' ), 'found port passed to wsdlinit');

View File

@@ -1,32 +1,32 @@
BEGIN
use Test::More tests => 8;
use strict;
use warnings;
use lib '../lib';
use lib 't/lib';
use lib 'lib';
use Cwd;
use File::Basename;
our $SKIP;
eval "use Test::SOAPMessage";
if ($@)
{
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 ($@)
{
$SKIP = "Test::Differences required for testing. $@";
}
$SKIP = "Test::Differences required for testing. ";
}
my $path = cwd();
my $name = $0;
$name =~s/\.t$//;
$name =~s/^t\///;
$path =~s{/attic}{}xms;
use_ok(qw/SOAP::WSDL/);
print "# SOAP::WSDL Version: $SOAP::WSDL::VERSION\n";
my $xml;
my $soap;
#2
ok( $soap = SOAP::WSDL->new(
@@ -36,21 +36,14 @@ ok( $soap = SOAP::WSDL->new(
#3
ok( $soap->wsdlinit(
checkoccurs => 1,
), 'parsed WSDL' );
$soap->no_dispatch(1);
ok $soap->wsdlinit( checkoccurs => 1, ), 'parse WSDL';
ok $soap->no_dispatch(1), 'set no dispatch';
ok ($xml = $soap->serializer->method( $soap->call('test',
testAll => {
Test1 => 'Test 1',
Test2 => 'Test 2',
}
) ), 'Serialized complexType' );
ok ($xml = $soap->call('test',
Test1 => 'Test 1',
Test2 => 'Test 2',
), 'Serialized complexType' );
# oprint $xml;
#exit;
open (my $fh, $path . '/acceptance/results/' . $name . '.xml')
|| die "Cannot open acceptance results file";
@@ -58,13 +51,15 @@ my $testXML = <$fh>;
close $fh;
SKIP: {
print $SKIP;
skip( $SKIP, 1 ) if ($SKIP);
eval { soap_eq_or_diff( $xml, $testXML, 'Got expected result') };
};
# $soap->wsdl_checkoccurs(1);
TODO: {
local $TODO = "not implemented yet";
eval
{
$xml = $soap->serializer->method(
@@ -92,3 +87,4 @@ eval {
};
ok($@, 'Died on illegal number of elements (not enough)');
}

View File

@@ -1,19 +1,22 @@
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;
use Test::More tests => 2;
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. $@";
}
}
our $SKIP;
eval "use Test::SOAPMessage";
if ($@) {
$SKIP = "Test::Differences required for testing. $@";
}
use_ok qw/SOAP::WSDL/;
use_ok qw/SOAP::WSDL/;
my $soap = SOAP::WSDL->new();
TODO: {
local $TODO="implement <choice> support";
fail "serialize choice element";
}

View File

@@ -1,19 +1,22 @@
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;
use Test::More tests => 2;
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. $@";
}
}
our $SKIP;
eval "use Test::SOAPMessage";
if ($@) {
$SKIP = "Test::Differences required for testing. $@";
}
use_ok qw/SOAP::WSDL/;
use_ok qw/SOAP::WSDL/;
my $soap = SOAP::WSDL->new();
TODO: {
local $TODO="implement <complexContent> support";
fail "serialize complexContent element";
}

View File

@@ -1,19 +1,22 @@
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;
use Test::More tests => 2;
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. $@";
}
}
our $SKIP;
eval "use Test::SOAPMessage";
if ($@) {
$SKIP = "Test::Differences required for testing. $@";
}
use_ok qw/SOAP::WSDL/;
use_ok qw/SOAP::WSDL/;
my $soap = SOAP::WSDL->new();
TODO: {
local $TODO="implement <group> support";
fail "serialize group element";
}

View File

@@ -24,6 +24,8 @@ my $path = cwd();
my $name = $0;
$name =~s/\.t$//;
$path=~s{/attic}{}xms;
#2
ok( $soap = SOAP::WSDL->new(
wsdl => 'file://' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
@@ -34,16 +36,16 @@ ok( $soap->wsdlinit(
checkoccurs => 1,
), 'parsed WSDL' );
$soap->no_dispatch(1);
$soap->serializer()->namespace('SOAP-ENV');
$soap->serializer()->encodingspace('SOAP-ENC');
$soap->serializer()->envprefix('SOAP-ENV');
$soap->serializer()->encprefix('SOAP-ENC');
#4
ok ($xml = $soap->serializer->method( $soap->call('test',
ok $xml = $soap->call('test',
testSequence => {
Test1 => 'Test 1',
Test2 => 'Test 2',
}
) ), 'Serialized complexType' );
), 'Serialized complexType';
#5
open (my $fh, $path . '/acceptance/results/' . $name . '.xml')
@@ -53,7 +55,7 @@ close $fh;
SKIP:
{
skip( 1, $SKIP ) if ($SKIP);
skip( $SKIP, 1 ) if ($SKIP);
soap_eq_or_diff( $xml, $testXML, 'Got expected result');
}
#6
@@ -86,7 +88,3 @@ eval
ok( ($@),
"Died on illegal number of elements"
);
# chdir back to where we came from
chdir $cwd;

View File

@@ -1,19 +1,22 @@
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;
use Test::More tests => 2;
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. $@";
}
}
our $SKIP;
eval "use Test::SOAPMessage";
if ($@) {
$SKIP = "Test::Differences required for testing. $@";
}
use_ok qw/SOAP::WSDL/;
use_ok qw/SOAP::WSDL/;
my $soap = SOAP::WSDL->new();
TODO: {
local $TODO="implement <simpleContent> support";
fail "serialize simpleContent element";
}

View File

@@ -1,5 +1,4 @@
use Test::More tests => 1;
use Test::More skip_all => 'TODO: implement tests';
use lib '../lib';
use_ok qw/SOAP::WSDL/;

View File

@@ -1,23 +1,17 @@
BEGIN
{
chdir 't/' if (-d 't/');
use Test::More;
use strict;
use warnings;
plan qw/no_plan/;
use lib '../lib';
use lib 't/lib';
use lib 'lib';
use Cwd;
use File::Basename;
use Test::More;
plan qw/no_plan/;
# plan "skip_all", "Not yet supported";
# 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 ($@)
{
$SKIP = "Test::Differences required for testing.";
}
our $SKIP;
eval "use Test::SOAPMessage";
if ($@) {
$SKIP = "Test::Differences required for testing.";
}
@@ -25,15 +19,13 @@ use_ok(qw/SOAP::WSDL/);
my $xml;
# 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{/attic}{}xms;
#2
ok( $soap = SOAP::WSDL->new(
@@ -41,53 +33,35 @@ ok( $soap = SOAP::WSDL->new(
), 'Instantiated object' );
#3
$soap->readable(1);
ok( $soap->wsdlinit(), 'parsed WSDL' );
$soap->no_dispatch(1);
$soap->serializer()->namespace('SOAP-ENV');
$soap->serializer()->encodingspace('SOAP-ENC');
ok ( $xml = $soap->serializer->method( $soap->call('test',
testAll => 1 )
),
ok ( $xml = $soap->call('test', testElement1 => 1 ) ,
'Serialized (simpler) element' );
# 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;
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');
};
skip($SKIP, 1) if ($SKIP);
soap_eq_or_diff( $xml, $testXML, 'Got expected result');
}
TODO: {
local $TODO="implement min/maxOccurs checks";
eval { $soap->call('test', testAll => [ 2, 3 ] ); };
like $@, qr{illegal\snumber\sof\selements}, "Died on illegal number of elements (too many)";
eval { $soap->call('test', testAll => undef ) };
ok $@, 'Died on illegal number of elements (not enough)';
}
eval
{
$xml = $soap->serializer->method(
$soap->call('test',
testAll => [ 2, 3 ]
)
);
};
# print $@;
ok( ($@ =~m/illegal\snumber\sof\selements/),
"Died on illegal number of elements (too many)"
);
eval {
$xml = $soap->serializer->method(
$soap->call('test',
testAll => undef
)
)
};
ok($@, 'Died on illegal number of elements (not enough)');
chdir $cwd;

View File

@@ -1,74 +1,72 @@
BEGIN
{
chdir 't/' if (-d 't/');
use Test::More tests => 7;;
use strict;
use warnings;
use lib '../lib';
use lib 't/lib';
use lib 'lib';
use Cwd;
use File::Basename;
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 ($@)
{
$SKIP = "Test::Differences required for testing.";
}
our $SKIP;
eval "use Test::SOAPMessage";
if ($@) {
$SKIP = "Test::Differences required for testing.";
}
use_ok(qw/SOAP::WSDL/);
my $soap;
my $xml;
my $path = cwd();
my $name = $0;
$name =~s/\.t$//;
$path =~s{/attic}{}xsm;
#2
ok( $soap = SOAP::WSDL->new(
wsdl => 'file://' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' );
#3
$soap->readable(1);
ok( $soap->wsdlinit(), 'parsed WSDL' );
$soap->no_dispatch(1);
$soap->serializer()->namespace('SOAP-ENV');
$soap->serializer()->encodingspace('SOAP-ENC');
ok ($xml = $soap->serializer->method( $soap->call('test',
testAll => 'Test'
) ), 'Serialized (simpler) element' );
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:
{
skip( $SKIP, 1 ) if ($SKIP);
soap_eq_or_diff( $xml, $testXML, 'Got expected result');
SKIP: {
if ($SKIP){
print $xml;
skip( $SKIP, 1 );
}
soap_eq_or_diff( $xml, $testXML, 'Got expected result');
};
eval
{
$xml = $soap->serializer->method(
$soap->call('test',
TODO: {
local $TODO="implement min/maxOccurs checks";
eval {
$xml = $soap->call('test',
testAll => [ 'Test 2', 'Test 3' ]
)
);
};
);
};
ok( ($@ =~m/illegal\snumber\sof\selements/),
ok( ($@ =~m/illegal\snumber\sof\selements/),
"Died on illegal number of elements (too many)"
);
);
eval {
$xml = $soap->serializer->method(
$soap->call('test',
testAll => undef
)
)
};
ok($@, 'Died on illegal number of elements (not enough)');
eval {
$xml = $soap->call('test', testAll => undef );
};
ok($@, 'Died on illegal number of elements (not enough)');
}

View File

@@ -1,98 +1,53 @@
use Test::More tests => 10;
use Test::More tests => 8;
use strict;
use lib '../lib';
use lib 'lib';
use lib 't/lib';
use Cwd;
use File::Basename;
use Test::SOAPMessage;
use diagnostics;
use_ok(qw/SOAP::WSDL/);
unless ($SOAP::WSDL::MISSING) { };
my ($xml, $xml2);
my ($soap, $xml, $xml2);
# 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{/attic}{}xms;
#2
ok( $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' );
$soap->readable(1);
#3
ok( $soap->wsdlinit(), 'parsed WSDL' );
$soap->no_dispatch(1);
#4
ok ( $xml = $soap->serializer->method( $soap->call('test',
testAll => [ 1, 2 ] )
),
'Serialized (simple) call (list)' );
ok $xml = $soap->call('test', testAll => [ 1, 2 ] ), 'Serialize list call';
#print $xml, "\n";
SKIP: {
open (my $fh, $path . '/acceptance/results/' . $name . '.xml')
|| skip("Cannot open acceptance results file", 1);
my $testXML = <$fh>;
close $fh;
#5
soap_eq_or_diff( $xml, $testXML, 'Got expected result');
}
print $xml, "\n";
#5
ok ( $xml2 = $soap->call('test', testAll => "1 2" ) , 'Serialized scalar call' );
#6
ok ( $xml2 = $soap->serializer->method( $soap->call('test',
testAll => "1 2" )
),
'Serialized (simple) call (scalar)' );
#7
ok( $xml eq $xml2, 'Got expected result');
#8
ok (
$xml = $soap->serializer->method(
$soap->call('test',
testAll => 2
)
), "Serialized simple call (scalar value)"
);
#9
eval {
$xml = $soap->serializer->method(
$soap->call('test',
testAll => undef
)
)
};
ok($@, 'Died on illegal number of elements (not enough)');
#10
SKIP:
{
skip ("maxLength test not implemented", 1)
if ( $SOAP::WSDL::MISSING->{ simpleType }->{ list }->{ maxLength } );
eval {
$xml = $soap->serializer->method(
$soap->call('test',
testAll => [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 0 ]
)
)
};
ok($@, 'Died on illegal number of elements (more than maxLength)');
#7
TODO: {
local $TODO = "implement minLength check";
eval { $xml = $soap->call('test', testAll => undef ) };
ok($@, 'Died on illegal number of elements (not enough)');
}
chdir $cwd;
#8
TODO: {
local $TODO = "maxLength test not implemented";
eval { $xml = $soap->call('test', testAll => [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 0 ] ) };
ok($@, 'Died on illegal number of elements (more than maxLength)');
}

View File

@@ -1,105 +1,57 @@
use Test::More tests => 9;
use Test::More tests => 8;
use strict;
use warnings;
use diagnostics;
use Cwd;
use File::Basename;
use lib '../lib';
use lib 'lib';
use lib 't/lib';
use Test::SOAPMessage;
use_ok(qw/SOAP::WSDL/);
my $xml;
# 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{/attic}{}xms;
my $soap;
#2
ok( $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' );
#3
$soap->readable(1);
ok( $soap->wsdlinit(), 'parsed WSDL' );
$soap->no_dispatch(1);
$soap->autotype(0);
#4
ok ( $xml = $soap->serializer->method( $soap->call('test',
testAll => 1 )
),
'Serialized (simple) call (list)' );
ok $xml = $soap->call('test', testAll => [ 1, 2 ] ) , 'Serialize list call';
print $xml, "\n";
# print $xml, "\n";
SKIP: {
skip 'broken', 1;
open (my $fh, $path . '/acceptance/results/' . $name . '.xml')
|| skip("Cannot open acceptance results file ". $name . '.xml', 1);
my $testXML = <$fh>;
close $fh;
chomp $testXML;
chomp $xml;
TODO: {
local $TODO = "implement minLength/maxLength checks";
eval { $soap->call('test', testAll => [ 1, 2, 3 ] ) };
ok($@, 'Died on illegal number of elements (too many)');
soap_eq_or_diff( $xml, $testXML, 'Got expected result');
eval { $soap->call('test', testAll => [] ) };
ok($@, 'Died on illegal number of elements (not enough)');
}
# 6
eval {
$xml = $soap->serializer->method(
$soap->call('test',
testAll => [ 1, 2 ]
)
)
};
ok($@, 'Died on illegal number of elements (not enough)');
eval {
$xml = $soap->serializer->method(
$soap->call('test',
testAll => undef
)
)
};
ok($@, 'Died on illegal number of elements (not enough)');
SKIP:
{
skip( "minValue check not implemented ", 1)
if ($SOAP::WSDL::MISSING->{ simpleType }->{ restriction }->{ minValue });
eval {
$xml = $soap->serializer->method(
$soap->call('test',
testAll => 0
)
)
};
ok($@, 'Died on illegal value');
TODO: {
local $TODO = "minValue check not implemented ";
eval { $xml = $soap->call('test', testAll => 0 ) };
ok($@, 'Died on illegal value');
}
SKIP:
{
skip( "maxValue check not implemented ", 1)
if ($SOAP::WSDL::MISSING->{ simpleType }->{ restriction }->{ maxValue });
eval {
$xml = $soap->serializer->method(
$soap->call('test',
testAll => 100
)
)
};
ok($@, 'Died on illegal value');
TODO: {
local $TODO = "maxValue check not implemented ";
eval { $xml = $soap->call('test', testAll => 100 ) };
ok($@, 'Died on illegal value');
}
chdir $cwd;

View File

@@ -1,41 +1,36 @@
use Test::More tests => 9;
use Test::More skip_all => 'Not supported yet';
use strict;
use warnings;
use Cwd;
use File::Basename;
use lib '../lib';
use_ok(qw/SOAP::WSDL/);
use_ok qw/SOAP::WSDL/;
my $xml;
# 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{/attic}{}xms;
#2
ok( $soap = SOAP::WSDL->new(
ok $soap = SOAP::WSDL->new(
wsdl => 'file:///' . $path . '/acceptance/wsdl/' . $name . '.wsdl'
), 'Instantiated object' );
), 'Instantiated object';
#3
ok( $soap->wsdlinit(), 'parsed WSDL' );
$soap->readable(1);
ok $soap->wsdlinit(), 'parsed WSDL';
$soap->no_dispatch(1);
$soap->serializer()->namespace('SOAP-ENV');
$soap->serializer()->encodingspace('SOAP-ENC');
#4
ok ( $xml = $soap->serializer->method( $soap->call('test',
testAll => 1 )
),
'Serialized (simple) call (list)' );
ok $xml = $soap->call('test', testAll => 1 ) , 'Serialized call';
# print $xml, "\n";
print $xml, "\n";
SKIP: {
@@ -81,5 +76,3 @@ eval {
)
};
ok($@, 'Died on illegal number of elements (not enough)');
chdir $cwd;

View File

@@ -28,19 +28,6 @@ print "Acceptance test against sample output with simple WSDL\n";
my $data = {
name => 'test',
givenName => 'test',
# test => {
# name => 'TESTNAME',
# givenName => 'GIVENNAME',
# },
# test1 => {
# name => 'TESTNAME',
# givenName => 'GIVENNAME',
# extend => 'EXTEND',
# },
# test2 => {
# name => 'TESTNAME',
# givenName => 'GIVENNAME',
# }
};
my $t0 = [gettimeofday];
@@ -54,6 +41,8 @@ chdir $path;
$path = cwd;
$path =~s{/attic}{}xms;
ok( $soap=SOAP::WSDL->new(
wsdl => 'file:///'.$path.'/acceptance/wsdl/11_helloworld.wsdl',
@@ -71,9 +60,9 @@ print "WSDL init (".tv_interval ( $t0, [gettimeofday]) ."s)\n" ;
$t0 = [gettimeofday];
do {
my $xml = $soap->serializer->method( $soap->call(sayHello => %{ $data }) );
my $xml = $soap->call('sayHello', 'sayHello' => %{ $data });
open (FILE, "acceptance/results/11_helloworld.xml")
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;
@@ -94,9 +83,9 @@ do {
$t0 = [gettimeofday];
do {
my $xml = $soap->serializer->method( $soap->call(sayHello => %{ $data }) );
my $xml = $soap->call(sayHello => %{ $data });
open (FILE, "acceptance/results/11_helloworld.xml")
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;

View File

@@ -20,7 +20,7 @@ package MyTestElement;
use strict;
use Class::Std::Storable;
use SOAP::WSDL::XSD::Typelib::Element;
use SOAP::WSDL::XSD::Typelib::Builtin;
use SOAP::WSDL::XSD::Typelib::Builtin::string;
use base (
'SOAP::WSDL::XSD::Typelib::Element',
'SOAP::WSDL::XSD::Typelib::Builtin::string',
@@ -28,8 +28,9 @@ use base (
sub START {
my ($self, $ident, $args_of) =@_;
$self->__set_name('MyTestElement');
}
__PACKAGE__->__set_name('MyTestElement');
sub get_xmlns { 'urn:Test' };