import SOAP-WSDL 2.00_32 from CPAN

git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_32
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_32.tar.gz
This commit is contained in:
Martin Kutter
2008-02-14 09:13:39 -08:00
committed by Michael G. Schwern
parent f0b3bdc201
commit 51db446428
36 changed files with 376 additions and 106 deletions

View File

@@ -14,7 +14,7 @@ use Class::Std::Fast;
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
use LWP::UserAgent;
our $VERSION= '2.00_31';
our $VERSION= '2.00_32';
my %no_dispatch_of :ATTR(:name<no_dispatch>);
my %wsdl_of :ATTR(:name<wsdl>);
@@ -736,9 +736,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 524 $
$Rev: 534 $
$LastChangedBy: kutterma $
$Id: WSDL.pm 524 2008-02-10 23:24:43Z kutterma $
$Id: WSDL.pm 534 2008-02-14 17:07:18Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL.pm $
=cut

View File

@@ -6,7 +6,7 @@ use XML::Parser::Expat;
# TODO: convert to Class::Std::Fast based class - hash based classes suck.
our $VERSION = '2.00_27';
our $VERSION = '2.00_32';
sub new {
my ($class, $arg_ref) = @_;
@@ -15,20 +15,45 @@ sub new {
$self->set_user_agent($arg_ref->{ user_agent })
if $arg_ref->{ user_agent };
$self->{ parsed } = $arg_ref->{ parsed } if $arg_ref->{ parsed };
return $self;
}
sub clone {
my $self = shift;
my $class = ref $self;
my $clone = $class->new($self);
return $clone;
}
sub set_uri { $_[0]->{ uri } = $_[1]; }
sub get_uri { return $_[0]->{ uri }; }
sub set_user_agent { $_[0]->{ user_agent } = $_[1]; }
sub get_user_agent { return $_[0]->{ user_agent }; }
sub set_parsed {
my ($self, $uri) = @_;
$self->{ parsed }->{ $uri } = 1;
return;
}
sub is_parsed {
my ($self, $uri) = @_;
return exists $self->{ parsed }->{ $uri };
}
sub parse_uri {
my $self = shift;
my $uri = shift;
if ($self->is_parsed($uri)){
warn "$uri already imported. Ignoring it\n";
return;
}
$self->set_parsed($uri);
$self->set_uri( $uri );
if (not $self->{ user_agent }) {
@@ -37,7 +62,6 @@ sub parse_uri {
}
my $response = $self->{ user_agent }->get($uri);
die $response->message() if $response->code() ne '200';
return $self->parse( $response->content() );
}

View File

@@ -5,10 +5,12 @@ use Carp;
use SOAP::WSDL::TypeLookup;
use base qw(SOAP::WSDL::Expat::Base);
our $VERSION = q{2.00_31};
our $VERSION = q{2.00_32};
sub _import_children {
my ($self, $name, $imported, $importer, $import_namespace) = @_;
return if not $imported;
my $targetNamespace = $importer->get_targetNamespace();
my $push_method = "push_$name";
my $get_method = "get_$name";
@@ -32,7 +34,7 @@ sub _import_children {
sub xml_schema_import {
my $self = shift;
my $schema = shift;
my $parser = ref($self)->new();
my $parser = $self->clone();
my %attr_of = @_;
my $import_namespace = $attr_of{ namespace };
my $uri = URI->new_abs($attr_of{schemaLocation}, $self->get_uri() );
@@ -46,7 +48,7 @@ sub xml_schema_import {
sub wsdl_import {
my $self = shift;
my $definitions = shift;
my $parser = ref($self)->new();
my $parser = $self->clone();
my %attr_of = @_;
my $import_namespace = $attr_of{ namespace };
my $uri = URI->new_abs($attr_of{location}, $self->get_uri() );
@@ -243,8 +245,8 @@ the same terms as perl itself
$Id: $
$LastChangedDate: 2008-02-11 00:14:27 +0100 (Mo, 11 Feb 2008) $
$LastChangedRevision: 522 $
$LastChangedDate: 2008-02-14 18:07:18 +0100 (Do, 14 Feb 2008) $
$LastChangedRevision: 534 $
$LastChangedBy: kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/WSDLParser.pm $

View File

@@ -25,17 +25,33 @@ sub _process :PROTECTED {
my ($self, $template, $arg_ref, $output) = @_;
my $ident = ident $self;
$tt_of{$ident} = Template->new(
# always create a new Template object to
# force re-loading of plugins.
my $tt = 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 });
PLUGIN_BASE => 'SOAP::WSDL::Generator::Template::Plugin',
);
$tt_of{ $ident }->process( $template,
$tt->process( $template,
{
context => {
namespace_prefix_map => {
'http://www.w3.org/2001/XMLSchema' => 'SOAP::WSDL::XSD::Typelib::Builtin',
},
namespace_map => {
},
prefix => {
interface => $self->get_interface_prefix,
element => $self->get_element_prefix,
server => $self->get_server_prefix,
type => $self->get_type_prefix,
typemap => $self->get_typemap_prefix,
}
},
definitions => $self->get_definitions,
interface_prefix => $self->get_interface_prefix,
server_prefix => $self->get_server_prefix,
@@ -47,7 +63,7 @@ sub _process :PROTECTED {
%{ $arg_ref }
},
$output)
or die $INCLUDE_PATH_of{ $ident }, '\\', $template, ' ', $tt_of{ $ident }->error();
or die $INCLUDE_PATH_of{ $ident }, '\\', $template, ' ', $tt->error();
}
1;

View File

@@ -0,0 +1,61 @@
package SOAP::WSDL::Generator::Template::Plugin::XSD;
use strict;
use warnings;
use Class::Std::Fast::Storable constructor => 'none';
my %namespace_prefix_map_of :ATTR(:name<namespace_prefix_map> :default<{}>);
my %namespace_map_of :ATTR(:name<namespace_map> :default<{}>);
my %prefix_of :ATTR(:name<prefix> :default<()>);
# create a singleton
sub load { # called as MyPlugin->load($context)
my ($class, $context, @arg_from) = @_;
my $stash = $context->stash();
my $self = bless \do { my $o = Class::Std::Fast::ID() }, $class;
use Data::Dumper;
# die Data::Dumper::Dumper $stash->{ context };
$self->set_namespace_map( $stash->{ context }->{ namespace_map });
$self->set_namespace_prefix_map( $stash->{ context }->{ namespace_prefix_map });
$self->set_prefix( $stash->{ context }->{ prefix });
return $self; # returns 'MyPlugin'
}
sub new {
return shift;
}
sub _get_prefix {
my ($self, $type, $namespace) = @_;
return $namespace_prefix_map_of{ $$self }->{ $namespace }
|| ( ($namespace_map_of{ $$self }->{ $namespace })
? join ('::', $prefix_of{ $$self }->{ $type }, $namespace_map_of{ $$self }->{ $namespace })
: $prefix_of{ $$self }->{ $type }
)
|| $prefix_of{ $$self }->{ $type };
}
sub get_element_prefix {
shift->_get_prefix( 'element', shift );
}
sub get_interface_prefix {
shift->_get_prefix( 'interface', shift );
}
sub get_server_prefix {
shift->_get_prefix( 'server', shift );
}
sub get_type_prefix {
# die "WIX";
shift->_get_prefix( 'type', shift );
}
sub get_typemap_prefix {
shift->_get_prefix( 'typemap', shift );
}
sub error {}
1;

View File

@@ -1,3 +1,4 @@
[% USE XSD -%]
[% interface_name = interface_prefix _ '::'
_ service.get_name.replace('\.', '::') _ '::'
_ port.get_name.replace('^.+\.','');
@@ -48,12 +49,12 @@ __END__
use [% interface_name %];
my $interface = [% interface_name %]->new();
my $response;
[% FOREACH operation = binding.get_operation;
%] $response = $interface->[% operation.get_name %]();
[% END %]
[% head1 %] DESCRIPTION

View File

@@ -1,3 +1,4 @@
[% USE XSD(context) -%]
package [% type_prefix %]::[% complexType.get_name.replace('\.','::').replace('-','_') %];
use strict;
use warnings;
@@ -6,8 +7,6 @@ use warnings;
# 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;

View File

@@ -1,5 +1,5 @@
[% indent %]{
[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% END %]
[%- IF complexType.get_name %] # [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %][% END %]
[%- indent = indent _ ' ';
FOREACH element = complexType.get_element %]
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]

View File

@@ -1,5 +1,5 @@
[% indent %]{
[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% END %]
[%- IF complexType.get_name %] # [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %][% END %]
[%- indent = indent _ ' ' %]
[% indent %]# One of the following elements.
[% indent %]# No occurance checks yet, so be sure to pass just one...

View File

@@ -1,7 +1,10 @@
[% 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";
ELSIF (complexType.get_variety == 'extension');
#THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType complexContent extension not implemented yet";
%]
# No documentation generated for complexContent / extension yet
[%
ELSE;
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
END;

View File

@@ -1,5 +1,5 @@
[% indent %]{
[%- IF complexType.get_name %] # [% type_prefix %]::[% complexType.get_name %][% END %]
[%- IF complexType.get_name %] # [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %][% END %]
[%- indent = indent _ ' ';
FOREACH element = complexType.get_element %]
[% indent %][% element.get_name %] => [% INCLUDE element/POD/structure.tt -%]

View File

@@ -0,0 +1,12 @@
[% IF (complexType.get_variety == 'restriction');
INCLUDE complexType/POD/restriction.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'extension');
#THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType complexContent extension not implemented yet";
%]
# No documentation generated for complexContent / extension yet
[%
ELSE;
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
END;
%]

View File

@@ -7,7 +7,7 @@ ELSIF (complexType.get_variety == 'group');
ELSIF (complexType.get_variety == 'choice');
INCLUDE complexType/POD/choice.tt(complexType = complexType);
ELSIF (complexType.get_contentModel == 'simpleContent');
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType simpleContent not implemented yet";
INCLUDE complexType/POD/simpleContent.tt(complexType = complexType);
ELSIF (complexType.get_contentModel == 'complexContent');
INCLUDE complexType/POD/complexContent.tt(complexType = complexType);
END %],

View File

@@ -24,13 +24,9 @@ __PACKAGE__->_factory(
{
[% 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;
element_type = complexType.expand( type ); -%]
[% element.get_name %] => '[% XSD.get_type_prefix(element_type.0) %]::[% element_type.1 %]',
[% ELSE;
IF (element.first_simpleType);
atomic_types.${ element.get_name } = element.first_simpleType;
ELSIF (element.first_complexType);
@@ -38,7 +34,7 @@ __PACKAGE__->_factory(
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 %]',
[% element.get_name %] => '[% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %]::_[% element.get_name %]',
[% END;
END -%]
}

View File

@@ -1,7 +1,7 @@
[% FOREACH type IN atomic_types; %]
package [% type_prefix %]::[% complexType.get_name %]::_[% type.key %];
package [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %]::_[% type.key %];
use strict;
use warnings;
{

View File

@@ -1,3 +1,7 @@
[% IF (complexType.get_attribute.size) %]
package [% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
{ # BLOCK to scope variables
[%
@@ -19,11 +23,9 @@ __PACKAGE__->_factory(
[% 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;
-%]
[% element.get_name %] => '[% XSD.get_type_prefix(element_type.0) %]::[% element_type.1 %]',
[%
ELSE;
IF (element.first_simpleType);
THROW NOT_IMPLEMENTED , "Attributes with atomic simpleType definition are not implemented yet";
@@ -31,10 +33,12 @@ __PACKAGE__->_factory(
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 %]',
[% element.get_name %] => '[% XSD.get_type_prefix(complexType.get_targetNamespace) %]::[% complexType.get_name %]::_[% element.get_name %]',
[% END;
END -%]
}
);
} # end BLOCK
[% END %]

View File

@@ -2,6 +2,8 @@
INCLUDE complexType/restriction.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'sequence');
INCLUDE complexType/extension.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'all');
INCLUDE complexType/extension.tt(complexType = complexType);
ELSE;
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
END;

View File

@@ -1,5 +1,5 @@
[% IF (complexType.get_contentModel == 'simpleContent');
THROW NOT_IMPLEMENTED, "${ element.get_name } - complexType simpleContent not implemented yet";
INCLUDE complexType/simpleContent.tt(complexType = complexType);
ELSIF (complexType.get_contentModel == 'complexContent');
INCLUDE complexType/complexContent.tt(complexType = complexType);
ELSE;

View File

@@ -20,7 +20,7 @@ END;
complexType.set_element( element_list );
-%]
use base qw([% type_prefix %]::[% base_name.1.replace('\.', '::') %]);
use base qw([% XSD.get_type_prefix(base_name.0) %]::[% base_name.1.replace('\.', '::') %]);
[%
INCLUDE complexType/variety.tt(complexType = complexType);

View File

@@ -1,7 +1,7 @@
[% IF (base=complexType.get_base);
base_name=complexType.expand(base);
-%]
use base qw([% type_prefix %]::[% base_name.1.replace('\.', '::') %]);
use base qw([% XSD.get_type_prefix(base_name.0) %]::[% base_name.1.replace('\.', '::') %]);
[%
ELSE;
THROW NOT_IMPLEMENTED, "restriction without base not supported";

View File

@@ -0,0 +1,8 @@
[% IF (complexType.get_variety == 'restriction');
INCLUDE complexType/restriction.tt(complexType = complexType);
ELSIF (complexType.get_variety == 'extension');
THROW NOT_IMPLEMENTED, "${ complexType.get_name } - complexType simpleContent extension not implemented yet";
ELSE;
THROW UNKNOWN, "unknown variety ${ complexType.get_variety }";
END;
%]

View File

@@ -1,4 +1,5 @@
package [% element_prefix %]::[% element.get_name.replace('\.','::') %];
[% USE XSD(context) %]
package [% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name.replace('\.','::') %];
use strict;
use warnings;
@@ -44,7 +45,7 @@ use base qw(
}
package [% element_prefix %]::[% element.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
package [% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name.replace('\.','::').replace('-','_') %]::_ATTR;
use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
[% INCLUDE complexType/attributeSet.tt %]
@@ -66,7 +67,7 @@ use base qw(SOAP::WSDL::XSD::Typelib::AttributeSet);
[% head1 %] NAME
[% element_prefix %]::[% element.get_name %]
[% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name %]
[% head1 %] DESCRIPTION
@@ -77,7 +78,7 @@ Perl data type class for the XML Schema defined element
[% head2 %] new
my $element = [% element_prefix %]::[% element.get_name %]->new($data);
my $element = [% XSD.get_element_prefix(element.get_targetNamespace) %]::[% element.get_name %]->new($data);
Constructor. The following data structure may be passed to new():

View File

@@ -1,4 +1,5 @@
package [% type_prefix %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %];
[% USE XSD(context) -%]
package [% XSD.get_type_prefix(simpleType.get_targetNamespace) %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %];
use strict;
use warnings;
@@ -20,7 +21,7 @@ __END__
[% pod %]
[% head1 %] [% type_prefix %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %]
[% head1 %] [% XSD.get_type_prefix(simpleType.get_targetNamespace) %]::[% simpleType.get_name.replace('\.','::').replace('-','_') %]
[% head1 %] DESCRIPTION

View File

@@ -167,22 +167,22 @@ my %TYPES = (
},
group => {
type => 'METHOD',
method => 'set_flavor',
method => 'set_variety',
value => 'group',
},
all => {
type => 'METHOD',
method => 'set_flavor',
method => 'set_variety',
value => 'all',
},
choice => {
type => 'METHOD',
method => 'set_flavor',
method => 'set_variety',
value => 'choice',
},
sequence => {
type => 'METHOD',
method => 'set_flavor',
method => 'set_variety',
value => 'sequence',
},
},

View File

@@ -9,9 +9,10 @@ use base qw/SOAP::WSDL::Base/;
our $VERSION=q{2.00_29};
my %annotation_of :ATTR(:name<annotation> :default<()>);
my %attribute_of :ATTR(:name<attribute> :default<()>);
my %attribute_of :ATTR(:name<attribute> :default<()>);
my %element_of :ATTR(:name<element> :default<()>);
my %flavor_of :ATTR(:name<flavor> :default<()>);
#my %flavor_of :ATTR(:name<flavor> :default<()>);
my %variety_of :ATTR(:name<variety> :default<()>);
my %base_of :ATTR(:name<base> :default<()>);
my %itemType_of :ATTR(:name<itemType> :default<()>);
my %enumeration_of :ATTR(:name<enumeration> :default<()>);
@@ -21,17 +22,17 @@ my %mixed_of :ATTR(:name<mixed> :default<()>); # default is fal
# is set to simpleContent/complexContent
my %content_model_of :ATTR(:name<contentModel> :default<NONE>);
sub get_variety; *get_variety = \&get_flavor;
sub get_flavor; *get_flavor = \&get_variety;
sub push_element {
my $self = shift;
my $element = shift;
if ($flavor_of{ ident $self } eq 'all')
if ($variety_of{ ident $self } eq 'all')
{
$element->set_minOccurs(0) if not defined ($element->get_minOccurs);
$element->set_maxOccurs(1) if not defined ($element->get_maxOccurs);
}
elsif ($flavor_of{ ident $self } eq 'sequence')
elsif ($variety_of{ ident $self } eq 'sequence')
{
$element->set_minOccurs(1) if not defined ($element->get_minOccurs);
$element->set_maxOccurs(1) if not defined ($element->get_maxOccurs);
@@ -42,14 +43,14 @@ sub push_element {
sub set_restriction {
my $self = shift;
my $element = shift;
$flavor_of{ ident $self } = 'restriction';
$variety_of{ ident $self } = 'restriction';
$base_of{ ident $self } = $element->{ Value };
}
sub set_extension {
my $self = shift;
my $element = shift;
$flavor_of{ ident $self } = 'extension';
$variety_of{ ident $self } = 'extension';
$base_of{ ident $self } = $element->{ Value };
}
@@ -64,7 +65,7 @@ sub serialize {
$opt->{ indent } ||= q{};
$opt->{ attributes } ||= [];
my $flavor = $self->get_flavor();
my $variety = $self->get_variety();
my $xml = ($opt->{ readable }) ? $opt->{ indent } : q{}; # add indentation
@@ -78,17 +79,17 @@ sub serialize {
delete $opt->{ attributes }; # don't propagate...
if ( $opt->{ autotype }) {
my $ns = $self->get_targetNamespace();
# reverse namespace by prefix hash
my %prefix_of = reverse %{ $opt->{ namespace } };
my $prefix = $prefix_of{ $ns }
|| die 'No prefix found for namespace '. $ns;
$xml .= join q{}, " type=\"$prefix:", $self->get_name(), '" '
if ($self->get_name() );
my $ns = $self->get_targetNamespace();
# reverse namespace by prefix hash
my %prefix_of = reverse %{ $opt->{ namespace } };
my $prefix = $prefix_of{ $ns }
|| die 'No prefix found for namespace '. $ns;
$xml .= join q{}, " type=\"$prefix:", $self->get_name(), '" '
if ($self->get_name() );
}
$xml .= '>';
$xml .= "\n" if ( $opt->{ readable } ); # add linebreak
if ( ($flavor eq "sequence") or ($flavor eq "all") ) {
if ( ($variety eq "sequence") or ($variety eq "all") ) {
$opt->{ indent } .= "\t";
for my $element (@{ $self->get_element() }) {
# might be list - listify
@@ -114,7 +115,7 @@ sub serialize {
$opt->{ indent } =~s/\t$//;
}
else {
die "sorry, we just handle all and sequence types yet...";
die "sorry, we just handle all and sequence types yet...";
}
$xml .= $opt->{ indent } if ( $opt->{ readable } ); # add indentation
$xml .= '</' . $name . '>';