import SOAP-WSDL 2.00_33 from CPAN

git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_33
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_33.tar.gz
This commit is contained in:
Martin Kutter
2009-12-12 19:48:28 -08:00
committed by Michael G. Schwern
parent 51db446428
commit 0cbf981665
146 changed files with 3364 additions and 1280 deletions
+268
View File
@@ -0,0 +1,268 @@
package SOAP::WSDL::Generator::Iterator::WSDL11;
use strict; use warnings;
use Class::Std::Fast;
my %definitions_of :ATTR(:name<definitions> :default<[]>);
my %nodes_of :ATTR(:name<nodes> :default<[]>);
# memoization attributes
my %portType_of :ATTR();
my %types_of :ATTR();
my %METHOD_OF = (
'SOAP::WSDL::Definitions' => 'get_service',
'SOAP::WSDL::Service' => 'get_port',
'SOAP::WSDL::Port' => sub {
my ($self, $node) = @_;
return if ! $node->first_address()
or ! $node->first_address()->isa('SOAP::WSDL::SOAP::Address');
return [ $self->get_definitions()
->find_binding( $node->expand( $node->get_binding() ) ) || () ];
},
'SOAP::WSDL::Binding' => sub {
my ($self, $node) = @_;
# remember referenced portType
$portType_of{ ident $self } = $self->get_definitions()
->find_portType( $node->expand( $node->get_type ) )
or return [];
return $node->get_operation();
},
'SOAP::WSDL::Operation' => sub {
my ($self, $node) = @_;
my $name = $node->get_name();
# get the equally named operation from the portType
my ($op) = grep { $_->get_name() eq $name }
@{ $portType_of{ ident $self }->get_operation() }
or return [];
return [ @{ $op->get_input }, @{ $op->get_output }, @{ $op->get_fault } ]
},
'SOAP::WSDL::OpMessage' => sub {
my ($self, $node) = @_;
return if ( ref $node->get_parent() eq 'SOAP::WSDL::Binding' ); # we're in binding
# TODO maybe allow more messages && overloading by specifying name
return [ $self->get_definitions()->find_message(
$node->expand( $node->get_message() )
) || () ];
},
'SOAP::WSDL::Message' => 'get_part',
'SOAP::WSDL::Part' => sub {
my ($self, $node) = @_;
my $ident = ident $self;
my $types = $types_of{ $ident } = $definitions_of{ $ident }->get_types()->[0]
or return [];
return [
# If we have a type, this type is to be used in document/literal
# as global type. However this is forbidden, at least by WS-I.
# We should store the style/encoding somewhere, and regard it.
# TODO: auto-generate element for RPC bindings
$node->get_type()
? do {
die "unsupported global type <"
. $node->get_type . "> found in part ". $node->get_name();
$types->find_type( $node->expand($node->get_type) )
}
: (),
$node->get_element()
? $types->find_element( $node->expand($node->get_element) )
: (),
];
},
);
sub init {
my ($self, $arg_of) = @_;
my $ident = ident $self;
undef $portType_of{ $ident };
undef $types_of{ $ident };
$nodes_of{ $ident } = [
exists($arg_of->{ node })
? $arg_of->{ node }
: $definitions_of{ ident $self }
];
}
sub get_next {
my $self = shift;
my $ident = ident $self;
my $node = shift @{ $nodes_of{ $ident }};
return if ! defined $node;
unshift @{ $nodes_of{ $ident }}, @{ $self->get_nextNodes( $node ) || [] };
return $node;
}
sub get_nextNodes {
my ($self, $node) = @_;
my $method = $METHOD_OF{ ref $node }
or return [];
return (ref($method) eq 'CODE')
? $method->( $self, $node )
: $node->can($method)->( $node );
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::Generator::Iterator::WSDL11 - WSDL 1.1 Iterator
=head1 SYNOPSIS
my $iter = SOAP::WSDL::Generator::Iterator::WSDL11->new({
definitions => $wsdl
});
$iter->init();
while (my $node = $iter->get_next()) {
# do something with node - possibly call _accept with a visitor on it...
}
=head1 DESCRIPTION
Iterator for walking a WSDL 1.1 definition.
The iterator performs a depth-first search along the following path:
service
port
binding
operation
input/output/fault of operation in portType
message
part
type/element in XML schema
If you wonder about this path: This is how to look up which XML Schema element
is associated with a operation from a service/port.
=head2 Example
The nodes are returned in the order denoted in the following example:
<?xml version="1.0" encoding="UTF-8"?>
<!-- 1 -->
<definitions xmlns:http="http://schemas.xmlsoap.org/wsdl/http/"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:s="http://www.w3.org/2001/XMLSchema" xmlns:s0="urn:HelloWorld"
targetNamespace="urn:HelloWorld"
xmlns="http://schemas.xmlsoap.org/wsdl/">
<types>
<s:schema elementFormDefault="qualified" targetNamespace="urn:HelloWorld">
<!-- 9 -->
<s:element name="sayHello">
<s:complexType>
<s:sequence>
<s:element minOccurs="0" maxOccurs="1" name="name" type="s:string" />
<s:element minOccurs="0" maxOccurs="1" name="givenName" type="s:string" nillable="1" />
</s:sequence>
<s:attribute name="testAttr" type="s:string" use="optional"></s:attribute>
</s:complexType>
</s:element>
<!-- 13 -->
<s:element name="sayHelloResponse">
<s:complexType>
<s:sequence>
<s:element minOccurs="0" maxOccurs="1"
name="sayHelloResult" type="s:string" />
</s:sequence>
</s:complexType>
</s:element>
</s:schema>
</types>
<!-- 7 -->
<message name="sayHelloSoapIn">
<!-- 8 -->
<part name="parameters" element="s0:sayHello" />
</message>
<!-- 11 -->
<message name="sayHelloSoapOut">
<!-- 12 -->
<part name="parameters" element="s0:sayHelloResponse" />
</message>
<portType name="Service1Soap">
<operation name="sayHello">
<!-- 6 -->
<input message="s0:sayHelloSoapIn" />
<!-- 10 -->
<output message="s0:sayHelloSoapOut" />
</operation>
</portType>
<!-- 4 -->
<binding name="Service1Soap" type="s0:Service1Soap">
<soap:binding transport="http://schemas.xmlsoap.org/soap/http"
style="document" />
<!-- 5 -->
<operation name="sayHello">
<soap:operation soapAction="urn:HelloWorld#sayHello"
style="document" />
<input>
<soap:body use="literal" />
</input>
<output>
<soap:body use="literal" />
</output>
</operation>
</binding>
<!-- 2 -->
<service name="Service1">
<!-- 3 -->
<port name="Service1Soap" binding="s0:Service1Soap">
<soap:address
location="http://localhost:81/soap-wsdl-test/helloworld.pl" />
</port>
</service>
</definitions>
You should not rely too much on this order - it may change. Even though, the
current order will probably remain, but the nodes currently skipped might
be returned somewhere along the path.
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2008 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>
=head1 REPOSITORY INFORMATION
$Rev: 239 $
$LastChangedBy: kutterma $
$Id: Client.pm 239 2007-09-11 09:45:42Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
=cut
+113
View File
@@ -0,0 +1,113 @@
package SOAP::WSDL::Generator::PrefixResolver;
use strict; use warnings;
use Class::Std::Fast::Storable;
my %namespace_prefix_map_of :ATTR(:name<namespace_prefix_map> :default<{}>);
my %namespace_map_of :ATTR(:name<namespace_map> :default<{}>);
my %prefix_of :ATTR(:name<prefix> :default<{}>);
sub resolve_prefix {
my ($self, $type, $namespace, $element) = @_;
return $prefix_of{ $$self }->{ $type }
if not defined($namespace);
return $namespace_prefix_map_of{ $$self }->{ $namespace }
|| ( ($namespace_map_of{ $$self }->{ $namespace })
? join ('::', $prefix_of{ $$self }->{ $type }, $namespace_map_of{ $$self }->{ $namespace })
: $prefix_of{ $$self }->{ $type }
);
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::Generator::PrefixResolver - prefixes for different classes
=head1 SYNOPSIS
If you want to create your custom prefix resolver:
package MyPrefixResolver;
use strict; use warnings;
use base qw(SOAP::WSDL::Generator::PrefixResolver);
sub resolve_prefix {
my ($self, $type, $namespace, $node) = @_;
# return something special
return $self->SUPER::resolve_prefix($type, $namespace, $node);
}
When generating code:
use MyPrefixResolver;
use SOAP::WSDL::Generator::XSD;
my $generator = SOAP::WSDL::Generator::Template::XSD->new({
prefix_resolver_class => 'MyPrefixResolver',
});
=head1 DESCRIPTION
Prefix resolver class for SOAP::WSDL's code generator. You may subclass it to
apply some custom prefix resolving logic.
Subclasses must implement the following methods:
=over
=item * resolve_prefix
sub resolve_prefix {
my ($self, $namespace, $node) = @_;
# ...
}
resolve_prefix is expected to return a (perl class) prefis. It is called with
the following parameters:
NAME DESCRIPTION
-----------------------------------------------------------------------------
type One of (server|interface|typemap|type|element|attribute)
namespace The targetNamespace of the node to generate a prefix for.
node The node to generate a prefix for
You usually just need type and namespace for prefix resolving. node is
provided for rather funky setups, where you have to choose different prefixes
based on type names or whatever.
Note that node may be of any of the following classes:
SOAP::WSDL::Service
SOAP::WSDL::XSD::Attribute
SOAP::WSDL::XSD::Element
SOAP::WSDL::XSD::Type
Note that both namespace and node may be undef - you should test for
definedness before doing anything fancy with them.
=back
=head1 LICENSE AND COPYRIGHT
Copyright 2008 Martin Kutter.
This library is free software. You may distribute/modify it under
the same terms as perl itself
=head1 AUTHOR
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 583 $
$LastChangedBy: kutterma $
$Id: $
$HeadURL: $
=cut
+32 -30
View File
@@ -2,20 +2,25 @@ package SOAP::WSDL::Generator::Template;
use strict;
use Template;
use Class::Std::Fast::Storable;
use Carp;
use SOAP::WSDL::Generator::PrefixResolver;
our $VERSION=q{2.00_25};
use version; our $VERSION = qv(2.00_33);
my %tt_of :ATTR(:get<tt>);
my %definitions_of :ATTR(:name<definitions> :default<()>);
my %server_prefix_of :ATTR(:name<server_prefix> :default<MyServer>);
my %interface_prefix_of :ATTR(:name<interface_prefix> :default<MyInterfaces>);
my %typemap_prefix_of :ATTR(:name<typemap_prefix> :default<MyTypemaps>);
my %type_prefix_of :ATTR(:name<type_prefix> :default<MyTypes>);
my %element_prefix_of :ATTR(:name<element_prefix> :default<MyElements>);
my %INCLUDE_PATH_of :ATTR(:name<INCLUDE_PATH> :default<()>);
my %EVAL_PERL_of :ATTR(:name<EVAL_PERL> :default<0>);
my %RECURSION_of :ATTR(:name<RECURSION> :default<0>);
my %OUTPUT_PATH_of :ATTR(:name<OUTPUT_PATH> :default<.>);
my %definitions_of :ATTR(:name<definitions> :default<()>);
my %server_prefix_of :ATTR(:name<server_prefix> :default<MyServer>);
my %interface_prefix_of :ATTR(:name<interface_prefix> :default<MyInterfaces>);
my %typemap_prefix_of :ATTR(:name<typemap_prefix> :default<MyTypemaps>);
my %type_prefix_of :ATTR(:name<type_prefix> :default<MyTypes>);
my %element_prefix_of :ATTR(:name<element_prefix> :default<MyElements>);
my %attribute_prefix_of :ATTR(:name<attribute_prefix> :default<MyAttributes>);
my %INCLUDE_PATH_of :ATTR(:name<INCLUDE_PATH> :default<()>);
my %EVAL_PERL_of :ATTR(:name<EVAL_PERL> :default<0>);
my %RECURSION_of :ATTR(:name<RECURSION> :default<0>);
my %OUTPUT_PATH_of :ATTR(:name<OUTPUT_PATH> :default<.>);
my %prefix_resolver_class_of :ATTR(:name<prefix_resolver_class> :default<SOAP::WSDL::Generator::PrefixResolver>);
sub START {
my ($self, $ident, $arg_ref) = @_;
@@ -39,31 +44,28 @@ sub _process :PROTECTED {
$tt->process( $template,
{
context => {
namespace_prefix_map => {
'http://www.w3.org/2001/XMLSchema' => 'SOAP::WSDL::XSD::Typelib::Builtin',
},
namespace_map => {
},
prefix => {
interface => $self->get_interface_prefix,
element => $self->get_element_prefix,
server => $self->get_server_prefix,
type => $self->get_type_prefix,
typemap => $self->get_typemap_prefix,
}
prefix_resolver => $prefix_resolver_class_of{ $$self }->new({
namespace_prefix_map => {
'http://www.w3.org/2001/XMLSchema' => 'SOAP::WSDL::XSD::Typelib::Builtin',
},
namespace_map => {
},
prefix => {
interface => $self->get_interface_prefix,
element => $self->get_element_prefix,
attribute => $self->get_attribute_prefix,
server => $self->get_server_prefix,
type => $self->get_type_prefix,
typemap => $self->get_typemap_prefix,
}
}),
},
definitions => $self->get_definitions,
interface_prefix => $self->get_interface_prefix,
server_prefix => $self->get_server_prefix,
type_prefix => $self->get_type_prefix,
typemap_prefix => $self->get_typemap_prefix,
TYPE_PREFIX => $self->get_type_prefix,
element_prefix => $self->get_element_prefix,
NO_POD => delete $arg_ref->{ NO_POD } ? 1 : 0 ,
%{ $arg_ref }
},
$output)
or die $INCLUDE_PATH_of{ $ident }, '\\', $template, ' ', $tt->error();
or croak $INCLUDE_PATH_of{ $ident }, '\\', $template, ' ', $tt->error();
}
1;
+164 -29
View File
@@ -1,61 +1,196 @@
package SOAP::WSDL::Generator::Template::Plugin::XSD;
use strict;
use warnings;
use Carp qw(confess);
use Class::Std::Fast::Storable constructor => 'none';
my %namespace_prefix_map_of :ATTR(:name<namespace_prefix_map> :default<{}>);
my %namespace_map_of :ATTR(:name<namespace_map> :default<{}>);
my %prefix_of :ATTR(:name<prefix> :default<()>);
my %namespace_prefix_map_of :ATTR(:name<namespace_prefix_map> :default<{}>);
my %namespace_map_of :ATTR(:name<namespace_map> :default<{}>);
my %prefix_of :ATTR(:name<prefix> :default<()>);
my %prefix_resolver_of :ATTR(:name<prefix_resolver> :default<()>);
# create a singleton
sub load { # called as MyPlugin->load($context)
my ($class, $context, @arg_from) = @_;
my $stash = $context->stash();
my $self = bless \do { my $o = Class::Std::Fast::ID() }, $class;
use Data::Dumper;
# die Data::Dumper::Dumper $stash->{ context };
$self->set_namespace_map( $stash->{ context }->{ namespace_map });
$self->set_namespace_prefix_map( $stash->{ context }->{ namespace_prefix_map });
$self->set_prefix( $stash->{ context }->{ prefix });
# $self->set_namespace_map( $stash->{ context }->{ namespace_map });
# $self->set_namespace_prefix_map( $stash->{ context }->{ namespace_prefix_map });
# $self->set_prefix( $stash->{ context }->{ prefix });
$self->set_prefix_resolver( $stash->{ context }->{ prefix_resolver });
return $self; # returns 'MyPlugin'
}
sub new {
return shift;
return shift if ref $_[0];
my ($class, $arg_ref) = @_;
my $self = bless \do { my $o = Class::Std::Fast::ID() }, $class;
# $self->set_namespace_map( $arg_ref->{ namespace_map });
# $self->set_namespace_prefix_map( $arg_ref->{ namespace_prefix_map });
# $self->set_prefix( $arg_ref->{ prefix });
$self->set_prefix_resolver( $arg_ref->{ prefix_resolver });
return $self; # returns 'MyPlugin'
}
sub _get_prefix {
my ($self, $type, $namespace) = @_;
return $namespace_prefix_map_of{ $$self }->{ $namespace }
|| ( ($namespace_map_of{ $$self }->{ $namespace })
? join ('::', $prefix_of{ $$self }->{ $type }, $namespace_map_of{ $$self }->{ $namespace })
: $prefix_of{ $$self }->{ $type }
)
|| $prefix_of{ $$self }->{ $type };
my ($self, $type, $node) = @_;
my $namespace = defined ($node)
? ref($node)
? $node->get_targetNamespace
: $node
: undef;
return $self->get_prefix_resolver->resolve_prefix(
$type,
$namespace,
ref($node)
? $node
: undef
);
}
sub get_element_prefix {
shift->_get_prefix( 'element', shift );
#sub _get_prefix {
# my ($self, $type, $namespace) = @_;
# return $prefix_of{ $$self }->{ $type }
# if not defined($namespace);
# return $namespace_prefix_map_of{ $$self }->{ $namespace }
# || ( ($namespace_map_of{ $$self }->{ $namespace })
# ? join ('::', $prefix_of{ $$self }->{ $type }, $namespace_map_of{ $$self }->{ $namespace })
# : $prefix_of{ $$self }->{ $type }
# );
#}
sub create_xsd_name {
my ($self,$element) = @_;
my $name = $self->_resolve_prefix($element) . '::'
. $element->get_name();
return $self->perl_name( $name );
}
sub get_interface_prefix {
shift->_get_prefix( 'interface', shift );
sub create_typemap_name {
my ($self, $node) = @_;
my $name = $self->_get_prefix('typemap') . '::'
. $node->get_name();
return $self->perl_name( $name );
}
sub get_server_prefix {
shift->_get_prefix( 'server', shift );
sub create_server_name {
my ($self, $server, $port) = @_;
my $port_name = $port->get_name();
$port_name =~s{\A (?:.+)\. ([^\.]+) \z}{$1}x;
my $name = join('::',
$self->_get_prefix('server', $server),
$server->get_name(),
$port_name
);
return $self->perl_name( $name );
}
sub get_type_prefix {
# die "WIX";
shift->_get_prefix( 'type', shift );
sub create_interface_name {
my ($self, $server, $port) = @_;
my $port_name = $port->get_name();
$port_name =~s{\A (?:.+)\. ([^\.]+) \z}{$1}x;
my $name = join('::',
$self->_get_prefix('interface', $server),
$server->get_name(),
$port_name
);
return $self->perl_name( $name );
}
sub get_typemap_prefix {
shift->_get_prefix( 'typemap', shift );
sub _resolve_prefix {
my ($self, $node) = @_;
confess "no node" if not $node;
if ($node->isa('SOAP::WSDL::XSD::Builtin')) {
return $self->_get_prefix('type', $node)
}
if ( $node->isa('SOAP::WSDL::XSD::SimpleType')
or $node->isa('SOAP::WSDL::XSD::ComplexType')
) {
return $self->_get_prefix('type', $node);
}
if ( $node->isa('SOAP::WSDL::XSD::Element') ) {
return $self->_get_prefix('element', $node);
}
if ( $node->isa('SOAP::WSDL::XSD::Attribute') ) {
return $self->_get_prefix('attribute', $node);
}
}
sub perl_name {
my $self = shift;
my $name = shift;
$name =~s{[\-]}{_}xmsg;
$name =~s{[\.]}{::}xmsg;
return $name;
}
sub create_subpackage_name {
my $self = shift;
my $arg_ref = shift;
my $type = ref $arg_ref eq 'HASH' ? $arg_ref->{ value } : $arg_ref;
my @name_from = $type->get_name() || (); ;
my $parent = $type;
my $top_node = $parent;
if (! $parent->get_parent()->isa('SOAP::WSDL::XSD::Schema') ) {
NAMES: while ($parent = $parent->get_parent()) {
$top_node = $parent;
last NAMES if $parent->get_parent()->isa('SOAP::WSDL::XSD::Schema');
# skip empty names - atomic types have no name...
unshift @name_from, $parent->get_name()
if $parent->get_name();
}
}
# create name for top node
my $top_node_name = $self->create_xsd_name($top_node);
my $package_name = join('::_', $top_node_name , (@name_from) ? join('::', @name_from) : () );
return $package_name;
}
sub create_xmlattr_name {
return join '::', shift->create_subpackage_name(shift), 'XmlAttr';
}
sub error {}
1;
=pod
=head1 NAME
SOAP::WSDL::Generator::Template::Plugin::XSD - Template plugin for the XSD generator
=head1 METHODS
=head2 perl_name
XSD.perl_name(element.get_name);
Converts a XML name into a valid perl name (valid for subroutines, variables
or the like).
perl_name takes a crude approach by just replacing . and - (dot and dash)
with a underscore. This may or may not be sufficient, and may or may not
provoke collisions in your XML names.
=head1 LICENSE AND COPYRIGHT
Copyright 2008 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>
=head1 REPOSITORY INFORMATION
$Rev: 564 $
$LastChangedBy: kutterma $
$Id: ComplexType.pm 564 2008-02-23 13:31:39Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm $
=cut
+88 -67
View File
@@ -9,10 +9,11 @@ our $VERSION = q{2.00_27};
use SOAP::WSDL::Generator::Visitor::Typemap;
use SOAP::WSDL::Generator::Visitor::Typelib;
use SOAP::WSDL::Generator::Template::Plugin::XSD;
use base qw(SOAP::WSDL::Generator::Template);
my %output_of :ATTR(:name<output> :default<()>);
my %typemap_of :ATTR(:name<typemap> :default<({})>);
my %output_of :ATTR(:name<output> :default<()>);
my %typemap_of :ATTR(:name<typemap> :default<({})>);
sub BUILD {
my ($self, $ident, $arg_ref) = @_;
@@ -50,89 +51,76 @@ sub generate {
my $self = shift;
my $opt = shift;
$self->generate_typelib( $opt );
# $self->generate_interface( $opt );
$self->generate_typemap( $opt );
}
sub generate_typelib {
my ($self, $arg_ref) = @_;
# $output_of{ ident $self } = "";
my @schema = exists $arg_ref->{ schema }
? @{ $arg_ref->{schema} }
: @{ $self->get_definitions()->first_types()->get_schema() };
for my $type (map { @{ $_->get_type() } , @{ $_->get_element() } } @schema[1..$#schema] ) {
for my $type (map {
@{ $_->get_type() } ,
@{ $_->get_element() },
@{ $_->get_attribute() }
} @schema[1..$#schema] ) {
$type->_accept( $self );
}
# return $output_of{ ident $self };
return;
}
sub _generate_interface {
my $self = shift;
my $arg_ref = shift;
my $template_name = delete $arg_ref->{ template_name };
my $prefix_method = delete $arg_ref->{ prefix_method };
for my $service (@{ $self->get_definitions->get_service }) {
for my $port (@{ $service->get_port() }) {
# Skip ports without (known) address
next if not $port->first_address;
next if not $port->first_address->isa('SOAP::WSDL::SOAP::Address');
my $port_name = $port->get_name;
$port_name =~s{ \A .+\. }{}xms;
my $output = $arg_ref->{ output }
? $arg_ref->{ output }
: $self->_generate_filename(
$self->can($prefix_method)->($self),
$service->get_name(),
$port_name,
);
print "Creating interface class $output\n";
$self->_process($template_name,
{
service => $service,
port => $port,
NO_POD => $arg_ref->{ NO_POD } ? 1 : 0 ,
},
$output, binmode => ':utf8');
}
}
}
sub generate_server {
my $self = shift;
my $ident = ident $self;
my $arg_ref = shift;
for my $service (@{ $self->get_definitions->get_service }) {
for my $port (@{ $service->get_port() }) {
# Skip ports without (known) address
next if not $port->first_address;
next if not $port->first_address->isa('SOAP::WSDL::SOAP::Address');
my $port_name = $port->get_name;
$port_name =~s{ \A .+\. }{}xms;
my $output = $arg_ref->{ output }
? $arg_ref->{ output }
: $self->_generate_filename(
$self->get_server_prefix(),
$service->get_name(),
$port_name,
);
print "Creating interface class $output\n";
$self->_process('Server.tt',
{
service => $service,
port => $port,
NO_POD => $arg_ref->{ NO_POD } ? 1 : 0 ,
},
$output, binmode => ':utf8');
}
}
my ($self, $arg_ref) = @_;
$arg_ref->{ template_name } = 'Server.tt';
$arg_ref->{ prefix_method } = 'get_server_prefix';
$self->_generate_interface($arg_ref);
}
sub generate_interface {
my $self = shift;
my $ident = ident $self;
my $arg_ref = shift;
for my $service (@{ $self->get_definitions->get_service }) {
for my $port (@{ $service->get_port() }) {
# Skip ports without (known) address
next if not $port->first_address;
next if not $port->first_address->isa('SOAP::WSDL::SOAP::Address');
my $port_name = $port->get_name;
$port_name =~s{ \A .+\. }{}xms;
my $output = $arg_ref->{ output }
? $arg_ref->{ output }
: $self->_generate_filename(
$self->get_interface_prefix(),
$service->get_name(),
$port_name,
);
print "Creating interface class $output\n";
$self->_process('Interface.tt',
{
service => $service,
port => $port,
NO_POD => $arg_ref->{ NO_POD } ? 1 : 0 ,
},
$output, binmode => ':utf8');
}
}
sub generate_client {
my ($self, $arg_ref) = @_;
$arg_ref->{ template_name } = 'Interface.tt';
$arg_ref->{ prefix_method } = 'get_interface_prefix';
$self->_generate_interface($arg_ref);
}
sub generate_interface;
*generate_interface = \&generate_client;
sub generate_typemap {
my ($self, $arg_ref) = @_;
my $visitor = SOAP::WSDL::Generator::Visitor::Typemap->new({
type_prefix => $self->get_type_prefix(),
element_prefix => $self->get_element_prefix(),
@@ -144,10 +132,35 @@ sub generate_typemap {
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
%{ $typemap_of{ident $self }},
}
},
resolver => SOAP::WSDL::Generator::Template::Plugin::XSD->new({
prefix_resolver => $self->get_prefix_resolver_class()->new({
namespace_prefix_map => {
'http://www.w3.org/2001/XMLSchema' => 'SOAP::WSDL::XSD::Typelib::Builtin',
},
namespace_map => {
},
prefix => {
interface => $self->get_interface_prefix,
element => $self->get_element_prefix,
server => $self->get_server_prefix,
type => $self->get_type_prefix,
typemap => $self->get_typemap_prefix,
}
})
}),
});
use SOAP::WSDL::Generator::Iterator::WSDL11;
my $iterator = SOAP::WSDL::Generator::Iterator::WSDL11->new({
definitions => $self->get_definitions });
for my $service (@{ $self->get_definitions->get_service }) {
$visitor->visit_Service( $service );
$iterator->init({ node => $service });
while (my $node = $iterator->get_next()) {
$node->_accept( $visitor );
}
my $output = $arg_ref->{ output }
? $arg_ref->{ output }
: $self->_generate_filename( $self->get_typemap_prefix(), $service->get_name() );
@@ -171,6 +184,14 @@ sub _generate_filename :PRIVATE {
return "$name.pm";
}
sub visit_XSD_Attribute {
my ($self, $attribute) = @_;
my $output = defined $output_of{ ident $self }
? $output_of{ ident $self }
: $self->_generate_filename( $self->get_attribute_prefix(), $attribute->get_name() );
$self->_process('attribute.tt', { attribute => $attribute } , $output);
}
sub visit_XSD_Element {
my ($self, $element) = @_;
my $output = defined $output_of{ ident $self }
@@ -1,8 +1,5 @@
[% USE XSD -%]
[% interface_name = interface_prefix _ '::'
_ service.get_name.replace('\.', '::') _ '::'
_ port.get_name.replace('^.+\.','');
interface_name = interface_name.replace('-','_'); -%]
[% interface_name = XSD.create_interface_name(service, port) -%]
package [% interface_name %];
use strict;
use warnings;
@@ -11,20 +8,20 @@ use Scalar::Util qw(blessed);
use base qw(SOAP::WSDL::Client::Base);
# only load if it hasn't been loaded before
require [% typemap_prefix %]::[% service.get_name.replace('\.', '::').replace('-', '_') %]
if not [% typemap_prefix %]::[% service.get_name.replace('\.', '::').replace('-', '_') %]->can('get_class');
require [% XSD.create_typemap_name(service) %]
if not [% XSD.create_typemap_name(service) %]->can('get_class');
sub START {
$_[0]->set_proxy('[% port.first_address.get_location %]') if not $_[2]->{proxy};
$_[0]->set_class_resolver('[% typemap_prefix %]::[% service.get_name.replace('\.', '::').replace('-', '_') %]')
$_[0]->set_class_resolver('[% XSD.create_typemap_name(service) %]')
if not $_[2]->{class_resolver};
}
[% binding = definitions.find_binding( port.expand( port.get_binding ) );
FOREACH operation = binding.get_operation;
%][% INCLUDE Interface/Operation.tt %]
[%
[%
END;
%]
@@ -83,7 +80,6 @@ All arguments are forwarded to L<SOAP::WSDL::Client|SOAP::WSDL::Client>.
[% INCLUDE Interface/POD/method_info.tt %]
[% FOREACH operation = binding.get_operation;
%][% INCLUDE Interface/POD/Operation.tt %]
[% END %]
@@ -1,14 +1,12 @@
[% RETURN IF NOT item;
type = definitions.find_portType( binding.expand( binding.get_type ) );
port_op = type.find_operation( definitions.get_targetNamespace, operation.get_name );
port_op = type.find_operation( type.get_targetNamespace, operation.get_name );
message = definitions.find_message( port_op.first_input.expand( port_op.first_input.get_message ) );
part_from = message.get_part;
PERL %]
my $item = $stash->{ item };
my $def = $stash->{ definitions };
my $part_from = $stash->{ part_from };
my $type_prefix = $stash->{ type_prefix };
my $element_prefix = $stash->{ element_prefix };
my $part_from = $stash->{ message }->get_part();
my @body_part_from = split m{\s}, $item->get_parts;
@@ -25,14 +23,17 @@
my $name;
($name = $part->get_element)
? do {
$name =~s{ ^[^:]+: }{}xms;
$element_prefix . '::' . $name;
}
my $element = $def->first_types->find_element($part->expand($name));
my $resolver = $context->plugin('XSD');
$resolver->create_xsd_name($element);
}
: ($name = $part->get_type)
? do {
$name =~s{ ^[^:]+: }{}xms;
$type_prefix . '::' . $name;
}
my $element = $def->first_types->find_type($part->expand($name));
my $resolver = $context->plugin('XSD');
$resolver->create_xsd_name($element);
}
: die "input must have either type or element"
}
: ()
@@ -44,13 +45,15 @@
my $name;
($name = $part->get_element)
? do {
$name =~s{ ^[^:]+: }{}xms;
"$element_prefix\::$name"
}
my $element = $def->first_types->find_element($part->expand($name));
my $resolver = $context->plugin('XSD');
$resolver->create_xsd_name($element);
}
: ($name = $part->get_type)
? do {
$name =~s{ ^[^:]+: }{}xms;
"$type_prefix\::$name"
my $element = $def->first_types->find_type($part->expand($name));
my $resolver = $context->plugin('XSD');
$resolver->create_xsd_name($element);
}
: die "input must have either type or element";
} @{ $part_from };
@@ -63,7 +66,10 @@
$stash->{ parts } = \@parts;
[% END %]
'use' => '[% item.get_use %]',
namespace => '[% item.get_namespace %]',
encodingStyle => '[% item.get_encodingStyle %]',
parts => [qw( [% parts.join(' ') %] )],
[% IF item.get_use != 'literal';
THROW NOT_SUPPORTED "Body: SOAP::WSDL supports literal encoding only - ${ item.get_use } found";
END %]
'use' => '[% item.get_use %]',
namespace => '[% item.get_namespace %]',
encodingStyle => '[% item.get_encodingStyle %]',
parts => [qw( [% parts.join(' ') %] )],
@@ -19,19 +19,25 @@
my $name;
($name = $part->get_element)
? do {
$name =~s{ ^[^:]+: }{}xms;
$element_prefix . '::' . $name;
my $element = $def->first_types->find_element($part->expand($name));
my $resolver = $context->plugin('XSD');
$resolver->create_xsd_name($element);
}
: ($name = $part->get_type)
? do {
$name =~s{ ^[^:]+: }{}xms;
$type_prefix . '::' . $name;
}
my $element = $def->first_types->find_type($part->expand($name));
my $resolver = $context->plugin('XSD');
$resolver->create_xsd_name($element);
}
: die "input must have either type or element"
};
$stash->{ part_class } = $part_class;
[% END;
%]
%]
[% IF item.get_use != 'literal';
THROW NOT_SUPPORTED "Header: SOAP::WSDL supports literal encoding only - ${ item.get_use } found";
END %]
'use' => '[% item.get_use %]',
namespace => '[% item.get_namespace %]',
encodingStyle => '[% item.get_encodingStyle %]',
@@ -4,7 +4,12 @@ sub [% operation.get_name %] {
return $self->SUPER::call({
operation => '[% operation.get_name %]',
soap_action => '[% operation.first_operation.get_soapAction %]',
style => '[% operation.get_style || binding.get_style %]',
style => [% style = operation.first_operation.get_style || binding.get_style;
IF style != "document";
THROW NOT_SUPPORTED "SOAP::WSDL supports document encoding only - $style found";
END;
-%]
'[% style %]',
body => {
[% INCLUDE Interface/Body.tt( item = operation.first_input.first_body ); %]
},
@@ -5,3 +5,12 @@ of the corresponding class can be passed instead of the marked hash ref.
You may pass any combination of objects, hash and list refs to these
methods, as long as you meet the structure.
List items (i.e. multiple occurences) are not displayed in the synopsis.
You may generally pass a list ref of hash refs (or objects) instead of a hash
ref - this may result in invalid XML if used improperly, though. Note that
SOAP::WSDL always expects list references at maximum depth position.
XML attributes are not displayed in this synopsis and cannot be set using
hash refs. See the respective class' documentation for additional information.
@@ -0,0 +1,2 @@
[% node.get_annotation.0.get_documentation %]
@@ -1,7 +1,6 @@
[% server_name = server_prefix _ '::'
_ service.get_name.replace('\.', '::') _ '::'
_ port.get_name.replace('^.+\.','');
server_name = server_name.replace('-','_'); -%]
[% USE XSD;
server_name = XSD.create_server_name(service, port);
-%]
package [% server_name %];
use strict;
use warnings;
@@ -10,8 +9,8 @@ use Scalar::Util qw(blessed);
use base qw(SOAP::WSDL::Client::Base);
# only load if it hasn't been loaded before
require [% typemap_prefix %]::[% service.get_name.replace('\.', '::') %]
if not [% typemap_prefix %]::[% service.get_name.replace('\.', '::') %]->can('get_class');
require [% XSD.create_typemap_name(service) %]
if not [% XSD.create_typemap_name(service) %]->can('get_class');
my %transport_class_of :ATTR(:name<transport_class> :default<SOAP::WSDL::Server::CGI>);
my %transport_of :ATTR(:name<transport> :default<()>);
@@ -31,13 +30,13 @@ sub START {
or die "Cannot load transport class $transport_class_of{ $ident }: $@";
$transport_of{ $ident } = $transport_class_of{ $ident }->new({
action_map_ref => $action_map_ref,
class_resolver => '[% typemap_prefix %]::[% service.get_name.replace('\.', '::') %]',
class_resolver => '[% XSD.create_typemap_name(service) %]',
dispatch_to => $dispatch_to{ $ident },
});
}
sub handle {
$transport_of{ ${ $_[0] } }->handle();
$transport_of{ ${ shift @_ } }->handle(@_);
}
1;
@@ -3,7 +3,7 @@
#element;
#STOP;
-%]
[% element_prefix %]::[% element.get_name.replace('\.', '::') %]->new([%
[% XSD.create_xsd_name(element) %]->new([%
type = element.first_complexType || element.first_simpleType || definitions.first_types.find_type(
element.expand( element.get_type ) );
INCLUDE Interface/POD/Type.tt; %]
@@ -1,4 +1,5 @@
package [% typemap_prefix %]::[% service.get_name.replace('\.','::') %];
[% USE XSD %]
package [% XSD.create_typemap_name(service) %];
use strict;
use warnings;
@@ -27,7 +28,7 @@ __END__
[% head1 %] NAME
[% typemap_prefix %]::[% service.get_name.replace('\.','::').replace('-', '_') %]; - typemap for ::[% service.get_name %];
[% XSD.create_typemap_name(service) %] - typemap for [% service.get_name %]
[% head1 %] DESCRIPTION
@@ -1,6 +0,0 @@
[% type_name = node.expand( type );
IF (type_name.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
SOAP::WSDL::XSD::Typelib::Builtin::[% type_name.1 %]
[% ELSE -%]
[% type_prefix %]::[% type_name.1 %]
[% END -%]
@@ -0,0 +1,83 @@
[% USE XSD(context) %]
package [% XSD.create_xsd_name(attribute) %];
use strict;
use warnings;
{ # BLOCK to scope variables
sub get_xmlns { '[% attribute.get_targetNamespace %]' }
__PACKAGE__->__set_name('[% attribute.get_name %]');
__PACKAGE__->__set_ref([% IF attribute.get_ref; %]'[% attribute.get_ref %]'[% END %]);
[%- IF (type_name = attribute.get_type); -%]
use base qw(
SOAP::WSDL::XSD::Typelib::Attribute
[% type = definitions.get_types.0.find_type(attribute.expand(type_name));
IF ! type;
THROW NOT_FOUND "type " _ type_name _ " not found in attribute " _ attribute.get_name;
END;
XSD.create_xsd_name(type) %]
);
}
[%- ELSIF (ref = attribute.get_ref);
ref_from = ref.split(':');
-%]
# attribute ref="[% ref %]"
use base qw(
[% ref_element = definitions.get_types.0.find_attribute(attribute.expand(ref));
XSD.create_xsd_name( ref_element ); %]
);
}
[%- ELSIF (simpleType = attribute.first_simpleType) %]
# atomic simpleType: <attribute><simpleType
use base qw(
SOAP::WSDL::XSD::Typelib::Attribute
);
[% INCLUDE simpleType/contentModel.tt -%]
}
[% END %]
1;
[%# work around for CPAN's indexer, which gets disturbed by pod in templates -%]
[% pod = BLOCK %]=pod[% END -%]
[% head1 = BLOCK %]=head1[% END -%]
[% head2 = BLOCK %]=head2[% END -%]
[% head3 = BLOCK %]=head3[% END -%]
[% pod %]
[% head1 %] NAME
[% XSD.create_xsd_name(attribute) %]
[% head1 %] DESCRIPTION
Perl data type class for the XML Schema defined attribute
[% attribute.get_name %] from the namespace [% attribute.get_targetNamespace %].
[% INCLUDE POD/annotation.tt(node = attribute) %]
[% INCLUDE element/POD/contentModel.tt(element = attribute) %]
[% head1 %] METHODS
[% head2 %] new
my $element = [% XSD.create_xsd_name(attribute) %]->new($data);
Constructor. The following data structure may be passed to new():
{ value => $value }
[% head1 %] AUTHOR
Generated by SOAP::WSDL
=cut
@@ -1,13 +1,15 @@
[% USE XSD(context) -%]
package [% type_prefix %]::[% complexType.get_name.replace('\.','::').replace('-','_') %];
[% USE XSD -%]
package [% XSD.create_xsd_name(complexType) %];
use strict;
use warnings;
[% INCLUDE complexType/contentModel.tt %]
[%#
# Don't include any perl source here - there may be sub-packages...
# Don't include any perl source for this package below this line - there
# may be sub-packages...
#-%]
[% INCLUDE complexType/attributeSet.tt %]
[% INCLUDE complexType/contentModel.tt %]
1;
[%# work around for CPAN's indexer, which gets disturbed by pod in templates -%]
@@ -20,22 +22,35 @@ use warnings;
[% head1 %] NAME
[% type_prefix %]::[% complexType.get_name.replace('\.','::').replace('-','_') %]
[% XSD.create_xsd_name(complexType) %]
[% head1 %] DESCRIPTION
Perl data type class for the XML Schema defined complextype
Perl data type class for the XML Schema defined complexType
[% complexType.get_name %] from the namespace [% complexType.get_targetNamespace %].
[% INCLUDE POD/annotation.tt(node = complexType) %]
[% IF (complexType.get_element); %]
[% head2 %] PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
=over
[% FOREACH element = complexType.get_element -%]
[% element.get_name %]
=item * [% element.get_name %]
[% IF element.get_annotation.get_documentation; %]
[% element.get_annotation.get_documentation %]
[% END -%]
[% END %]
=back
[% END -%]
[% head1 %] METHODS
[% head2 %] new
@@ -44,6 +59,8 @@ Constructor. The following data structure may be passed to new():
[% indent = ' '; INCLUDE complexType/POD/structure.tt %]
[% INCLUDE complexType/POD/attributeSet.tt %]
[% head1 %] AUTHOR
Generated by SOAP::WSDL
@@ -1,5 +1,5 @@
[% indent %]{
[%- IF complexType.get_name %] # [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %][% END %]
{
[%- IF complexType.get_name %] # [% XSD.create_xsd_name(complexType) %][% END %]
[%- indent = indent _ ' ';
FOREACH element = complexType.get_element %]
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
@@ -0,0 +1,34 @@
[% head2 = BLOCK %]=head2[% END -%]
[% IF (complexType.get_attribute.size) %]
[% head2 %] attr
NOTE: Attribute documentation is experimental, and may be inaccurate.
See the correspondent WSDL/XML Schema if in question.
This class has additional attributes, accessibly via the C<attr()> method.
attr() returns an object of the class [% XSD.create_xmlattr_name(complexType) %].
The following attributes can be accessed on this object via the corresponding
get_/set_ methods:
=over
[% FOREACH element = complexType.get_attribute -%]
=item * [% element.get_name %]
[%- IF (element.get_annotation && element.get_annotation.0.get_documentation) %]
[% element.get_annotation.0.get_documentation %]
[% END; %]
[% IF (type_name=element.get_type);
type = definitions.get_types.0.find_type(element.expand(type_name));
IF (! type);
THROW NOT_FOUND "type " _ type_name _ " for attribute " _ element.get_name _ " not found";
END; %]
This attribute is of type L<[% XSD.create_xsd_name(type) %]|[% XSD.create_xsd_name(type) %]>.
[% END %]
[%- END -%]
[% END %]
@@ -1,5 +1,5 @@
[% indent %]{
[%- IF complexType.get_name %] # [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %][% END %]
[%- IF complexType.get_name %] # [% XSD.create_xsd_name(complexType) %][% END %]
[%- indent = indent _ ' ' %]
[% indent %]# One of the following elements.
[% indent %]# No occurance checks yet, so be sure to pass just one...
@@ -1,5 +1,5 @@
[% indent %]{
[%- IF complexType.get_name %] # [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %][% END %]
[%- IF complexType.get_name %] # [% XSD.create_xsd_name(complexType) %][% END %]
[%- indent = indent _ ' ';
FOREACH element = complexType.get_element %]
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
@@ -1,10 +1,7 @@
[% IF (complexType.get_variety == 'restriction');
INCLUDE complexType/POD/restriction.tt(complexType = complexType);
INCLUDE complexType/POD/simpleContent/restriction.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'extension');
#THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType complexContent extension not implemented yet";
%]
# No documentation generated for complexContent / extension yet
[%
INCLUDE complexType/POD/simpleContent/restriction.tt(complexType = complexType);
ELSE;
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
END;
@@ -0,0 +1 @@
# No documentation generated for simpleContent / extension yet
@@ -0,0 +1,46 @@
{
value => $some_value, # simple perl scalar. See below for restrictions
}
NOTE: This type is derived by restriction as complexType with simpleContent.
Documentation generation for this derivation method is experimental and may
be erroneous/incomplete.
This clase is derived from [%-
IF (name = complexType.get_base);
# type_name = complexType.expand( name );
-%]
[% XSD.create_xsd_name(complexType) %]
[% ELSE;
%] an atomic base type. Unfortunately there's no documentation generated
on atomic base types' base type yet.[%
END -%]
SOAP::WSDL's schema implementation does not validate data yet - however, the
following restrictions apply for this type's value:
[%- FOREACH facet = [
'length',
'minLength',
'maxLength',
'totalDigits',
'fractionDigits',
'minInclusive',
'maxInclusive',
'minExclusive',
'maxExclusive',
'pattern',
'enumeration'
];
IF (facet_method = complexType.can( "get_" _ facet ));
facet_value = facet_method( complexType );
IF (facet_value.size());
%]
[% IF (facet == 'enumeration');
%]valid values (enumeration)
[%- ELSE;
facet;
END -%]:[% FOREACH value = facet_value %] [% value.get_value; END -%]
[% END;
END;
END %]
@@ -7,7 +7,7 @@ ELSIF (complexType.get_variety == 'group');
ELSIF (complexType.get_variety == 'choice');
INCLUDE complexType/POD/choice.tt(complexType = complexType);
ELSIF (complexType.get_contentModel == 'simpleContent');
INCLUDE complexType/POD/simpleContent.tt(complexType = complexType);
INCLUDE complexType/POD/structure/simpleContent.tt(complexType = complexType);
ELSIF (complexType.get_contentModel == 'complexContent');
INCLUDE complexType/POD/complexContent.tt(complexType = complexType);
END %],
END -%],
@@ -0,0 +1,7 @@
{
[%- IF complexType.get_name %] # [% XSD.create_xsd_name(complexType) %][% END %]
[%- indent = indent _ ' ';
FOREACH element = complexType.get_element %]
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
[% END %]
[% indent.replace('\s{2}$', ''); %]}
@@ -0,0 +1 @@
{ value => $some_value }
@@ -8,7 +8,7 @@ Class::Std::initialize();
atomic_types = {};
FOREACH element = complexType.get_element %]
my %[% element.get_name %]_of :ATTR(:get<[% element.get_name %]>);
my %[% XSD.perl_name(element.get_name) %]_of :ATTR(:get<[% XSD.perl_name(element.get_name) %]>);
[%- END %]
__PACKAGE__->_factory(
@@ -18,23 +18,23 @@ __PACKAGE__->_factory(
) ],
{
[% FOREACH element = complexType.get_element -%]
[% element.get_name %] => \%[% element.get_name %]_of,
'[% element.get_name %]' => \%[% XSD.perl_name(element.get_name) %]_of,
[% END -%]
},
{
[% FOREACH element = complexType.get_element;
IF (type = element.get_type);
element_type = complexType.expand( type ); -%]
[% element.get_name %] => '[% XSD.get_type_prefix(element_type.0) %]::[% element_type.1 %]',
element_type = definitions.first_types.find_type(complexType.expand( type )); -%]
'[% element.get_name %]' => '[% XSD.create_xsd_name(element_type) %]',
[% ELSE;
IF (element.first_simpleType);
atomic_types.${ element.get_name } = element.first_simpleType;
ELSIF (element.first_complexType);
atomic_types.${ element.get_name } = element.first_complexType;
ELSE;
THROW NOT_IMPLEMENTED , "Neither simple nor complex atomic type - don't know what to do with it";
THROW NOT_IMPLEMENTED , "Neither simple nor complex atomic type for element ${ element.get_name } - don't know what to do with it";
END; %]
[% element.get_name %] => '[% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %]::_[% element.get_name %]',
'[% element.get_name %]' => '[% XSD.create_subpackage_name({ value => element }) %]',
[% END;
END -%]
}
@@ -1,7 +1,7 @@
[% FOREACH type IN atomic_types; %]
package [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %]::_[% type.key %];
[%# TODO generate name create_name method %]
package [% XSD.create_subpackage_name(type); %];
use strict;
use warnings;
{
@@ -1,16 +1,15 @@
[% IF (complexType.get_attribute.size) %]
package [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
[% IF (complexType.get_attribute.size) -%]
package [% XSD.create_xmlattr_name(complexType) %];
use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
{ # BLOCK to scope variables
[%
FOREACH element = complexType.get_attribute %]
[% FOREACH element = complexType.get_attribute %]
my %[% element.get_name %]_of :ATTR(:get<[% element.get_name %]>);
[%- END %]
__PACKAGE__->_factory(
[ qw([% FOREACH element = complexType.get_attribute %]
[ qw(
[%- FOREACH element = complexType.get_attribute %]
[% element.get_name -%]
[% END %]
) ],
@@ -22,23 +21,24 @@ __PACKAGE__->_factory(
{
[% FOREACH element = complexType.get_attribute;
IF (type = element.get_type);
element_type = complexType.expand( type );
element_type = definitions.first_types.find_type(complexType.expand( type ));
-%]
[% element.get_name %] => '[% XSD.get_type_prefix(element_type.0) %]::[% element_type.1 %]',
[% element.get_name %] => '[% XSD.create_xsd_name(element_type) %]',
[%
ELSE;
IF (element.first_simpleType);
ELSIF (ref = element.get_ref);
attribute = definitions.first_types.find_attribute( complexType.expand(ref) );
# element_type = definitions.get_types.0.find_type(complexType.expand( attribute.get_type ));
%]
[% attribute.get_name %] => '[% XSD.create_xsd_name(attribute) %]',
[% ELSIF (element.first_simpleType);
THROW NOT_IMPLEMENTED , "Attributes with atomic simpleType definition are not implemented yet";
atomic_types.${ element.get_name } = element.first_simpleType;
ELSE;
THROW NOT_IMPLEMENTED , "Neither simple nor complex atomic type - don't know what to do with it";
END; %]
[% element.get_name %] => '[% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %]::_[% element.get_name %]',
[% END;
ELSE;
THROW NOT_IMPLEMENTED , "Neither simple nor complex atomic type for attribute ${ element.get_name } in ${ complexType.get_name } - don't know what to do with it";
END;
END -%]
}
);
} # end BLOCK
[% END %]
@@ -1,7 +1,19 @@
[% IF (complexType.get_attribute.size) -%]
our $XML_ATTRIBUTE_CLASS = '[% XSD.create_xmlattr_name(complexType) %]';
[% ELSE -%]
our $XML_ATTRIBUTE_CLASS;
undef $XML_ATTRIBUTE_CLASS;
[% END %]
sub __get_attr_class {
return $XML_ATTRIBUTE_CLASS;
}
[% IF (complexType.get_contentModel == 'simpleContent');
INCLUDE complexType/simpleContent.tt(complexType = complexType);
ELSIF (complexType.get_contentModel == 'complexContent');
INCLUDE complexType/complexContent.tt(complexType = complexType);
ELSE;
INCLUDE complexType/variety.tt(complexType = complexType);
END %]
END -%]
[% INCLUDE complexType/attributeSet.tt %]
@@ -20,7 +20,7 @@ END;
complexType.set_element( element_list );
-%]
use base qw([% XSD.get_type_prefix(base_name.0) %]::[% base_name.1.replace('\.', '::') %]);
use base qw([% XSD.create_xsd_name( base_type ) %]);
[%
INCLUDE complexType/variety.tt(complexType = complexType);
@@ -1,7 +1,7 @@
[% IF (base=complexType.get_base);
base_name=complexType.expand(base);
base_type=definitions.get_types.0.find_type(complexType.expand(base));
-%]
use base qw([% XSD.get_type_prefix(base_name.0) %]::[% base_name.1.replace('\.', '::') %]);
use base qw([% XSD.create_xsd_type(base_type) %]);
[%
ELSE;
THROW NOT_IMPLEMENTED, "restriction without base not supported";
@@ -1,8 +1,9 @@
[% IF (complexType.get_variety == 'restriction');
INCLUDE complexType/restriction.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'extension');
THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType simpleContent extension not implemented yet";
INCLUDE complexType/simpleContent/extension.tt(complexType = complexType);
# THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType simpleContent extension not implemented yet";
ELSE;
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
THROW UNKNOWN, "unknown variety ${ complexType.get_variety } in complexType name='${complexType.get_name}'";
END;
%]
@@ -0,0 +1,11 @@
[% IF (base=complexType.get_base);
base_type=definitions.get_types.0.find_type(complexType.expand(base));
-%]
use base qw(
SOAP::WSDL::XSD::Typelib::ComplexType
[% XSD.create_xsd_name(base_type) %]
);
[%
ELSE;
THROW NOT_IMPLEMENTED, "extension without base not supported";
END %]
+14 -15
View File
@@ -1,5 +1,5 @@
[% USE XSD(context) %]
package [% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name.replace('\.','::') %];
package [% XSD.create_xsd_name(element) %];
use strict;
use warnings;
@@ -13,17 +13,21 @@ __PACKAGE__->__set_minOccurs([% element.get_minOccurs %]);
__PACKAGE__->__set_maxOccurs([% element.get_maxOccurs %]);
__PACKAGE__->__set_ref([% IF element.get_ref; %]'[% element.get_ref %]'[% END %]);
[%- IF (type = element.get_type); -%]
[%- IF (type_name = element.get_type); -%]
use base qw(
SOAP::WSDL::XSD::Typelib::Element
[% INCLUDE _type_class.tt( type = type, node = element ) %]
[% type = definitions.get_types.0.find_type(element.expand(type_name));
XSD.create_xsd_name(type) %]
);
}
[%- ELSIF (ref = element.get_ref); -%]
[%- ELSIF (ref = element.get_ref);
ref_from = ref.split(':');
-%]
# element ref="[% ref %]"
use base qw(
[% element_prefix %]::[% ref.split(':').1 %]
[% ref_element = definitions.get_types.0.find_element(element.expand(ref));
XSD.create_xsd_name( ref_element ); %]
);
}
@@ -41,16 +45,9 @@ use base qw(
SOAP::WSDL::XSD::Typelib::Element
SOAP::WSDL::XSD::Typelib::ComplexType
);
[% INCLUDE complexType/contentModel.tt -%]
}
package [% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
[% INCLUDE complexType/attributeSet.tt %]
[% ELSE %]
} # end of BLOCK
[% END %]
@@ -67,18 +64,20 @@ use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
[% head1 %] NAME
[% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name %]
[% XSD.create_xsd_name(element) %]
[% head1 %] DESCRIPTION
Perl data type class for the XML Schema defined element
[% element.get_name %] from the namespace [% element.get_targetNamespace %].
[% INCLUDE POD/annotation.tt(node = element) %]
[% head1 %] METHODS
[% head2 %] new
my $element = [% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name %]->new($data);
my $element = [% XSD.create_xsd_name(element) %]->new($data);
Constructor. The following data structure may be passed to new():
@@ -0,0 +1,8 @@
[% IF (type = element.get_type);
ELSIF (simpleType = element.get_simpleType) %]
This XML element type class has a atomic simpleType as it's base:
[%
INCLUDE simpleType/POD/contentModel.tt(simpleType = simpleType);
ELSIF (simpleType = element.get_complexType);
ELSIF (ref_element = element.get_ref);
END %]
@@ -1,5 +1,5 @@
[% USE XSD(context) -%]
package [% XSD.get_type_prefix(simpleType.get_targetNamespace) %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %];
package [% XSD.create_xsd_name(simpleType) %];
use strict;
use warnings;
@@ -21,20 +21,18 @@ __END__
[% pod %]
[% head1 %] [% XSD.get_type_prefix(simpleType.get_targetNamespace) %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %]
[% head1 %] NAME
[% XSD.create_name(simpleType) %]
[% head1 %] DESCRIPTION
Perl data type class for the XML Schema defined simpleType
[% simpleType.get_name %] from the namespace [% simpleType.get_targetNamespace %].
[% IF (simpleType.get_variety == 'list');
INCLUDE simpleType/POD/list.tt;
ELSIF (simpleType.get_variety == 'restriction');
INCLUDE simpleType/POD/restriction.tt;
ELSE;
THROW NOT_IMPLEMENTED "simpleType union not implemented yet in $simpleType.get_name";
END %]
[% INCLUDE POD/annotation.tt(node = simpleType) %]
[% INCLUDE simpleType/POD/contentModel.tt(simpleType = simpleType) %]
[% head1 %] METHODS
@@ -0,0 +1,9 @@
[% IF (simpleType.get_variety == 'list');
INCLUDE simpleType/POD/list.tt;
ELSIF (simpleType.get_variety == 'restriction');
INCLUDE simpleType/POD/restriction.tt;
ELSIF (simpleType.get_variety == 'union');
INCLUDE simpleType/POD/union.tt;
ELSE;
# THROW NOT_IMPLEMENTED "simpleType " _ simpleType.get_variety _ "not implemented yet in $simpleType.get_name";
END %]
@@ -1,13 +1,9 @@
This clase is derived from
[%-
IF (name = simpleType.get_itemType);
type_name = simpleType.expand( name );
IF (type_name.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
SOAP::WSDL::XSD::Typelib::Builtin::[% type_name.1 %]
[% ELSE -%]
[% type_prefix %]::[% type_name.1 %]
[% END;
ELSE;
type = definitions.get_types.0.find_type(simpleType.expand( name )); %]
[% XSD.create_xsd_name(type) %]
[% ELSE;
# THROW NOT_IMPLEMENTED "atomic simpleType list not implemented yet in $simpleType.get_name";
%] a atomic base type. Unfortunately there's no documenatation generation for atomic base types yet. [%
END -%].
@@ -1,12 +1,8 @@
This clase is derived from [%-
IF (name = simpleType.get_base);
type_name = simpleType.expand( name );
IF (type_name.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
SOAP::WSDL::XSD::Typelib::Builtin::[% type_name.1 %]
[% ELSE -%]
[% type_prefix %]::[% type_name.1 %]
[% END;
ELSE;
type = definitions.get_types.0.find_type(simpleType.expand(name)); %]
[% XSD.create_xsd_name(type); %]
[% ELSE;
# THROW NOT_IMPLEMENTED "atomic simpleType restriction not implemented yet in $simpleType.get_name";
%] a atomic base type. Unfortunately there's no documenatation generation for atomic base types yet. [%
END -%]
@@ -0,0 +1,8 @@
This type class is derived by union.
Derivation by union is not fully supported yet - value space constraints are
not checked yet.
The current implementation of union resorts to inheriting from the base type,
which means (quoted from the XML Schema specs): "If the <list> or <union>
alternative is chosen, then the simple ur-type definition·."
@@ -2,6 +2,8 @@
INCLUDE simpleType/list.tt(simpleType = simpleType);
ELSIF (simpleType.get_variety == 'restriction');
INCLUDE simpleType/restriction.tt(type = simpleType);
ELSIF (simpleType.get_variety == 'union');
INCLUDE simpleType/union.tt(type = simpleType);
ELSE;
THROW NOT_IMPLEMENTED "${ element.get_name } - ${ simpleType.get_variety } not supported yet";
END %]
@@ -1,17 +1,13 @@
[% USE XSD %]
# list derivation
use base qw(
SOAP::WSDL::XSD::Typelib::Builtin::list
[%
IF (name = simpleType.get_itemType);
type_name = simpleType.expand( name );
IF (type_name.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
SOAP::WSDL::XSD::Typelib::Builtin::[% type_name.1 %]
type = definitions.get_types.0.find_type(simpleType.expand( name )); -%]
[% XSD.create_xsd_name(type) %]
);
[% ELSE -%]
[% type_prefix %]::[% type_name.1 %]
);
[% END;
ELSIF (type = simpleType.first_simpleType); %]
[% ELSIF (type = simpleType.first_simpleType); %]
);
[% INCLUDE simpleType/atomicType.tt(type = type);
@@ -1,9 +1,14 @@
# derivation by restriction
[% IF (base = simpleType.get_base) -%]
use base qw(
[% INCLUDE _type_class.tt(type = base, node=simpleType) %]);
[%
base_type = definitions.get_types.0.find_type(simpleType.expand(base));
IF ! base_type;
THROW NOT_FOUND "No base type in " _ simpleType.get_parent.get_name;
END;
XSD.create_xsd_name(base_type) %]);
[% ELSIF (type = simpleType.first_simpleType() );
INCLUDE simpleType/atomicType.tt(type = type);
ELSE;
THROW "neither base nor atomic type - don't know what to do" %]
[% END %]
[% END %]
@@ -0,0 +1,11 @@
# derivation by union
# union is not fully supported yet - value space constraints are not
# checked yet.
# This implementation of union resorts to the simplest possible base, which
# is: "If the <list> or <union> alternative is chosen, then the
# simple ur-type definition·."
#
use base qw(
SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType
);
+15 -12
View File
@@ -77,24 +77,24 @@ Visitor:
package PersonVisitor;
use Class::Std; # handles all basic stuff like constructors etc.
sub visit_Person {
my ( $self, $object ) = @_;
print "Person name is ", $object->get_name(), "\n";
}
package Person;
use Class::Std;
my %name : ATTR(:name<name> :default<anonymous>);
sub accept { $_[1]->visit_Person( $_[0] ) }
package main;
my @person_from = ();
for (qw(Gamma Helm Johnson Vlissides)) {
push @person_from, Person->new( { name => $_ } );
}
my $visitor = PersonVisitor->new();
for (@person_from) {
$_->accept($visitor);
@@ -269,7 +269,7 @@ SOAP::WSDL data classes:
In your Visitor, you must implement visit_Foo methods for all classes you wish
to visit.
Currently, all SOAP::WSDL::Generator::Visitor implementations include their own
The SOAP::WSDL::Generator::Visitor implementations include part of their own
Iterator (which means they know how to find the next objects to visit). You
may or may not choose to implement a separate Iterator.
@@ -279,9 +279,12 @@ easy as writing something like this:
my $visitor = MyVisitor->new();
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
my $definitions = $parser->parse_file('my.wsdl'):
$definitions->_accept( $visitor );
If you need an iterator following the somewhat crude path of dependencies in
a WSDL1.1 definition, you might want to look at L<SOAP::WSDL::Generator::Iterator::WSDL11>.
=head1 REFERENCES
=over
@@ -296,10 +299,10 @@ Addison-Wesley Longman, Amsterdam.
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2007 Martin Kutter.
Copyright 2004-2008 Martin Kutter.
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself
This file is part of SOAP-WSDL. You may distribute/modify it under the same
terms as perl itself
=head1 AUTHOR
@@ -307,9 +310,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 239 $
$Rev: 391 $
$LastChangedBy: kutterma $
$Id: Client.pm 239 2007-09-11 09:45:42Z kutterma $
$Id: Client.pm 391 2007-11-17 21:56:13Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
=cut
+39 -125
View File
@@ -9,13 +9,11 @@ our $VERSION = q{2.00_25};
my %path_of :ATTR(:name<path> :default<[]>);
my %typemap_of :ATTR(:name<typemap> :default<()>);
my %type_prefix_of :ATTR(:name<type_prefix> :default<()>);
my %element_prefix_of :ATTR(:name<element_prefix> :default<()>);
my %resolver_of :ATTR(:name<resolver> :default<()>);
sub START {
my ($self, $ident, $arg_ref) = @_;
$type_prefix_of{ $ident } ||= 'MyTypes';
$element_prefix_of{ $ident } ||= 'MyElements';
$resolver_of { $ident } = $arg_ref->{ resolver };
}
sub set_typemap_entry {
@@ -41,105 +39,6 @@ sub add_element_path {
# . $element->get_name();
}
sub visit_Definitions {
my ( $self, $ident, $definitions ) = ( $_[0], ident $_[0], $_[1] );
$self->set_definitions( $definitions );
for ( @{ $definitions->get_service() } ){
$_->_accept($self);
}
}
sub visit_Service {
my ( $self, $service ) = ( $_[0], $_[1] );
for ( @{ $service->get_port() } ) { $_->_accept($self); }
}
sub visit_Port {
my ( $self, $ident, $port ) = ( $_[0], ident $_[0], $_[1] );
# This is a false assumption - typemaps may be valid for non-soap
# bindings as well.
# TODO check and correct
return if not $port->first_address();
return if not $port->first_address()->isa('SOAP::WSDL::SOAP::Address');
my $binding = $self->get_definitions()
->find_binding( $port->expand( $port->get_binding() ) )
or die 'binding ' . $port->get_binding() . ' not found!';
$binding->_accept($self);
}
sub visit_Binding {
my ( $self, $ident, $binding ) = ( $_[0], ident $_[0], $_[1] );
my $portType = $self->get_definitions()
->find_portType( $binding->expand( $binding->get_type ) )
or die 'portType not found: ' . $binding->binding_type;
for my $operation ( @{ $binding->get_operation() } ) {
my $name = $operation->get_name();
# get the equally named operation from the portType
my ($op) = grep { $_->get_name eq $name }
@{ $portType->get_operation() }
or die "operation <$name> not found";
# visit every input, output and fault message...
for ( @{ $op->get_input }, @{ $op->get_output }, @{ $op->get_fault } ) {
$_->_accept($self);
}
}
}
sub visit_OpMessage {
my ( $self, $ident, $operation_message ) = ( $_[0], ident $_[0], $_[1] );
return if not( $operation_message->get_message() ); # we're in binding
# TODO maybe allow more messages && overloading by specifying name
# find message referenced in operation
my $message = $self->get_definitions()->find_message(
$operation_message->expand( $operation_message->get_message() ) );
for my $part ( @{ $message->get_part() } ) {
$part->_accept($self);
}
}
sub visit_Part {
my ( $self, $ident, $part ) = ( $_[0], ident $_[0], $_[1] );
my $types_ref = $self->get_definitions()->first_types()
or warn "Empty part" . $part->get_name();
# resolve type
# If we have a type, this type is to be used in document/literal
# as global type. However this is forbidden, at least by WS-I.
# We should store the style/encoding somewhere, and regard it.
# TODO: auto-generate element for RPC bindings
if ( my $type_name = $part->get_type ) {
# FIXME support RPC-style calls
die "unsupported global type <$type_name> found in part ". $part->get_name();
}
# TODO factor out iterator or replace by lookup (probably better)
if ( my $element_name = $part->get_element() ) {
my $element = $types_ref->find_element(
$part->expand($element_name) )
|| die "no element $element_name found for part " . $part->get_name();
$element->_accept($self);
return;
}
warn 'neither type nor element - do not know what to do for part '
. $part->get_name();
return;
}
sub process_referenced_type {
my ( $self, $ns, $localname ) = @_;
return if not $localname;
@@ -149,18 +48,13 @@ sub process_referenced_type {
# Caveat: visits type if it's a referenced type from the
# a ? b : c operation.
my ($type, $typeclass);
if ( $ns eq 'http://www.w3.org/2001/XMLSchema' ) {
$typeclass = "SOAP::WSDL::XSD::Typelib::Builtin::$localname";
}
else {
$type = $self->get_definitions()->first_types()->find_type( $ns, $localname );
$typeclass = join( q{::}, $type_prefix_of{$ident}, $type->get_name() );
}
$type = $self->get_definitions()->first_types()->find_type( $ns, $localname );
$typeclass = $self->get_resolver()->create_xsd_name($type);
# set before to allow it to be used from inside _accept
$self->set_typemap_entry($typeclass);
$type->_accept($self) if ($type);
$type->_accept($self) if ($ns ne 'http://www.w3.org/2001/XMLSchema');
# set afterwards again (just to be sure...)
$self->set_typemap_entry($typeclass);
@@ -202,17 +96,21 @@ sub visit_XSD_Element {
if ($element->get_simpleType()) {
# warn "simpleType " . $element->get_name();
my @path = @{ $path_of{ ${ $self } } };
my $typeclass = defined ($parent)
? join '::_', $parent , $element->get_name()
: join q{::}, $element_prefix_of{$ident}, $element->get_name();
my $typeclass = $self->get_resolver()->create_subpackage_name($element);
# my $typeclass = defined ($parent)
# ? join q{::_}, $parent , $element->get_name()
# : join q{::}, $self->resolver()->get_element_prefix( $element->get_targetNamespace), $element->get_name();
$self->set_typemap_entry($typeclass);
$typeclass =~s{\.}{::}g;
$typeclass =~s{\-}{_}g;
last SWITCH;
}
# for atomic and complex types , and ref elements
my $typeclass = join q{::}, $element_prefix_of{$ident}, $element->get_name();
$typeclass =~s{\.}{::}g;
$typeclass =~s{\-}{_}g;
my $typeclass = $self->get_resolver()->create_subpackage_name($element);
# my $typeclass = join q{::}, $self->get_resolver()->get_element_prefix( $element->get_targetNamespace), $element->get_name();
# $typeclass =~s{\.}{::}g;
# $typeclass =~s{\-}{_}g;
$self->set_typemap_entry($typeclass);
$self->process_atomic_type( $element->first_complexType()
@@ -226,9 +124,10 @@ sub visit_XSD_Element {
# a normal (not atomic) type, we just override it here
if (not defined($parent)) {
# for atomic and complex types , and ref elements
my $typeclass = join q{::}, $element_prefix_of{$ident}, $element->get_name();
$typeclass =~s{\.}{::}g;
$typeclass =~s{\-}{_}g;
my $typeclass = $self->get_resolver()->create_xsd_name($element);
# my $typeclass = join q{::}, $self->get_resolver()->get_element_prefix($element->get_targetNamespace), $element->get_name();
# $typeclass =~s{\.}{::}g;
# $typeclass =~s{\-}{_}g;
$self->set_typemap_entry($typeclass);
}
@@ -238,11 +137,12 @@ sub visit_XSD_Element {
sub visit_XSD_ComplexType {
my ($self, $ident, $type) = ($_[0], ident $_[0], $_[1] );
my $content_model = $type->get_flavor();
# TODO is this allowed ? or should we better die ?
return if not $content_model; # empty complexType
my $variety = $type->get_variety();
my $content_model = $type->get_contentModel;
return if not $variety; # empty complexType
return if ($content_model eq 'simpleContent');
if ( grep { $_ eq $content_model} qw(all sequence choice) )
if ( grep { $_ eq $variety} qw(all sequence choice) )
{
# visit child elements
for (@{ $type->get_element() || [] }) {
@@ -251,7 +151,21 @@ sub visit_XSD_ComplexType {
return;
}
warn "unsupported content model $content_model found in "
if (grep { $_ eq $variety } qw(restriction extension) ) {
# resolve base / get atomic type and run on elements
if (my $type_name = $type->get_base()) {
my $subtype = $self->get_definitions()
->first_types()->find_type( $type->expand($type_name) );
# visit child elements
for (@{ $subtype->get_element() || [] }) {
$_->_accept( $self );
}
# that's all for restriction
return if ($variety eq 'restriction');
}
}
warn "unsupported content model $variety found in "
. "complex type " . $type->get_name()
. " - typemap may be incomplete";
}