import SOAP-WSDL 2.00_29 from CPAN
git-cpan-module: SOAP-WSDL git-cpan-version: 2.00_29 git-cpan-authorid: MKUTTER git-cpan-file: authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_29.tar.gz
This commit is contained in:
Martin Kutter
committed by
Michael G. Schwern
Michael G. Schwern
parent
2bad767211
commit
874251225f
@@ -0,0 +1,53 @@
|
||||
package SOAP::WSDL::Generator::Template;
|
||||
use strict;
|
||||
use Template;
|
||||
use Class::Std::Fast::Storable;
|
||||
|
||||
our $VERSION=q{2.00_25};
|
||||
|
||||
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<.>);
|
||||
|
||||
sub START {
|
||||
my ($self, $ident, $arg_ref) = @_;
|
||||
}
|
||||
|
||||
sub _process :PROTECTED {
|
||||
my ($self, $template, $arg_ref, $output) = @_;
|
||||
my $ident = ident $self;
|
||||
|
||||
$tt_of{$ident} = Template->new(
|
||||
DEBUG => 1,
|
||||
EVAL_PERL => $EVAL_PERL_of{ $ident },
|
||||
RECURSION => $RECURSION_of{ $ident },
|
||||
INCLUDE_PATH => $INCLUDE_PATH_of{ $ident },
|
||||
OUTPUT_PATH => $OUTPUT_PATH_of{ $ident },
|
||||
)
|
||||
if (not $tt_of{ $ident });
|
||||
|
||||
$tt_of{ $ident }->process( $template,
|
||||
{
|
||||
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_of{ $ident }->error();
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,198 @@
|
||||
package SOAP::WSDL::Generator::Template::XSD;
|
||||
use strict;
|
||||
use Template;
|
||||
use Class::Std::Fast::Storable;
|
||||
use File::Basename;
|
||||
use File::Spec;
|
||||
|
||||
our $VERSION = q{2.00_27};
|
||||
|
||||
use SOAP::WSDL::Generator::Visitor::Typemap;
|
||||
use SOAP::WSDL::Generator::Visitor::Typelib;
|
||||
use base qw(SOAP::WSDL::Generator::Template);
|
||||
|
||||
my %output_of :ATTR(:name<output> :default<()>);
|
||||
my %typemap_of :ATTR(:name<typemap> :default<({})>);
|
||||
|
||||
sub BUILD {
|
||||
my ($self, $ident, $arg_ref) = @_;
|
||||
$self->set_EVAL_PERL(1);
|
||||
$self->set_RECURSION(1);
|
||||
$self->set_INCLUDE_PATH( exists $arg_ref->{INCLUDE_PATH}
|
||||
? $arg_ref->{INCLUDE_PATH}
|
||||
: do {
|
||||
# ignore uninitialized warnings - File::Spec warns about
|
||||
# uninitialized values, probably because we have no filename
|
||||
local $SIG{__WARN__} = sub {
|
||||
return if ($_[0]=~m{\buninitialized\b});
|
||||
CORE::warn @_;
|
||||
};
|
||||
|
||||
# makeup path for the OS we're running on
|
||||
my ($volume, $dir, $file) = File::Spec->splitpath(
|
||||
File::Spec->rel2abs( dirname __FILE__ )
|
||||
);
|
||||
$dir = File::Spec->catdir($dir, $file, 'XSD');
|
||||
# return path put together...
|
||||
my $path = File::Spec->catpath( $volume, $dir , q{});
|
||||
|
||||
# Fixup path for windows - / works fine, \ does
|
||||
# not...
|
||||
if ( eval { &Win32::BuildNumber } ) {
|
||||
$path =~s{\\}{/}g;
|
||||
}
|
||||
$path;
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
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] ) {
|
||||
$type->_accept( $self );
|
||||
}
|
||||
# return $output_of{ ident $self };
|
||||
return;
|
||||
}
|
||||
|
||||
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');
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
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_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(),
|
||||
definitions => $self->get_definitions(),
|
||||
typemap => {
|
||||
'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11',
|
||||
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
|
||||
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::token',
|
||||
'Fault/faultstring' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
'Fault/detail' => 'SOAP::WSDL::XSD::Typelib::Builtin::string',
|
||||
%{ $typemap_of{ident $self }},
|
||||
}
|
||||
});
|
||||
for my $service (@{ $self->get_definitions->get_service }) {
|
||||
$visitor->visit_Service( $service );
|
||||
my $output = $arg_ref->{ output }
|
||||
? $arg_ref->{ output }
|
||||
: $self->_generate_filename( $self->get_typemap_prefix(), $service->get_name() );
|
||||
print "Creating typemap class $output\n";
|
||||
$self->_process('Typemap.tt',
|
||||
{
|
||||
service => $service,
|
||||
typemap => $visitor->get_typemap(),
|
||||
NO_POD => $arg_ref->{ NO_POD } ? 1 : 0 ,
|
||||
},
|
||||
$output);
|
||||
}
|
||||
}
|
||||
|
||||
sub _generate_filename :PRIVATE {
|
||||
my ($self, @parts) = @_;
|
||||
my $name = join '::', @parts;
|
||||
$name =~s{ \. }{::}xmsg;
|
||||
$name =~s{ \- }{_}xmsg;
|
||||
$name =~s{ :: }{/}xmsg;
|
||||
return "$name.pm";
|
||||
}
|
||||
|
||||
sub visit_XSD_Element {
|
||||
my ($self, $element) = @_;
|
||||
my $output = defined $output_of{ ident $self }
|
||||
? $output_of{ ident $self }
|
||||
: $self->_generate_filename( $self->get_element_prefix(), $element->get_name() );
|
||||
$self->_process('element.tt', { element => $element } , $output);
|
||||
}
|
||||
|
||||
sub visit_XSD_SimpleType {
|
||||
my ($self, $type) = @_;
|
||||
my $output = defined $output_of{ ident $self }
|
||||
? $output_of{ ident $self }
|
||||
: $self->_generate_filename( $self->get_type_prefix(), $type->get_name() );
|
||||
$self->_process('simpleType.tt', { simpleType => $type } , $output);
|
||||
}
|
||||
|
||||
sub visit_XSD_ComplexType {
|
||||
my ($self, $type) = @_;
|
||||
my $output = defined $output_of{ ident $self }
|
||||
? $output_of{ ident $self }
|
||||
: $self->_generate_filename( $self->get_type_prefix(), $type->get_name() );
|
||||
$self->_process('complexType.tt', { complexType => $type } , $output);
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,94 @@
|
||||
[% interface_name = interface_prefix _ '::'
|
||||
_ service.get_name.replace('\.', '::') _ '::'
|
||||
_ port.get_name.replace('^.+\.','');
|
||||
interface_name = interface_name.replace('-','_'); -%]
|
||||
package [% interface_name %];
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Fast::Storable;
|
||||
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');
|
||||
|
||||
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('-', '_') %]')
|
||||
if not $_[2]->{class_resolver};
|
||||
}
|
||||
|
||||
[% binding = definitions.find_binding( port.expand( port.get_binding ) );
|
||||
FOREACH operation = binding.get_operation;
|
||||
%][% INCLUDE Interface/Operation.tt %]
|
||||
[%
|
||||
|
||||
END;
|
||||
%]
|
||||
|
||||
1;
|
||||
|
||||
[% IF NO_POD; STOP; END %]
|
||||
|
||||
__END__
|
||||
[%# 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
|
||||
|
||||
[% interface_name %] - SOAP Interface for the [% service.get_name %] Web Service
|
||||
|
||||
[% head1 %] SYNOPSIS
|
||||
|
||||
use [% interface_name %];
|
||||
my $interface = [% interface_name %]->new();
|
||||
|
||||
my $response;
|
||||
[% FOREACH operation = binding.get_operation;
|
||||
%] $response = $interface->[% operation.get_name %]();
|
||||
[% END %]
|
||||
|
||||
|
||||
[% head1 %] DESCRIPTION
|
||||
|
||||
SOAP Interface for the [% service.get_name %] web service
|
||||
located at [% port.first_address.get_location %].
|
||||
|
||||
[% head1 %] SERVICE [% service.get_name %]
|
||||
|
||||
[% service.get_documentation %]
|
||||
|
||||
[% head2 %] Port [% port.get_name %]
|
||||
|
||||
[% port.get_documentation %]
|
||||
|
||||
[% head1 %] METHODS
|
||||
|
||||
[% head2 %] General methods
|
||||
|
||||
[% head3 %] new
|
||||
|
||||
Constructor.
|
||||
|
||||
All arguments are forwarded to L<SOAP::WSDL::Client|SOAP::WSDL::Client>.
|
||||
|
||||
[% head2 %] SOAP Service methods
|
||||
|
||||
[% INCLUDE Interface/POD/method_info.tt %]
|
||||
|
||||
|
||||
[% FOREACH operation = binding.get_operation;
|
||||
%][% INCLUDE Interface/POD/Operation.tt %]
|
||||
[% END %]
|
||||
|
||||
[% head1 %] AUTHOR
|
||||
|
||||
Generated by SOAP::WSDL on [% PERL %]print scalar localtime() [% END %]
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,69 @@
|
||||
[% RETURN IF NOT item;
|
||||
type = definitions.find_portType( binding.expand( binding.get_type ) );
|
||||
port_op = type.find_operation( definitions.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 @body_part_from = split m{\s}, $item->get_parts;
|
||||
|
||||
my @parts;
|
||||
if (@body_part_from) {
|
||||
@parts = map {
|
||||
my $part = $_;
|
||||
(grep {
|
||||
my ($ns, $lname) = $def->expand( $_ );
|
||||
($lname eq $part->get_name)
|
||||
} @body_part_from
|
||||
)
|
||||
? do {
|
||||
my $name;
|
||||
($name = $part->get_element)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
$element_prefix . '::' . $name;
|
||||
}
|
||||
: ($name = $part->get_type)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
$type_prefix . '::' . $name;
|
||||
}
|
||||
: die "input must have either type or element"
|
||||
}
|
||||
: ()
|
||||
} @{ $part_from };
|
||||
}
|
||||
else {
|
||||
@parts = map {
|
||||
my $part = $_;
|
||||
my $name;
|
||||
($name = $part->get_element)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
"$element_prefix\::$name"
|
||||
}
|
||||
: ($name = $part->get_type)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
"$type_prefix\::$name"
|
||||
}
|
||||
: die "input must have either type or element";
|
||||
} @{ $part_from };
|
||||
}
|
||||
|
||||
warn "Multiple parts detected in message " . $stash->{ message }->get_name() . ".\n",
|
||||
"WS-I BP demands 0 to 1 parts in message body\n"
|
||||
if (@parts > 1);
|
||||
|
||||
$stash->{ parts } = \@parts;
|
||||
|
||||
[% END %]
|
||||
'use' => '[% item.get_use %]',
|
||||
namespace => '[% item.get_namespace %]',
|
||||
encodingStyle => '[% item.get_encodingStyle %]',
|
||||
parts => [qw( [% parts.join(' ') %] )],
|
||||
@@ -0,0 +1,38 @@
|
||||
[%
|
||||
RETURN IF NOT item;
|
||||
message_name = item.get_message;
|
||||
IF NOT message_name;
|
||||
THROW BAD_WSDL "missing <message> attribute in header for operation ${operation.get_name}";
|
||||
END;
|
||||
message = definitions.find_message( item.expand( message_name ) );
|
||||
PERL %]
|
||||
my $message = $stash->{ message };
|
||||
my $item = $stash->{ item };
|
||||
my $def = $stash->{ definitions };
|
||||
my $type_prefix = $stash->{ type_prefix };
|
||||
my $element_prefix = $stash->{ element_prefix };
|
||||
my ($ns, $lname) = $def->expand( $item->get_part() );
|
||||
my ($part) = grep {
|
||||
$_->get_name eq $lname
|
||||
&& $_->get_targetNamespace eq $ns } @{ $message->get_part( ) };
|
||||
my $part_class = do {
|
||||
my $name;
|
||||
($name = $part->get_element)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
$element_prefix . '::' . $name;
|
||||
}
|
||||
: ($name = $part->get_type)
|
||||
? do {
|
||||
$name =~s{ ^[^:]+: }{}xms;
|
||||
$type_prefix . '::' . $name;
|
||||
}
|
||||
: die "input must have either type or element"
|
||||
};
|
||||
$stash->{ part_class } = $part_class;
|
||||
[% END;
|
||||
%]
|
||||
'use' => '[% item.get_use %]',
|
||||
namespace => '[% item.get_namespace %]',
|
||||
encodingStyle => '[% item.get_encodingStyle %]',
|
||||
parts => [qw( [% part_class %] )],
|
||||
@@ -0,0 +1,18 @@
|
||||
sub [% operation.get_name %] {
|
||||
my ($self, $body, $header) = @_;
|
||||
die "[% operation.get_name %] must be called as object method (\$self is <$self>)" if not blessed($self);
|
||||
return $self->SUPER::call({
|
||||
operation => '[% operation.get_name %]',
|
||||
soap_action => '[% operation.first_operation.get_soapAction %]',
|
||||
style => '[% operation.get_style || binding.get_style %]',
|
||||
body => {
|
||||
[% INCLUDE Interface/Body.tt( item = operation.first_input.first_body ); %]
|
||||
},
|
||||
header => {
|
||||
[% INCLUDE Interface/Header.tt( item = operation.first_input.first_header ); %]
|
||||
},
|
||||
headerfault => {
|
||||
[% INCLUDE Interface/Header.tt( item = operation.first_input.first_headerfault ); %]
|
||||
}
|
||||
}, $body, $header);
|
||||
}
|
||||
@@ -0,0 +1,13 @@
|
||||
|
||||
[% INDENT; %][% element.get_name %] => [%-
|
||||
IF (element.get_ref);
|
||||
element = element.get_ref();
|
||||
END;
|
||||
IF (type_name = element.get_type);
|
||||
INCLUDE Interface/POD/Type.tt(type = definitions.first_types.find_type( element.expand(type_name) ) );
|
||||
ELSIF (type = element.first_complexType);
|
||||
INCLUDE Interface/POD/Type.tt(type = type );
|
||||
ELSIF (type = element.first_simpleType);
|
||||
INCLUDE Interface/POD/Type.tt(type = type );
|
||||
END;
|
||||
%]
|
||||
@@ -0,0 +1,9 @@
|
||||
[%
|
||||
message_name = port_op.first_input.get_message();
|
||||
# message_name;
|
||||
|
||||
part_from = definitions.find_message( port_op.first_input.expand( message_name ) ).get_part;
|
||||
FOREACH part = part_from;
|
||||
INCLUDE Interface/POD/Part.tt(part = part);
|
||||
END;
|
||||
%]
|
||||
@@ -0,0 +1,10 @@
|
||||
[%# work around for CPAN's indexer, which gets disturbed by pod in templates -%]
|
||||
[% head3 = BLOCK %]=head3[% END -%]
|
||||
[% head3 %] [% operation.get_name %]
|
||||
|
||||
[% type = definitions.find_portType( binding.expand( binding.get_type ) );
|
||||
port_op = type.find_operation( definitions.get_targetNamespace, operation.get_name );
|
||||
port_op.get_documentation %]
|
||||
|
||||
$interface->[% operation.get_name %]([% INCLUDE Interface/POD/Message.tt %] );
|
||||
|
||||
@@ -0,0 +1,7 @@
|
||||
[% element = definitions.first_types.find_element( part.expand( part.get_element ) );
|
||||
#element.get_name();
|
||||
#element;
|
||||
#STOP;
|
||||
type = element.first_complexType || element.first_simpleType || definitions.first_types.find_type(
|
||||
element.expand( element.get_type ) );
|
||||
INCLUDE Interface/POD/Type.tt;%],
|
||||
@@ -0,0 +1,7 @@
|
||||
[%- indent = ' ';
|
||||
IF type.isa('SOAP::WSDL::XSD::ComplexType');
|
||||
INCLUDE complexType/POD/structure.tt(complexType = type);
|
||||
ELSE;
|
||||
INCLUDE simpleType/POD/structure.tt(simpleType = type);
|
||||
END;
|
||||
indent.replace('\s{2}$',''); %]
|
||||
@@ -0,0 +1,7 @@
|
||||
Method synopsis is displayed with hash refs as parameters.
|
||||
|
||||
The commented class names in the method's parameters denote that objects
|
||||
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.
|
||||
@@ -0,0 +1,106 @@
|
||||
[% server_name = server_prefix _ '::'
|
||||
_ service.get_name.replace('\.', '::') _ '::'
|
||||
_ port.get_name.replace('^.+\.','');
|
||||
server_name = server_name.replace('-','_'); -%]
|
||||
package [% server_name %];
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Fast::Storable;
|
||||
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');
|
||||
|
||||
my %transport_class_of :ATTR(:name<transport_class> :default<SOAP::WSDL::Server::CGI>);
|
||||
my %transport_of :ATTR(:name<transport> :default<()>);
|
||||
my %dispatch_to :ATTR(:name<dispatch_to>);
|
||||
|
||||
my $action_map_ref = {
|
||||
[% binding = definitions.find_binding( port.expand( port.get_binding ) );
|
||||
FOREACH operation = binding.get_operation;
|
||||
- %]
|
||||
'[% operation.first_operation.get_soapAction %]' => '[% operation.get_name %]',
|
||||
[% END %]
|
||||
};
|
||||
|
||||
sub START {
|
||||
my ($self, $ident, $arg_ref) = @_;
|
||||
eval "require $transport_class_of{ $ident }"
|
||||
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('\.', '::') %]',
|
||||
dispatch_to => $dispatch_to{ $ident },
|
||||
});
|
||||
}
|
||||
|
||||
sub handle {
|
||||
$transport_of{ ${ $_[0] } }->handle();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
[% IF NO_POD; STOP; END %]
|
||||
|
||||
__END__
|
||||
[%# 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
|
||||
|
||||
[% server_name %] - SOAP Server Class for the [% service.get_name %] Web Service
|
||||
|
||||
[% head1 %] SYNOPSIS
|
||||
|
||||
use [% server_name %];
|
||||
my $server = [% server_name %]->new({
|
||||
dispatch_to => 'My::Handler::Class',
|
||||
transport_class => 'SOAP::WSDL::Server::CGI', # optional, default
|
||||
});
|
||||
$server->handle();
|
||||
|
||||
|
||||
[% head1 %] DESCRIPTION
|
||||
|
||||
SOAP Server handler for the [% service.get_name %] web service
|
||||
located at [% port.first_address.get_location %].
|
||||
|
||||
[% head1 %] SERVICE [% service.get_name %]
|
||||
|
||||
[% service.get_documentation %]
|
||||
|
||||
[% head2 %] Port [% port.get_name %]
|
||||
|
||||
[% port.get_documentation %]
|
||||
|
||||
[% head1 %] METHODS
|
||||
|
||||
[% head2 %] General methods
|
||||
|
||||
[% head3 %] new
|
||||
|
||||
Constructor.
|
||||
|
||||
The C<dispatch_to> argument is mandatory. It must be a class or object
|
||||
implementing the SOAP Service methods listed below.
|
||||
|
||||
[% head2 %] SOAP Service methods
|
||||
|
||||
[% INCLUDE Server/POD/method_info.tt %]
|
||||
|
||||
[% FOREACH operation = binding.get_operation;
|
||||
%][% INCLUDE Server/POD/Operation.tt %]
|
||||
[% END %]
|
||||
|
||||
[% head1 %] AUTHOR
|
||||
|
||||
Generated by SOAP::WSDL on [% PERL %]print scalar localtime() [% END %]
|
||||
|
||||
=pod
|
||||
@@ -0,0 +1,9 @@
|
||||
[%
|
||||
message_name = port_op.first_output.get_message();
|
||||
# message_name;
|
||||
|
||||
part_from = definitions.find_message( port_op.first_output.expand( message_name ) ).get_part;
|
||||
FOREACH part = part_from;
|
||||
INCLUDE Server/POD/OutPart.tt(part = part);
|
||||
END;
|
||||
%]
|
||||
@@ -0,0 +1,18 @@
|
||||
[%# work around for CPAN's indexer, which gets disturbed by pod in templates -%]
|
||||
[% head3 = BLOCK %]=head3[% END -%]
|
||||
|
||||
[% head3 %] [% operation.get_name %]
|
||||
|
||||
[% type = definitions.find_portType( binding.expand( binding.get_type ) );
|
||||
port_op = type.find_operation( definitions.get_targetNamespace, operation.get_name );
|
||||
port_op.get_documentation %]
|
||||
|
||||
sub [% operation.get_name %] {
|
||||
my ($self, $body, $header) = @_;
|
||||
# body is a ??? object - sorry, POD not implemented yet
|
||||
# header is a ??? object - sorry, POD not implemented yet
|
||||
|
||||
# do something with body and header...
|
||||
|
||||
return [% INCLUDE Server/POD/Message.tt %]
|
||||
}
|
||||
@@ -0,0 +1,10 @@
|
||||
[% element = definitions.first_types.find_element( part.expand( part.get_element ) );
|
||||
#element.get_name();
|
||||
#element;
|
||||
#STOP;
|
||||
-%]
|
||||
[% element_prefix %]::[% element.get_name.replace('\.', '::') %]->new([%
|
||||
type = element.first_complexType || element.first_simpleType || definitions.first_types.find_type(
|
||||
element.expand( element.get_type ) );
|
||||
INCLUDE Interface/POD/Type.tt; %]
|
||||
);
|
||||
@@ -0,0 +1,4 @@
|
||||
Your dispatch_to class has to implement the following methods:
|
||||
|
||||
The examples below serve as copy-and-paste prototypes to use in your
|
||||
class.
|
||||
@@ -0,0 +1,37 @@
|
||||
package [% typemap_prefix %]::[% service.get_name.replace('\.','::') %];
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our [% USE Dumper(varname = 'typemap_'); Dumper.dump( typemap ) %];
|
||||
|
||||
sub get_class {
|
||||
my $name = join '/', @{ $_[1] };
|
||||
exists $typemap_1->{ $name } or die "Cannot resolve $name via " . __PACKAGE__;
|
||||
return $typemap_1->{ $name };
|
||||
}
|
||||
|
||||
sub get_typemap {
|
||||
return $typemap_1;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
__END__
|
||||
[%# work around for CPAN's indexer, which gets disturbed by pod in templates -%]
|
||||
[% pod = BLOCK %]=pod[% END -%]
|
||||
[% head1 = BLOCK %]=head1[% END -%]
|
||||
|
||||
[% pod %]
|
||||
|
||||
[% head1 %] NAME
|
||||
|
||||
[% typemap_prefix %]::[% service.get_name.replace('\.','::').replace('-', '_') %]; - typemap for ::[% service.get_name %];
|
||||
|
||||
[% head1 %] DESCRIPTION
|
||||
|
||||
Typemap created by SOAP::WSDL for map-based SOAP message parsers.
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,6 @@
|
||||
[% 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,53 @@
|
||||
package [% type_prefix %]::[% complexType.get_name.replace('\.','::').replace('-','_') %];
|
||||
use strict;
|
||||
use warnings;
|
||||
[% INCLUDE complexType/contentModel.tt %]
|
||||
[%#
|
||||
# Don't include any perl source here - there may be sub-packages...
|
||||
#-%]
|
||||
|
||||
package [% type_prefix %]::[% complexType.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
|
||||
[% INCLUDE complexType/attributeSet.tt %]
|
||||
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
|
||||
|
||||
[% type_prefix %]::[% complexType.get_name.replace('\.','::').replace('-','_') %]
|
||||
|
||||
[% head1 %] DESCRIPTION
|
||||
|
||||
Perl data type class for the XML Schema defined complextype
|
||||
[% complexType.get_name %] from the namespace [% complexType.get_targetNamespace %].
|
||||
|
||||
[% head2 %] PROPERTIES
|
||||
|
||||
The following properties may be accessed using get_PROPERTY / set_PROPERTY
|
||||
methods:
|
||||
|
||||
[% FOREACH element = complexType.get_element -%]
|
||||
[% element.get_name %]
|
||||
[% END %]
|
||||
|
||||
[% head1 %] METHODS
|
||||
|
||||
[% head2 %] new
|
||||
|
||||
Constructor. The following data structure may be passed to new():
|
||||
|
||||
[% indent = ' '; INCLUDE complexType/POD/structure.tt %]
|
||||
|
||||
[% head1 %] AUTHOR
|
||||
|
||||
Generated by SOAP::WSDL
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,7 @@
|
||||
[% indent %]{
|
||||
[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% 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,9 @@
|
||||
[% indent %]{
|
||||
[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% 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 -%]
|
||||
[% END %]
|
||||
[% indent.replace('\s{2}$', ''); %]}
|
||||
@@ -0,0 +1,9 @@
|
||||
[% IF (complexType.get_variety == 'restriction');
|
||||
INCLUDE complexType/POD/restriction.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'sequence');
|
||||
THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType complexContent extension not implemented yet";
|
||||
ELSE;
|
||||
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
|
||||
END;
|
||||
|
||||
%]
|
||||
@@ -0,0 +1,7 @@
|
||||
[% indent %]{
|
||||
[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% 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,13 @@
|
||||
[% IF (complexType.get_variety == 'all');
|
||||
INCLUDE complexType/POD/all.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'sequence');
|
||||
INCLUDE complexType/POD/all.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'group');
|
||||
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType group not implemented yet";
|
||||
ELSIF (complexType.get_variety == 'choice');
|
||||
INCLUDE complexType/POD/choice.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_contentModel == 'simpleContent');
|
||||
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType simpleContent not implemented yet";
|
||||
ELSIF (complexType.get_contentModel == 'complexContent');
|
||||
INCLUDE complexType/POD/complexContent.tt(complexType = complexType);
|
||||
END %],
|
||||
@@ -0,0 +1,49 @@
|
||||
use Class::Std::Fast::Storable constructor => 'none';
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
|
||||
|
||||
Class::Std::initialize();
|
||||
|
||||
{ # BLOCK to scope variables
|
||||
[%
|
||||
atomic_types = {};
|
||||
|
||||
FOREACH element = complexType.get_element %]
|
||||
my %[% element.get_name %]_of :ATTR(:get<[% element.get_name %]>);
|
||||
[%- END %]
|
||||
|
||||
__PACKAGE__->_factory(
|
||||
[ qw([% FOREACH element = complexType.get_element %]
|
||||
[% element.get_name -%]
|
||||
[% END %]
|
||||
) ],
|
||||
{
|
||||
[% FOREACH element = complexType.get_element -%]
|
||||
[% element.get_name %] => \%[% element.get_name %]_of,
|
||||
[% END -%]
|
||||
},
|
||||
{
|
||||
[% FOREACH element = complexType.get_element;
|
||||
IF (type = element.get_type);
|
||||
element_type = complexType.expand( type );
|
||||
IF (element_type.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
|
||||
[% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% element_type.1 %]',
|
||||
[% ELSE -%]
|
||||
[% element.get_name %] => '[% type_prefix %]::[% element_type.1 %]',
|
||||
[% END;
|
||||
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";
|
||||
END; %]
|
||||
[% element.get_name %] => '[% type_prefix %]::[% complexType.get_name %]::_[% element.get_name %]',
|
||||
[% END;
|
||||
END -%]
|
||||
}
|
||||
);
|
||||
|
||||
} # end BLOCK
|
||||
|
||||
[% INCLUDE complexType/atomicTypes.tt(atomic_types = atomic_types) %]
|
||||
@@ -0,0 +1,19 @@
|
||||
|
||||
[% FOREACH type IN atomic_types; %]
|
||||
|
||||
package [% type_prefix %]::[% complexType.get_name %]::_[% type.key %];
|
||||
use strict;
|
||||
use warnings;
|
||||
{
|
||||
[% IF ( type.value.isa('SOAP::WSDL::XSD::ComplexType') );
|
||||
INCLUDE complexType/contentModel.tt(complexType = type.value );
|
||||
ELSIF ( type.value.isa('SOAP::WSDL::XSD::SimpleType') );
|
||||
INCLUDE simpleType/contentModel.tt(simpleType = type.value );
|
||||
ELSE;
|
||||
PERL; %] die $stash->{ type } [% END;
|
||||
THROW UNKNOWN, "neither complex nor simple type - don't know what to do";
|
||||
END
|
||||
%]
|
||||
}
|
||||
|
||||
[% END %]
|
||||
@@ -0,0 +1,40 @@
|
||||
{ # BLOCK to scope variables
|
||||
[%
|
||||
|
||||
FOREACH element = complexType.get_attribute %]
|
||||
my %[% element.get_name %]_of :ATTR(:get<[% element.get_name %]>);
|
||||
[%- END %]
|
||||
|
||||
__PACKAGE__->_factory(
|
||||
[ qw([% FOREACH element = complexType.get_attribute %]
|
||||
[% element.get_name -%]
|
||||
[% END %]
|
||||
) ],
|
||||
{
|
||||
[% FOREACH element = complexType.get_attribute -%]
|
||||
[% element.get_name %] => \%[% element.get_name %]_of,
|
||||
[% END -%]
|
||||
},
|
||||
{
|
||||
[% FOREACH element = complexType.get_attribute;
|
||||
IF (type = element.get_type);
|
||||
element_type = complexType.expand( type );
|
||||
IF (element_type.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
|
||||
[% element.get_name %] => 'SOAP::WSDL::XSD::Typelib::Builtin::[% element_type.1 %]',
|
||||
[% ELSE -%]
|
||||
[% element.get_name %] => '[% type_prefix %]::[% element_type.1 %]',
|
||||
[% END;
|
||||
ELSE;
|
||||
IF (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 %] => '[% type_prefix %]::[% complexType.get_name %]::_[% element.get_name %]',
|
||||
[% END;
|
||||
END -%]
|
||||
}
|
||||
);
|
||||
|
||||
} # end BLOCK
|
||||
@@ -0,0 +1,8 @@
|
||||
[% IF (complexType.get_variety == 'restriction');
|
||||
INCLUDE complexType/restriction.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'sequence');
|
||||
INCLUDE complexType/extension.tt(complexType = complexType);
|
||||
ELSE;
|
||||
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
|
||||
END;
|
||||
%]
|
||||
@@ -0,0 +1,7 @@
|
||||
[% IF (complexType.get_contentModel == 'simpleContent');
|
||||
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType simpleContent not implemented yet";
|
||||
ELSIF (complexType.get_contentModel == 'complexContent');
|
||||
INCLUDE complexType/complexContent.tt(complexType = complexType);
|
||||
ELSE;
|
||||
INCLUDE complexType/variety.tt(complexType = complexType);
|
||||
END %]
|
||||
@@ -0,0 +1,28 @@
|
||||
[%
|
||||
|
||||
base_name=complexType.expand( complexType.get_base );
|
||||
base_type = definitions.first_types.find_type( base_name );
|
||||
|
||||
element_from = complexType.get_element;
|
||||
|
||||
#
|
||||
# Sanity check: All original elements must be noted first
|
||||
#
|
||||
element_list = base_type.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;
|
||||
|
||||
complexType.set_element( element_list );
|
||||
|
||||
-%]
|
||||
use base qw([% type_prefix %]::[% base_name.1.replace('\.', '::') %]);
|
||||
[%
|
||||
|
||||
INCLUDE complexType/variety.tt(complexType = complexType);
|
||||
|
||||
%]
|
||||
@@ -0,0 +1,8 @@
|
||||
[% IF (base=complexType.get_base);
|
||||
base_name=complexType.expand(base);
|
||||
-%]
|
||||
use base qw([% type_prefix %]::[% base_name.1.replace('\.', '::') %]);
|
||||
[%
|
||||
ELSE;
|
||||
THROW NOT_IMPLEMENTED, "restriction without base not supported";
|
||||
END %]
|
||||
@@ -0,0 +1,15 @@
|
||||
[%
|
||||
IF (complexType.get_variety == 'all');
|
||||
INCLUDE complexType/all.tt(complexType = complexType);
|
||||
ELSIF (complexType.get_variety == 'sequence');
|
||||
INCLUDE complexType/all.tt(complexType = complexType);
|
||||
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 })";
|
||||
ELSE;
|
||||
# There's no variety - might be empty complexType
|
||||
END;
|
||||
%]
|
||||
@@ -0,0 +1,91 @@
|
||||
package [% element_prefix %]::[% element.get_name.replace('\.','::') %];
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
{ # BLOCK to scope variables
|
||||
|
||||
sub get_xmlns { '[% element.get_targetNamespace %]' }
|
||||
|
||||
__PACKAGE__->__set_name('[% element.get_name %]');
|
||||
__PACKAGE__->__set_nillable([% element.get_nillable %]);
|
||||
__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); -%]
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
[% INCLUDE _type_class.tt( type = type, node = element ) %]
|
||||
);
|
||||
|
||||
}
|
||||
[%- ELSIF (ref = element.get_ref); -%]
|
||||
# element ref="[% ref %]"
|
||||
use base qw(
|
||||
[% element_prefix %]::[% ref.split(':').1 %]
|
||||
);
|
||||
|
||||
}
|
||||
[%- ELSIF (simpleType = element.first_simpleType) %]
|
||||
# atomic simpleType: <element><simpleType
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
);
|
||||
[% INCLUDE simpleType/contentModel.tt -%]
|
||||
|
||||
}
|
||||
|
||||
[% ELSIF (complexType = element.first_complexType) %]
|
||||
use base qw(
|
||||
SOAP::WSDL::XSD::Typelib::Element
|
||||
SOAP::WSDL::XSD::Typelib::ComplexType
|
||||
);
|
||||
[% INCLUDE complexType/contentModel.tt -%]
|
||||
|
||||
}
|
||||
|
||||
package [% element_prefix %]::[% element.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
|
||||
use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
|
||||
[% INCLUDE complexType/attributeSet.tt %]
|
||||
|
||||
[% ELSE %]
|
||||
|
||||
} # end of BLOCK
|
||||
|
||||
[% 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
|
||||
|
||||
[% element_prefix %]::[% element.get_name %]
|
||||
|
||||
[% head1 %] DESCRIPTION
|
||||
|
||||
Perl data type class for the XML Schema defined element
|
||||
[% element.get_name %] from the namespace [% element.get_targetNamespace %].
|
||||
|
||||
[% head1 %] METHODS
|
||||
|
||||
[% head2 %] new
|
||||
|
||||
my $element = [% element_prefix %]::[% element.get_name %]->new($data);
|
||||
|
||||
Constructor. The following data structure may be passed to new():
|
||||
|
||||
[% indent = ' '; INCLUDE element/POD/structure.tt; %]
|
||||
|
||||
[% head1 %] AUTHOR
|
||||
|
||||
Generated by SOAP::WSDL
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,30 @@
|
||||
[%- IF (name = element.get_type);
|
||||
type_name = element.expand(name);
|
||||
IF (type_name.0 == 'http://www.w3.org/2001/XMLSchema'); -%]
|
||||
$some_value, # [% type_name.1 %]
|
||||
[%-
|
||||
RETURN;
|
||||
ELSIF (type = definitions.first_types.find_type( type_name ));
|
||||
IF (type.isa('SOAP::WSDL::XSD::ComplexType') );
|
||||
INCLUDE complexType/POD/structure.tt(complexType = type);
|
||||
RETURN;
|
||||
ELSE;
|
||||
INCLUDE simpleType/POD/structure.tt(simpleType = type);
|
||||
END;
|
||||
RETURN;
|
||||
END;
|
||||
THROW NOT_FOUND, "no type found for {${type_name.0}}${type_name.1}";
|
||||
ELSIF (ref = element.get_ref);
|
||||
ref_element = definitions.first_types.find_element( element.expand( ref ) );
|
||||
INCLUDE element/POD/structure.tt(element = ref_element);
|
||||
RETURN;
|
||||
ELSIF (type = element.first_simpleType);
|
||||
INCLUDE simpleType/POD/structure.tt(simpleType = type);
|
||||
RETURN;
|
||||
ELSIF (type = element.first_complexType);
|
||||
INCLUDE complexType/POD/structure.tt(complexType = type);
|
||||
ELSE;
|
||||
THROW NOT_FOUND, "no type found for ${element.get_name}";
|
||||
%]
|
||||
NO TYPE FOUND FOR ELEMENT [% element.get_name %]
|
||||
[% END -%]
|
||||
@@ -0,0 +1,63 @@
|
||||
package [% type_prefix %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %];
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub get_xmlns { '[% simpleType.get_targetNamespace %]'};
|
||||
|
||||
[% INCLUDE simpleType/contentModel.tt %]
|
||||
[%#
|
||||
# Don't include any perl source here - there may be sub-packages...
|
||||
#-%]
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
[%# 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 %] [% type_prefix %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %]
|
||||
|
||||
[% 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 %]
|
||||
|
||||
[% head1 %] METHODS
|
||||
|
||||
[% head2 %] new
|
||||
|
||||
Constructor.
|
||||
|
||||
[% head2 %] get_value / set_value
|
||||
|
||||
Getter and setter for the simpleType's value.
|
||||
|
||||
[% head1 %] OVERLOADING
|
||||
|
||||
Depending on the simple type's base type, the following operations are overloaded
|
||||
|
||||
Stringification
|
||||
Numerification
|
||||
Boolification
|
||||
|
||||
Check L<SOAP::WSDL::XSD::Typelib::Builtin> for more information.
|
||||
|
||||
[% head1 %] AUTHOR
|
||||
|
||||
Generated by SOAP::WSDL
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,20 @@
|
||||
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;
|
||||
# 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 -%].
|
||||
|
||||
You may pass the following structure to new():
|
||||
|
||||
[ $value_1, .. $value_n ]
|
||||
|
||||
All elements of the list must be of the class' base type (or valid arguments
|
||||
to it's constructor).
|
||||
@@ -0,0 +1,16 @@
|
||||
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;
|
||||
# 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 -%]
|
||||
. SOAP::WSDL's schema implementation does not validate data, so you can use it exactly
|
||||
like it's base type.
|
||||
|
||||
# Description of restrictions not implemented yet.
|
||||
@@ -0,0 +1 @@
|
||||
$some_value, # [% IF (simpleType.get_name); simpleType.get_name; ELSE %]atomic[% END %]
|
||||
@@ -0,0 +1,3 @@
|
||||
# atomic simple type.
|
||||
|
||||
[% INCLUDE simpleType/contentModel.tt(simpleType = type ); %]
|
||||
@@ -0,0 +1,7 @@
|
||||
[% IF (simpleType.get_variety == 'list');
|
||||
INCLUDE simpleType/list.tt(simpleType = simpleType);
|
||||
ELSIF (simpleType.get_variety == 'restriction');
|
||||
INCLUDE simpleType/restriction.tt(type = simpleType);
|
||||
ELSE;
|
||||
THROW NOT_IMPLEMENTED "${ element.get_name } - ${ simpleType.get_variety } not supported yet";
|
||||
END %]
|
||||
@@ -0,0 +1,21 @@
|
||||
# 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 %]
|
||||
);
|
||||
[% ELSE -%]
|
||||
[% type_prefix %]::[% type_name.1 %]
|
||||
);
|
||||
[% END;
|
||||
ELSIF (type = simpleType.first_simpleType); %]
|
||||
);
|
||||
|
||||
[% INCLUDE simpleType/atomicType.tt(type = type);
|
||||
ELSE; PERL %]die $stash->{simpleType}._DUMP [% END;
|
||||
THROW UNKNOWN , "No list itemTape and no atomic simpleType - don't know what to do";
|
||||
END %]
|
||||
|
||||
@@ -0,0 +1,9 @@
|
||||
# derivation by restriction
|
||||
[% IF (base = simpleType.get_base) -%]
|
||||
use base qw(
|
||||
[% INCLUDE _type_class.tt(type = base, node=simpleType) %]);
|
||||
[% 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 %]
|
||||
@@ -0,0 +1,315 @@
|
||||
package SOAP::WSDL::Generator::Visitor;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Fast::Storable;
|
||||
|
||||
our $VERSION = q{2.00_25};
|
||||
|
||||
my %definitions_of :ATTR(:name<definitions> :default<()>);
|
||||
my %type_prefix_of :ATTR(:name<type_prefix> :default<()>);
|
||||
my %element_prefix_of :ATTR(:name<element_prefix> :default<()>);
|
||||
|
||||
sub START {
|
||||
my ($self, $ident, $arg_ref) = @_;
|
||||
$type_prefix_of{ $ident } = 'MyType' if not exists
|
||||
$arg_ref->{ 'type_prefix' };
|
||||
$element_prefix_of{ $ident } = 'MyElement' if not exists
|
||||
$arg_ref->{ 'element_prefix' };
|
||||
|
||||
}
|
||||
|
||||
|
||||
# WSDL stuff
|
||||
sub visit_Definitions {}
|
||||
sub visit_Binding {}
|
||||
sub visit_Message {}
|
||||
sub visit_Operation {}
|
||||
sub visit_OpMessage {}
|
||||
sub visit_Part {}
|
||||
sub visit_Port {}
|
||||
sub visit_PortType {}
|
||||
sub visit_Service {}
|
||||
sub visit_SoapOperation {}
|
||||
sub visit_Types {}
|
||||
|
||||
# XML Schema stuff
|
||||
sub visit_XSD_Schema {}
|
||||
sub visit_XSD_ComplexType {}
|
||||
sub visit_XSD_Element {}
|
||||
sub visit_XSD_SimpleType {}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
SOAP::WSDL::Generator::Visitor - SOAP::WSDL's Visitor-based Code Generator
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
SOAP::WSDL features a code generating facility. This code generation facility
|
||||
(in fact there are several of them) is implemented as Visitor to
|
||||
SOAP::WSDL::Base-derived objects.
|
||||
|
||||
=head2 The Visitor Pattern
|
||||
|
||||
The Visitor design pattern is one of the object oriented design pattern
|
||||
described by [GHJV1995].
|
||||
|
||||
A Visitor is an object implementing some behaviour for a fixed set of classes,
|
||||
whose implementation would otherwise need to be scattered accross those
|
||||
classes' implementations.
|
||||
|
||||
Visitors are usually combined with Iterators for traversing either a list or
|
||||
tree of objects.
|
||||
|
||||
A Visitor's methods are called using the so-called double dispatch technique.
|
||||
To allow double dispatching, the Visitor implements one method for every class
|
||||
ro be handled, whereas every class implements just one method (commonly named
|
||||
"access"), which does nothing more than calling a method on the reference
|
||||
given, with the self object as parameter.
|
||||
|
||||
If all this sounds strange, maybe an example helps. Imagine you had a list of
|
||||
person objects and wanted to print out a list of their names (or address
|
||||
stamps or everything elseyou like). This can easily be implemented with a
|
||||
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);
|
||||
}
|
||||
|
||||
# will print
|
||||
Person name is Gamma
|
||||
Person name is Helm
|
||||
Person name is Johnson
|
||||
Person name is Vlissides
|
||||
|
||||
While using this pattern for just printing a list may look a bit over-sized,
|
||||
but it may become handy if you need multiple output formats and different
|
||||
classes to operate on.
|
||||
|
||||
The main benefits using visitors are:
|
||||
|
||||
=over
|
||||
|
||||
=item * Grouping related behaviour in one class
|
||||
|
||||
Related behaviour for several classes can be grouped together in the Visitor
|
||||
class. The behaviour can easily be changed by changing the code in one class,
|
||||
instead of having to change all the visited classes.
|
||||
|
||||
=item * Cleaning up the data classes' implementations
|
||||
|
||||
If classes holding data also implement several different output formats or
|
||||
other (otherwise unrelated) behaviour, they tend to get bloated.
|
||||
|
||||
=item * Adding behaviour is easy
|
||||
|
||||
Swapping out the visitor class allows easy alterations of behaviour. So on a
|
||||
list of Persons, one Visitor may print address stamps, while another one prints
|
||||
out a phone number list.
|
||||
|
||||
=back
|
||||
|
||||
Of course, there are also drawbacks in the visitor pattern:
|
||||
|
||||
=over
|
||||
|
||||
=item * Changes in the visited classes are expensive
|
||||
|
||||
If one of the visited classes changes (or is added), all visitors must be
|
||||
updated to reflect this change. This may be rather expensive if classes change
|
||||
often.
|
||||
|
||||
=item * The visited classes must expose all data required
|
||||
|
||||
Visitors may need to use the internals of a class. This may result in fidelling
|
||||
with a object's internals, or a bloated interface in the visited class.
|
||||
|
||||
=back
|
||||
|
||||
Visitors are usually accompanied by a Iterator. The Iterator may be implemented
|
||||
in the visited classes, in the Visitor, or somewhere else (in the example it
|
||||
was somewhere else).
|
||||
|
||||
The Iterator decides which object to visit next.
|
||||
|
||||
=head2 Why SOAP::WSDL uses the Visitor pattern for Code Generation
|
||||
|
||||
Code generation in SOAP::WSDL means generating various artefacts:
|
||||
|
||||
=over
|
||||
|
||||
=item * Typemaps
|
||||
|
||||
For every WSDL definition, a Typemap is created. The Typemap is used later as
|
||||
an aid in parsing the SOAP XML messages.
|
||||
|
||||
=item * Type Classes
|
||||
|
||||
For every type defined in the WSDL's schema, a Type Class is generated.
|
||||
|
||||
These classes are instantiated later as a result of parsing SOAP XML messages.
|
||||
|
||||
=item * Interface Classes
|
||||
|
||||
For every service, a interface class is generated. This class is later used by
|
||||
programmers accessing the service
|
||||
|
||||
=item * Documentation
|
||||
|
||||
Both Type Classes and Interface Classes include documentation. Additional
|
||||
documentation may be generated as a hint for programmers, or later for
|
||||
mimicing .NET's .asmx example pages.
|
||||
|
||||
=back
|
||||
|
||||
All these behaviours could well be (and have historically been) implemented in
|
||||
the classes holding the WSDL data. This made these classes rather bloated, and
|
||||
made it hard to change behaviour (like, supporting SOAP Headers,
|
||||
supporting atomic types and other features which were missing from early
|
||||
versions of SOAP::WSDL).
|
||||
|
||||
Implementing these behaviours in Visitor classes eases adding new behaviours,
|
||||
and reducing the incompletenesses still inherent in SOAP::WSDL's WSDL and XML
|
||||
schema implementation.
|
||||
|
||||
=head2 Implementation
|
||||
|
||||
=head3 accept
|
||||
|
||||
SOAP::WSDL::Base defines an accept method which expects a Visitor as only
|
||||
parameter.
|
||||
|
||||
The method visit_Foo_Bar is called on the visitor, whith the self object as
|
||||
parameter.
|
||||
|
||||
The actual method name is constructed this way:
|
||||
|
||||
=over
|
||||
|
||||
=item * SOAP::WSDL is stripped from the class name
|
||||
|
||||
=item * All remaining :: s are replaced by _
|
||||
|
||||
=back
|
||||
|
||||
Example:
|
||||
|
||||
When visiting a SOAP::WSDL::XSD::ComplexType object, the method
|
||||
visit_XSD_ComplexType is called on the visitor.
|
||||
|
||||
=head2 Writing your own visitor
|
||||
|
||||
SOAP::WSDL eases writing your own visitor. This might be required if you need
|
||||
some special output format from a WSDL file, or want to feed your own
|
||||
serializer/deserializer pair with custom configuration data. Or maybe you want
|
||||
to generate C# code from it...
|
||||
|
||||
To write your own code generating visitor, you should subclass
|
||||
SOAP::WSDL::Generator::Visitor. It implements (empty) default methods for all
|
||||
SOAP::WSDL data classes:
|
||||
|
||||
=over
|
||||
|
||||
=item * visit_Definitions
|
||||
|
||||
=item * visit_Binding
|
||||
|
||||
=item * visit_Message
|
||||
|
||||
=item * visit_Operation
|
||||
|
||||
=item * visit_OpMessage
|
||||
|
||||
=item * visit_Part
|
||||
|
||||
=item * visit_Port
|
||||
|
||||
=item * visit_PortType
|
||||
|
||||
=item * visit_Service
|
||||
|
||||
=item * visit_SoapOperation
|
||||
|
||||
=item * visit_Types
|
||||
|
||||
=item * visit_XSD_Schema
|
||||
|
||||
=item * visit_XSD_ComplexType
|
||||
|
||||
=item * visit_XSD_Element
|
||||
|
||||
=item * visit_XSD_SimpleType
|
||||
|
||||
=back
|
||||
|
||||
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
|
||||
Iterator (which means they know how to find the next objects to visit). You
|
||||
may or may not choose to implement a separate Iterator.
|
||||
|
||||
Letting a visitor implementing it's own Iterator visit a WSDL definition is as
|
||||
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 );
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over
|
||||
|
||||
=item * [GHJV1995]
|
||||
|
||||
Erich Gamma, Richard Helm, Ralph E. Johnson, John Vlissides, (1995):
|
||||
Design Patterns. Elements of Reusable Object-Oriented Software.
|
||||
Addison-Wesley Longman, Amsterdam.
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
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>
|
||||
|
||||
=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
|
||||
@@ -0,0 +1,10 @@
|
||||
package SOAP::WSDL::Generator::Visitor::Typelib;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(SOAP::WSDL::Generator::Visitor
|
||||
SOAP::WSDL::Generator::Template
|
||||
);
|
||||
|
||||
|
||||
1;
|
||||
|
||||
@@ -0,0 +1,259 @@
|
||||
package SOAP::WSDL::Generator::Visitor::Typemap;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Fast::Storable;
|
||||
|
||||
use base qw(SOAP::WSDL::Generator::Visitor);
|
||||
|
||||
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<()>);
|
||||
|
||||
sub START {
|
||||
my ($self, $ident, $arg_ref) = @_;
|
||||
$type_prefix_of{ $ident } ||= 'MyTypes';
|
||||
$element_prefix_of{ $ident } ||= 'MyElements';
|
||||
}
|
||||
|
||||
sub set_typemap_entry {
|
||||
my ($self, $value) = @_;
|
||||
# warn join( q{/}, @{ $path_of{ ident $self } }) . " => $value";
|
||||
$typemap_of{ ident $self }->{
|
||||
join( q{/}, @{ $path_of{ ident $self } } )
|
||||
} = $value;
|
||||
}
|
||||
|
||||
sub add_element_path {
|
||||
my ($self, $element) = @_;
|
||||
|
||||
# Swapping out this lines against the ones below generates
|
||||
# a namespace-sensitive typemap.
|
||||
# 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();
|
||||
}
|
||||
|
||||
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;
|
||||
my $ident = ident $self;
|
||||
|
||||
# get type's class name
|
||||
# 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() );
|
||||
}
|
||||
|
||||
# set before to allow it to be used from inside _accept
|
||||
$self->set_typemap_entry($typeclass);
|
||||
|
||||
$type->_accept($self) if ($type);
|
||||
|
||||
# set afterwards again (just to be sure...)
|
||||
$self->set_typemap_entry($typeclass);
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub process_atomic_type {
|
||||
my ( $self, $type, $callback ) = @_;
|
||||
return if not $type;
|
||||
|
||||
my $ident = ident $self;
|
||||
$callback->( $self, $type ) if $callback;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub visit_XSD_Element {
|
||||
my ( $self, $ident, $element ) = ( $_[0], ident $_[0], $_[1] );
|
||||
|
||||
# warn "simpleType " . $element->get_name();
|
||||
my @path = @{ $path_of{ ${ $self } } };
|
||||
my $path = join '/', @path;
|
||||
my $parent = $typemap_of{ ${ $self } }->{ $path };
|
||||
|
||||
# step down in tree
|
||||
$self->add_element_path( $element );
|
||||
|
||||
# now call all possible variants.
|
||||
# They all just return if no argument is given,
|
||||
# and return $self on success.
|
||||
SWITCH: {
|
||||
if ($element->get_type) {
|
||||
$self->process_referenced_type( $element->expand( $element->get_type() ) )
|
||||
&& last;
|
||||
}
|
||||
|
||||
# atomic simpleType typemap rule:
|
||||
# if we have a parent, use parent's sub-package.
|
||||
# if not, use element package.
|
||||
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();
|
||||
$self->set_typemap_entry($typeclass);
|
||||
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;
|
||||
$self->set_typemap_entry($typeclass);
|
||||
|
||||
$self->process_atomic_type( $element->first_complexType()
|
||||
, sub { $_[1]->_accept($_[0]) } )
|
||||
&& last;
|
||||
|
||||
# TODO: add element ref handling
|
||||
};
|
||||
|
||||
# Safety measure. If someone defines a top-level element with
|
||||
# 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;
|
||||
$self->set_typemap_entry($typeclass);
|
||||
}
|
||||
|
||||
# step up in hierarchy
|
||||
pop @{ $path_of{$ident} };
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
if ( grep { $_ eq $content_model} qw(all sequence choice) )
|
||||
{
|
||||
# visit child elements
|
||||
for (@{ $type->get_element() || [] }) {
|
||||
$_->_accept( $self );
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
warn "unsupported content model $content_model found in "
|
||||
. "complex type " . $type->get_name()
|
||||
. " - typemap may be incomplete";
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user