dinislage/SOAP-WSDL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

import SOAP-WSDL 2.00.02 from CPAN

Browse Source 
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00.02
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00.02.tar.gz
This commit is contained in:
Martin Kutter
2009-12-12 19:48:35 -08:00
committed by Michael G. Schwern
parent 745ce925c1
commit 915ee03cbe
153 changed files with 3289 additions and 2513 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lib/SOAP/WSDL/Generator/Iterator/WSDL11.pm
+1 -1
View File
@@ -2,7 +2,7 @@ package SOAP::WSDL::Generator::Iterator::WSDL11;
use strict; use warnings;
use Class::Std::Fast;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.02');
my %definitions_of :ATTR(:name<definitions> :default<[]>);
my %nodes_of :ATTR(:name<nodes> :default<[]>);
lib/SOAP/WSDL/Generator/PrefixResolver.pm
+1 -1
View File
@@ -3,7 +3,7 @@ use strict; use warnings;
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.02');
my %namespace_prefix_map_of :ATTR(:name<namespace_prefix_map> :default<{}>);
my %namespace_map_of :ATTR(:name<namespace_map> :default<{}>);
lib/SOAP/WSDL/Generator/Template.pm
+1 -1
View File
@@ -5,7 +5,7 @@ use Class::Std::Fast::Storable;
use Carp;
use SOAP::WSDL::Generator::PrefixResolver;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.02');
my %tt_of :ATTR(:get<tt>);
my %definitions_of :ATTR(:name<definitions> :default<()>);
lib/SOAP/WSDL/Generator/Template/Plugin/XSD.pm
+35 -4
View File
@@ -4,19 +4,22 @@ use warnings;
use Carp qw(confess);
use Class::Std::Fast::Storable constructor => 'none';
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.02');
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<()>);
my %definitions_of :ATTR(:name<definitions> :default<()>);
# create a singleton
sub load { # called as MyPlugin->load($context)
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;
$self->set_prefix_resolver( $stash->{ context }->{ prefix_resolver });
$self->set_definitions( $stash->{ definitions });
return $self; # returns 'MyPlugin'
}
@@ -27,6 +30,7 @@ sub new {
my $self = bless \do { my $o = Class::Std::Fast::ID() }, $class;
$self->set_prefix_resolver( $arg_ref->{ prefix_resolver });
$self->set_definitions( $arg_ref->{ definitions });
return $self; # returns 'MyPlugin'
}
@@ -47,7 +51,9 @@ sub _get_prefix {
}
sub create_xsd_name {
my ($self,$node) = @_;
my ($self, $node) = @_;
confess "no node $node" if not defined($node)
or $node eq "";
my $name = $self->_resolve_prefix($node) #. '::'
. $node->get_name();
return $self->perl_name( $name );
@@ -84,7 +90,7 @@ sub create_interface_name {
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)
}
@@ -109,6 +115,14 @@ sub perl_name {
return $name;
}
sub perl_var_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;
@@ -127,6 +141,7 @@ sub create_subpackage_name {
}
}
# create name for top node
die "FOO" if not defined $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;
@@ -136,6 +151,22 @@ sub create_xmlattr_name {
return join '::', shift->create_subpackage_name(shift), 'XmlAttr';
}
sub element_name {
my $self = shift;
my $element = shift;
my $name = $element->get_name();
if (! $name) {
while (my $ref = $element->get_ref()) {
$element = $self->get_definitions()->first_types()
->find_element($element->expand( $ref ) );
$name = $element->get_name();
last if ($name);
}
}
return $name;
}
1;
=pod
lib/SOAP/WSDL/Generator/Template/XSD.pm
+1 -1
View File
@@ -5,7 +5,7 @@ use Class::Std::Fast::Storable;
use File::Basename;
use File::Spec;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.02');
use SOAP::WSDL::Generator::Visitor::Typemap;
use SOAP::WSDL::Generator::Visitor::Typelib;
lib/SOAP/WSDL/Generator/Template/XSD/Interface.tt
+3 -1
View File
@@ -15,6 +15,8 @@ sub START {
$_[0]->set_proxy('[% port.first_address.get_location %]') if not $_[2]->{proxy};
$_[0]->set_class_resolver('[% XSD.create_typemap_name(service) %]')
if not $_[2]->{class_resolver};
$_[0]->set_prefix($_[2]->{use_prefix}) if exists $_[2]->{use_prefix};
}
[% binding = definitions.find_binding( port.expand( port.get_binding ) );
@@ -88,4 +90,4 @@ All arguments are forwarded to L<SOAP::WSDL::Client|SOAP::WSDL::Client>.
Generated by SOAP::WSDL on [% PERL %]print scalar localtime() [% END %]
=cut
=cut
lib/SOAP/WSDL/Generator/Template/XSD/complexType.tt
+9 -1
View File
@@ -40,8 +40,16 @@ methods:
=over
[% FOREACH element = complexType.get_element -%]
=item * [% element.get_name %]
=item * [% XSD.perl_var_name(XSD.element_name(element)) %]
[% IF (XSD.perl_var_name(XSD.element_name(element)) == element.get_name); %]
[% ELSE %]
Note: The name of this property has been altered, because it didn't match
perl's notion of variable/subroutine names. The altered name is used in
perl code only, XML output uses the original name:
[% element.get_name %]
[% END %]
[% IF element.get_annotation.get_documentation; %]
[% element.get_annotation.get_documentation %]
[% END -%]
lib/SOAP/WSDL/Generator/Template/XSD/complexType/POD/all.tt
+2 -1
View File
@@ -1,7 +1,8 @@
[% USE XSD -%]
{
[%- 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 -%]
[% indent %][% XSD.perl_var_name(XSD.element_name(element)) %] => [% INCLUDE element/POD/structure.tt -%]
[% END %]
[% indent.replace('\s{2}$', ''); %]}
lib/SOAP/WSDL/Generator/Template/XSD/complexType/POD/attributeSet.tt
+3
View File
@@ -34,4 +34,7 @@ This attribute is of type L<[% XSD.create_xsd_name(type) %]|[% XSD.create_xsd_na
[% END %]
[%- END -%]
=back
[% END %]
lib/SOAP/WSDL/Generator/Template/XSD/complexType/POD/choice.tt
+2 -1
View File
@@ -1,9 +1,10 @@
[%USE XSD -%]
[% indent %]{
[%- 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...
[%- FOREACH element = complexType.get_element %]
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]
[% indent %][% XSD.perl_var_name(XSD.element_name(element)) %] => [% INCLUDE element/POD/structure.tt -%]
[% END %]
[% indent.replace('\s{2}$', ''); %]}
lib/SOAP/WSDL/Generator/Template/XSD/complexType/all.tt
+28 -10
View File
@@ -7,26 +7,39 @@ Class::Std::initialize();
[%
atomic_types = {};
FOREACH element = complexType.get_element %]
my %[% XSD.perl_name(element.get_name) %]_of :ATTR(:get<[% XSD.perl_name(element.get_name) %]>);
FOREACH element = complexType.get_element;
name = XSD.perl_var_name(XSD.element_name(element)); %]
my %[% XSD.perl_name(name) %]_of :ATTR(:get<[% XSD.perl_name(name) %]>);
[%- END %]
__PACKAGE__->_factory(
[ qw([% FOREACH element = complexType.get_element %]
[% element.get_name -%]
[ qw([% FOREACH element = complexType.get_element;
# ugly copied code - macro or plugin method?
name = XSD.perl_var_name(XSD.element_name(element)); -%]
[% name %]
[% END %]
) ],
{
[% FOREACH element = complexType.get_element -%]
'[% element.get_name %]' => \%[% XSD.perl_name(element.get_name) %]_of,
[% FOREACH element = complexType.get_element;
# ugly copied code - macro or plugin method?
name = XSD.perl_var_name(XSD.element_name(element)); -%]
'[% name %]' => \%[% XSD.perl_name(name) %]_of,
[% END -%]
},
{
[% FOREACH element = complexType.get_element;
IF (ref = element.get_ref);
element = definitions.first_types.find_element(element.expand( element.get_ref ));
END;
IF (type = element.get_type);
element_type = definitions.first_types.find_type(complexType.expand( type )); -%]
'[% element.get_name %]' => '[% XSD.create_xsd_name(element_type) %]',
[% ELSE;
element_type = definitions.first_types.find_type(complexType.expand( type ));
IF (! element_type);
type_name = complexType.expand( type );
THROW NOT_FOUND, "${ type_name.0 } ${ type_name.1 } not found";
END; -%]
'[% XSD.perl_var_name(XSD.element_name(element)) %]' => '[% XSD.create_xsd_name(element_type) %]',
[% ELSE;
IF (element.first_simpleType);
atomic_types.${ element.get_name } = element.first_simpleType;
ELSIF (element.first_complexType);
@@ -34,9 +47,14 @@ __PACKAGE__->_factory(
ELSE;
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.create_subpackage_name({ value => element }) %]',
'[% XSD.perl_var_name(XSD.element_name(element)) %]' => '[% XSD.create_subpackage_name({ value => element }) %]',
[% END;
END -%]
},
{
[% FOREACH element = complexType.get_element; %]
'[% XSD.perl_var_name(XSD.element_name(element)); %]' => '[% element.get_name %]',
[%- END %]
}
);
lib/SOAP/WSDL/Generator/Template/XSD/complexType/complexContent.tt
+2
View File
@@ -1,5 +1,7 @@
[% IF (complexType.get_variety == 'restriction');
INCLUDE complexType/restriction.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'extension');
INCLUDE complexType/extension.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'sequence');
INCLUDE complexType/extension.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'all');
lib/SOAP/WSDL/Generator/Template/XSD/complexType/extension.tt
+49 -9
View File
@@ -1,28 +1,68 @@
[%
#
# extension
#
# unfortunately, SOAP::WSDL's speed tweaks don't play well with
# Class::Std's inheritance model.
#
# In Class::Std, all properties are stored in the class, and in objects
# using inheritance in the defining class.
#
# As the speed tweaks directly access the class' data without checking
# inheritance, the simplest way is to resolve complexType extension
# relationships
#
# To capture deep inheritance, extensions must be followed until a non-
# extension base is found
#
# TODO attribute handling is missing
# TODO sort out some better way to handle inheritance
base_name=complexType.expand( complexType.get_base );
element_list = [];
# copy complexType ref
base_type = complexType;
base_name=base_type.expand( base_type.get_base );
base_type = definitions.first_types.find_type( base_name );
element_from = complexType.get_element;
# add a use base for first to setup inheritance
%]
use base qw([% XSD.create_xsd_name( base_type ) %]);
[%
# loop forever
WHILE (1);
# make a copy. We don't want to modify the original list here...
FOREACH element = base_type.get_element.reverse;
element_list.unshift(element);
END;
# get next base type
IF (base_name=base_type.expand( base_type.get_base ));
# set new base_type
base_type = definitions.first_types.find_type( base_name );
ELSE;
# exit loop if there is none
BREAK;
END;
END;
#
# Sanity check: All original elements must be noted first
# and now the new elements...
#
element_list = base_type.get_element;
element_from = complexType.get_element;
FOREACH element = element_from;
IF element_list.${ loop.index }.get_name != element.get_name;
element_list.push( element );
# THROW WSDL "${element.get_name} not found at position ${ loop.index } in extension type ${ complexType.get_name }";
END;
END;
# set derived element list
complexType.set_element( element_list );
-%]
use base qw([% XSD.create_xsd_name( base_type ) %]);
[%
INCLUDE complexType/variety.tt(complexType = complexType);
# restore original element list
complexType.set_element( element_from );
%]
lib/SOAP/WSDL/Generator/Template/XSD/complexType/variety.tt
+2 -2
View File
@@ -7,8 +7,8 @@ ELSIF (complexType.get_variety == 'group');
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType group not implemented yet";
ELSIF (complexType.get_variety == 'choice');
INCLUDE complexType/all.tt(complexType = complexType);
ELSIF (complexType.get_variety);
THROW NOT_IMPLEMENTED, "Unknown variety ${ complexType.get_variety } in ${ complexType.get_name } (${ element.get_name })";
#ELSIF (complexType.get_variety);
# THROW NOT_IMPLEMENTED, "unknown variety ${ complexType.get_variety } in ${ complexType.get_name } (${ element.get_name })";
ELSE %]
# There's no variety - empty complexType
lib/SOAP/WSDL/Generator/Visitor.pm
+1 -1
View File
@@ -3,7 +3,7 @@ use strict;
use warnings;
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.02');
my %definitions_of :ATTR(:name<definitions> :default<()>);
my %type_prefix_of :ATTR(:name<type_prefix> :default<()>);
lib/SOAP/WSDL/Generator/Visitor/Typelib.pm
+1 -1
View File
@@ -5,7 +5,7 @@ use base qw(SOAP::WSDL::Generator::Visitor
SOAP::WSDL::Generator::Template
);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.02');
1;
lib/SOAP/WSDL/Generator/Visitor/Typemap.pm
+48 -27
View File
@@ -5,7 +5,7 @@ use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Generator::Visitor);
use version; our $VERSION = qv('2.00.01');
use version; our $VERSION = qv('2.00.02');
my %path_of :ATTR(:name<path> :default<[]>);
my %typemap_of :ATTR(:name<typemap> :default<()>);
@@ -32,11 +32,14 @@ sub add_element_path {
# Well almost: Class names are not constructed in a namespace-sensitive
# manner, yet - there should be some facility to allow binding a (perl)
# prefix to a namespace...
push @{ $path_of{ ident $self } }, $element->get_name();
# push @{ $path_of{ ident $self } },
# "{". $element->get_targetNamespace . "}"
# . $element->get_name();
if (my $ref = $element->get_ref() ) {
$element = $self->get_definitions()->first_types()->find_element(
$element->expand($ref) );
}
my $name = $element->get_name();
push @{ $path_of{ ident $self } }, $name;
}
sub process_referenced_type {
@@ -61,14 +64,6 @@ sub process_referenced_type {
return $self;
}
sub process_atomic_type {
my ( $self, $type, $callback ) = @_;
return if not $type;
$callback->( $self, $type );
return $self;
}
sub visit_XSD_Element {
my ( $self, $ident, $element ) = ( $_[0], ident $_[0], $_[1] );
@@ -84,9 +79,11 @@ sub visit_XSD_Element {
# They all just return if no argument is given,
# and return $self on success.
SWITCH: {
my $name = $element->get_name();
if ($element->get_type) {
$self->process_referenced_type( $element->expand( $element->get_type() ) )
&& last;
$self->process_referenced_type( $element->expand( $element->get_type() ) );
last SWITCH;
}
# atomic simpleType typemap rule:
@@ -106,11 +103,23 @@ sub visit_XSD_Element {
my $typeclass = $self->get_resolver()->create_subpackage_name($element);
$self->set_typemap_entry($typeclass);
$self->process_atomic_type( $element->first_complexType()
, sub { $_[1]->_accept($_[0]) } )
&& last SWITCH;
if (my $complexType = $element->first_complexType()) {
$complexType->_accept($self);
last SWITCH;
}
# TODO: add element ref handling
# element ref handling
if (my $ref = $element->get_ref()) {
$element = $self->get_definitions()->first_types()->find_element(
$element->expand($ref) );
# we added a path too much - we should add the path of this
# element instead.
pop @{ $path_of{$ident} };
$element->_accept($self);
# and we must not pop it off now - thus, just return
return;
}
die "Neither type nor ref in element >". $element->get_name ."<. Don't know what to do."
};
# Safety measure. If someone defines a top-level element with
@@ -128,6 +137,7 @@ sub visit_XSD_Element {
sub visit_XSD_ComplexType {
my ($self, $ident, $type) = ($_[0], ident $_[0], $_[1] );
my $variety = $type->get_variety();
my $derivation = $type->get_derivation();
my $content_model = $type->get_contentModel;
return if not $variety; # empty complexType
return if ($content_model eq 'simpleContent');
@@ -138,10 +148,16 @@ sub visit_XSD_ComplexType {
for (@{ $type->get_element() || [] }) {
$_->_accept( $self );
}
return;
}
# Only continue for derived types
# Saves a uninitialized warning.
return if not $derivation;
if (grep { $_ eq $variety } qw(restriction extension) ) {
if ($derivation eq 'restriction' ) {
# TODO check and probably correct - this includes
# all base type's elements in a restriction derivation.
# Probably wrong.
#
# resolve base / get atomic type and run on elements
if (my $type_name = $type->get_base()) {
my $subtype = $self->get_definitions()
@@ -150,14 +166,19 @@ sub visit_XSD_ComplexType {
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";
elsif ($derivation eq 'extension' ) {
# resolve base / get atomic type and run on elements
while (my $type_name = $type->get_base()) {
$type = $self->get_definitions()
->first_types()->find_type( $type->expand($type_name) );
# visit child elements
for (@{ $type->get_element() || [] }) {
$_->_accept( $self );
}
}
}
}
1;