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

import SOAP-WSDL 2.00_25 from CPAN

Browse Source 
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_25
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_25.tar.gz
This commit is contained in:
Martin Kutter
2009-12-12 19:48:11 -08:00
committed by Michael G. Schwern
parent 84b53d9261
commit a9033164e6
177 changed files with 3449 additions and 2063 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lib/SOAP/WSDL/Generator/Template.pm
+11 -6
View File
@@ -1,12 +1,13 @@
package SOAP::WSDL::Generator::Template;
use strict;
use Template;
use Class::Std::Storable;
use Class::Std::Fast::Storable;
our $VERSION='2.00_17';
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>);
@@ -23,17 +24,21 @@ sub START {
sub _process :PROTECTED {
my ($self, $template, $arg_ref, $output) = @_;
my $ident = ident $self;
my $tt = $tt_of{$ident} ||= Template->new(
$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 },
);
$tt->process( $template,
)
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,
@@ -42,7 +47,7 @@ sub _process :PROTECTED {
%{ $arg_ref }
},
$output)
or die $INCLUDE_PATH_of{ $ident }, '\\', $template, ' ', $tt->error();
or die $INCLUDE_PATH_of{ $ident }, '\\', $template, ' ', $tt_of{ $ident }->error();
}
1;
lib/SOAP/WSDL/Generator/Template/XSD.pm
+38 -5
View File
@@ -1,10 +1,12 @@
package SOAP::WSDL::Generator::Template::XSD;
use strict;
use Template;
use Class::Std::Storable;
use Class::Std::Fast::Storable;
use File::Basename;
use File::Spec;
our $VERSION = q{2.00_25};
use SOAP::WSDL::Generator::Visitor::Typemap;
use SOAP::WSDL::Generator::Visitor::Typelib;
use base qw(SOAP::WSDL::Generator::Template);
@@ -32,7 +34,7 @@ sub BUILD {
);
$dir = File::Spec->catdir($dir, $file, 'XSD');
# return path put together...
my $path = File::Spec->catpath( $volume, $dir );
my $path = File::Spec->catpath( $volume, $dir , q{});
# Fixup path for windows - / works fine, \ does
# not...
@@ -48,7 +50,7 @@ sub generate {
my $self = shift;
my $opt = shift;
$self->generate_typelib( $opt );
$self->generate_interface( $opt );
# $self->generate_interface( $opt );
$self->generate_typemap( $opt );
}
@@ -63,11 +65,42 @@ sub generate_typelib {
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;
my $tt = $self->get_tt();
for my $service (@{ $self->get_definitions->get_service }) {
for my $port (@{ $service->get_port() }) {
# Skip ports without (known) address
@@ -105,7 +138,7 @@ sub generate_typemap {
typemap => {
'Fault' => 'SOAP::WSDL::SOAP::Typelib::Fault11',
'Fault/faultcode' => 'SOAP::WSDL::XSD::Typelib::Builtin::anyURI',
'Fault/faultactor' => 'SOAP::WSDL::XSD::Typelib::Builtin::TOKEN',
'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 }},
lib/SOAP/WSDL/Generator/Template/XSD/Interface.tt
+1 -1
View File
@@ -1,7 +1,7 @@
package [% interface_prefix %]::[% service.get_name.replace('\.', '::') %]::[% port.get_name.replace('^.+\.','') %];
use strict;
use warnings;
use Class::Std::Storable;
use Class::Std::Fast::Storable;
use Scalar::Util qw(blessed);
use base qw(SOAP::WSDL::Client::Base);
lib/SOAP/WSDL/Generator/Template/XSD/Server.tt
+97
View File
@@ -0,0 +1,97 @@
package [% server_prefix %]::[% service.get_name.replace('\.', '::') %]::[% port.get_name.replace('^.+\.','') %];
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__
=pod
=head1 NAME
[% interface_prefix %]::[% service.get_name.replace('\.', '::') %]::[% port.get_name.replace('\.', '::') %] - SOAP Server Class for the [% service.get_name %] Web Service
=head1 SYNOPSIS
use [% server_prefix %]::[% service.get_name.replace('\.', '::') %]::[% port.get_name.replace('\.', '::') %];
my $server = [% server_prefix %]::[% service.get_name.replace('\.', '::') %]::[% port.get_name.replace('\.', '::') %]->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
lib/SOAP/WSDL/Generator/Template/XSD/Server/POD/Message.tt
+9
View File
@@ -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;
%]
lib/SOAP/WSDL/Generator/Template/XSD/Server/POD/Operation.tt
+15
View File
@@ -0,0 +1,15 @@
=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 %]
}
lib/SOAP/WSDL/Generator/Template/XSD/Server/POD/OutPart.tt
+10
View File
@@ -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; %]
);
lib/SOAP/WSDL/Generator/Template/XSD/Server/POD/method_info.tt
+4
View File
@@ -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.
lib/SOAP/WSDL/Generator/Template/XSD/Typemap.tt
+4
View File
@@ -10,6 +10,10 @@ sub get_class {
return $typemap_1->{ $name };
}
sub get_typemap {
return $typemap_1;
}
1;
__END__
lib/SOAP/WSDL/Generator/Template/XSD/complexType/all.tt
+3 -1
View File
@@ -1,6 +1,8 @@
use Class::Std::Storable;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
Class::Std::initialize();
{ # BLOCK to scope variables
[%
atomic_types = {};
lib/SOAP/WSDL/Generator/Visitor.pm
+2 -2
View File
@@ -1,9 +1,9 @@
package SOAP::WSDL::Generator::Visitor;
use strict;
use warnings;
use Class::Std::Storable;
use Class::Std::Fast::Storable;
our $VERSION = '2.00_17';
our $VERSION = q{2.00_25};
my %definitions_of :ATTR(:name<definitions> :default<()>);
my %type_prefix_of :ATTR(:name<type_prefix> :default<()>);
lib/SOAP/WSDL/Generator/Visitor/Typemap.pm
+48 -20
View File
@@ -1,10 +1,12 @@
package SOAP::WSDL::Generator::Visitor::Typemap;
use strict;
use warnings;
use Class::Std::Storable;
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<()>);
@@ -18,6 +20,7 @@ sub START {
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;
@@ -145,16 +148,21 @@ sub process_referenced_type {
# get type's class name
# Caveat: visits type if it's a referenced type from the
# a ? b : c operation.
my $typeclass =
( $ns eq 'http://www.w3.org/2001/XMLSchema' )
? "SOAP::WSDL::XSD::Typelib::Builtin::$localname"
: do {
my $type =
$self->get_definitions()->first_types()->find_type( $ns, $localname );
$type->_accept($self);
join( q{::}, $type_prefix_of{$ident}, $type->get_name() );
};
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;
}
@@ -171,8 +179,10 @@ sub process_atomic_type {
sub visit_XSD_Element {
my ( $self, $ident, $element ) = ( $_[0], ident $_[0], $_[1] );
# TODO: what about element ref="" ?
# when we're hopping from one element to the next one...
# 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 );
@@ -181,25 +191,43 @@ sub visit_XSD_Element {
# 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() ) )
if ($element->get_type) {
$self->process_referenced_type( $element->expand( $element->get_type() ) )
&& last;
}
# for atomic simple and comples types , and ref elements
# 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();
$self->set_typemap_entry($typeclass);
# kind of double-dispatch: returns true on success, but does nothing
$self->process_atomic_type( $element->first_simpleType() )
&& last;
$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();
$self->set_typemap_entry($typeclass);
}
# step up in hierarchy
pop @{ $path_of{$ident} };
}