Compare commits

..

1 Commits

Author SHA1 Message Date
Martin Kutter
7ba1959888 import SOAP-WSDL 2.00_10 from CPAN
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_10
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_10.tar.gz
2009-12-12 19:47:48 -08:00
10 changed files with 238 additions and 118 deletions

View File

@@ -1,9 +1,9 @@
use Module::Build;
Module::Build->new(
# create_makefile_pl => 'traditional',
create_makefile_pl => 'passthrough',
dist_abstract => 'SOAP with WSDL support',
dist_name => 'SOAP-WSDL',
dist_version => '2.00_09',
dist_version => '2.00_10',
module_name => 'SOAP::WSDL',
license => 'artistic',
requires => {

49
CHANGES
View File

@@ -1,4 +1,53 @@
------------------------------------------------------------------------
r142 | kutterma | 2007-08-13 15:55:45 +0200 (Mo, 13 Aug 2007) | 1 line
typo
------------------------------------------------------------------------
r141 | kutterma | 2007-08-12 21:45:51 +0200 (So, 12 Aug 2007) | 2 lines
- corrected POD error
- little speedup in add_FOO methods
------------------------------------------------------------------------
r140 | kutterma | 2007-08-12 21:27:58 +0200 (So, 12 Aug 2007) | 1 line
- corrected POD error
------------------------------------------------------------------------
r139 | kutterma | 2007-08-12 21:15:59 +0200 (So, 12 Aug 2007) | 1 line
- adder repository information
------------------------------------------------------------------------
r138 | kutterma | 2007-08-12 21:13:08 +0200 (So, 12 Aug 2007) | 1 line
- typo
------------------------------------------------------------------------
r137 | kutterma | 2007-08-12 21:12:20 +0200 (So, 12 Aug 2007) | 3 lines
- updated docs
- added svn information
- cosmetics
------------------------------------------------------------------------
r136 | kutterma | 2007-08-12 15:11:50 +0200 (So, 12 Aug 2007) | 2 lines
- fixed element ref="" top level- elements in code generator
- prepared 2.00_09 pre-release
------------------------------------------------------------------------
r135 | kutterma | 2007-08-12 14:44:06 +0200 (So, 12 Aug 2007) | 1 line
- prepared 2.00_09 pre-release
------------------------------------------------------------------------
r134 | kutterma | 2007-08-12 14:30:33 +0200 (So, 12 Aug 2007) | 2 lines
- updated README
- bumped up version
------------------------------------------------------------------------
r133 | kutterma | 2007-08-12 14:27:17 +0200 (So, 12 Aug 2007) | 1 line
- fixed Build.PL to leave Makefile.PL untouched.
------------------------------------------------------------------------
r132 | kutterma | 2007-08-12 14:21:24 +0200 (So, 12 Aug 2007) | 1 line
- now really added Makefile.PL
------------------------------------------------------------------------
r131 | kutterma | 2007-08-12 14:18:59 +0200 (So, 12 Aug 2007) | 3 lines
- fixed documentation for generated code with element ref="" declarations

View File

@@ -1,6 +1,6 @@
---
name: SOAP-WSDL
version: 2.00_09
version: 2.00_10
author:
abstract: SOAP with WSDL support
license: artistic
@@ -24,7 +24,7 @@ meta-spec:
provides:
SOAP::WSDL:
file: lib/SOAP/WSDL.pm
version: 2.00_09
version: 2.00_10
SOAP::WSDL::Base:
file: lib/SOAP/WSDL/Base.pm
SOAP::WSDL::Binding:

View File

@@ -1,27 +1,31 @@
# Note: this file was auto-generated by Module::Build::Compat version 0.03
use ExtUtils::MakeMaker;
WriteMakefile
(
'PL_FILES' => {},
'INSTALLDIRS' => 'site',
'NAME' => 'SOAP::WSDL',
'EXE_FILES' => [
bin/wsdl2perl.pl'
],
'VERSION_FROM' => 'lib/SOAP/WSDL.pm',
'PREREQ_PM' => {
'XML::SAX::ParserFactory' => 0,
'XML::Parser::Expat' => 0,
'Class::Std' => 'v0.0.8',
'Date::Format' => 0,
'Date::Parse' => 0,
'List::Util' => 0,
'LWP::UserAgent' => 0,
'XML::SAX::Base' => 0,
'XML::LibXML' => 0,
'File::Path' => 0,
'Class::Std::Storable' => 0,
'File::Basename' => 0
}
)
;
unless (eval "use Module::Build::Compat 0.02; 1" ) {
print "This module requires Module::Build to install itself.\n";
require ExtUtils::MakeMaker;
my $yn = ExtUtils::MakeMaker::prompt
(' Install Module::Build now from CPAN?', 'y');
unless ($yn =~ /^y/i) {
die " *** Cannot install without Module::Build. Exiting ...\n";
}
require Cwd;
require File::Spec;
require CPAN;
# Save this 'cause CPAN will chdir all over the place.
my $cwd = Cwd::cwd();
CPAN::Shell->install('Module::Build::Compat');
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
or die "Couldn't install Module::Build, giving up.\n";
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
}
eval "use Module::Build::Compat 0.02; 1" or die $@;
Module::Build::Compat->run_build_pl(args => \@ARGV);
require Module::Build;
Module::Build::Compat->write_makefile(build_class => 'Module::Build');

View File

@@ -9,10 +9,9 @@ use SOAP::WSDL::Envelope;
use SOAP::WSDL::SAX::WSDLHandler;
use Class::Std;
use XML::LibXML;
use Data::Dumper;
use LWP::UserAgent;
our $VERSION='2.00_09';
our $VERSION='2.00_10';
my %no_dispatch_of :ATTR(:name<no_dispatch>);
my %wsdl_of :ATTR(:name<wsdl>);
@@ -64,8 +63,10 @@ for my $method (keys %LOOKUP ) {
};
}
{
# we need to roll our own for supporting
# SOAP::WSDL->new( key => value ) syntax,
# like SOAP::Lite does
no warnings qw(redefine);
sub new {
my $class = shift;
@@ -85,7 +86,6 @@ for my $method (keys %LOOKUP ) {
return $self;
}
}
sub wsdlinit {
@@ -145,7 +145,7 @@ sub _wsdl_get_port :PRIVATE {
return $port_of{ $ident } = $portname_of{ $ident }
? $service_of{ $ident }->get_port( $ns, $portname_of{ $ident } )
: $port_of{ $ident } = $service_of{ $ident }->get_port()->[ 0 ];
} ## end sub _wsdl_get_port
}
sub _wsdl_get_binding :PRIVATE {
my $self = shift;
@@ -155,7 +155,7 @@ sub _wsdl_get_binding :PRIVATE {
$binding_of{ $ident } = $wsdl->find_binding( $wsdl->_expand( $port->get_binding() ) )
or die "no binding found for ", $port->get_binding();
return $binding_of{ $ident };
} ## end sub _wsdl_get_binding
}
sub _wsdl_get_portType :PRIVATE {
my $self = shift;
@@ -165,8 +165,7 @@ sub _wsdl_get_portType :PRIVATE {
$porttype_of{ $ident } = $wsdl->find_portType( $wsdl->_expand( $binding->get_type() ) )
or die "cannot find portType for " . $binding->get_type();
return $porttype_of{ $ident };
} ## end sub _wsdl_get_portType
}
sub _wsdl_init_methods :PRIVATE {
my $self = shift;
@@ -174,9 +173,7 @@ sub _wsdl_init_methods :PRIVATE {
my $wsdl = $definitions_of{ $ident };
my $ns = $wsdl->get_targetNamespace();
# get bindings, portType, message, part(s)
# - use cached values where possible for speed,
# private methods if not for clear separation...
# get bindings, portType, message, part(s) - use private methods for clear separation...
$self->_wsdl_get_service if not ($service_of{ $ident });
my $binding = $binding_of{ $ident } || $self->_wsdl_get_binding()
|| die "Can't find binding";
@@ -241,7 +238,6 @@ sub call {
my $response = (blessed $data)
? $client->call( $method, $data )
: do {
my $content = '';
# TODO support RPC-encoding: Top-Level element + namespace...
foreach my $part ( @{ $method_info_of{ $ident }->{ $method }->{ parts } } ) {
@@ -471,7 +467,19 @@ You may pass the servicename and portname as attributes to wsdlinit, though.
=head1 Differences to SOAP::Lite
=head3 Output formats
=head2 Message style/encoding
While SOAP::Lite supports rpc/encoded style/encoding only, SOAP::WSDL currently
supports document/literal style/encoding.
=head2 autotype / type information
SOAP::Lite defaults to transmitting XML type information by default, where
SOAP::WSDL defaults to leaving it out.
autotype(1) might even be broken in SOAP::WSDL - it's not well-tested, yet.
=head2 Output formats
In contrast to SOAP::Lite, SOAP::WSDL supports the following output formats:
@@ -498,7 +506,7 @@ See below.
=back
=head3 outputxml
=head2 outputxml
SOAP::Lite returns only the content of the SOAP body when outputxml is set
to true. SOAP::WSDL returns the complete XML response.
@@ -588,6 +596,40 @@ The following facets have no influence yet:
=back
=head1 SEE ALSO
There are lots of SOAP Clients on CPAN, lately.
You may wish to look at the following:
=over
=item * L<SOAP::Lite|SOAP::Lite>
Full featured SOAP-library, little WSDL support. Supports rpc-encoded style only. Many protocols supported.
=item * L<SOAP::Message|SOAP::Message>
A very basic SOAP library without transport facilities.
Handy if you got your XML message ready and just need an envelope around it.
=item * L<SOAP::MySOAP|SOAP::MySOAP>
An extremely basic SOAP client module - just HTTP support, no encoding / decoding,
HTTP headers have to be set as arguments to 'new'
=item * <XML::Compile::WSDL|XML::Compile::WSDL>
A promising-looking approach derived from a cool functional DOM-based XML schema parser.
Will support encoding/decoding of SOAP messages based on WSDL definitions.
Not yet finished at the time of writing - but you may wish to give it a try, especially
if you need to adhere very closely to the XML Schema / WSDL specs.
=back
=head1 ACKNOWLEDGMENTS
There are many people out there who fostered SOAP::WSDL's developement.
@@ -595,7 +637,7 @@ I would like to thank them all (and apologize to all those I have forgotten).
Giovanni S. Fois wrote a improved version of SOAP::WSDL (which eventually became v1.23)
Damian A. Martinez Gelabert, Dennis S. Hennen, Dan Horne, Peter Orvos, Marc Overmeer,
Damian A. Martinez Gelabert, Dennis S. Hennen, Dan Horne, Peter Orvos, Mark Overmeer,
Jon Robens, Isidro Vila Verde and Glenn Wood spotted bugs and/or
suggested improvements in the 1.2x releases.
@@ -617,5 +659,12 @@ the same terms as perl itself
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 143 $
$LastChangedBy: kutterma $
$Id: WSDL.pm 143 2007-08-13 18:43:20Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL.pm $
=cut

View File

@@ -284,7 +284,12 @@ the same terms as perl itself
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 139 $
$LastChangedBy: kutterma $
$Id: Client.pm 139 2007-08-12 19:15:59Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
=cut

View File

@@ -183,24 +183,28 @@ __PACKAGE__->__create_methods(
__END__
=pod
[% MACRO pod BLOCK %]=pod[% END %]
[% MACRO cut BLOCK %]=pod[% END %]
[% MACRO head1 BLOCK %]=head1[% END %]
[% MACRO head2 BLOCK %]=head2[% END %]
[% pod %]
=head1 NAME
[% head1 %] NAME
[% interface_prefix %][% service.get_name %] - SOAP interface to [% service.get_name %] at
[% service.first_port.get_location %]
=head1 SYNOPSIS
[% head1 %] SYNOPSIS
my $interface = [% interface_prefix %][% service.get_name %]->new();
my $[% operations.keys.1 %] = $interface->[% operations.keys.1 %]();
=head1 METHODS
[% head1 %] METHODS
[% FOREACH name=operations.keys;
operation=operations.$name;
%]
=head2 [% name %]
[% head2 %] [% name %]
[% operation.documentation %]
@@ -211,7 +215,7 @@ SYNOPSIS:
[% END %]
=cut
[% cut %]
EOT

View File

@@ -242,18 +242,25 @@ sub get_xmlns { '[% self.get_targetNamespace %]' }
1;
__END__
[% MACRO pod BLOCK %]=pod[% END %]
[% MACRO cut BLOCK %]=cut[% END %]
[% MACRO head1 BLOCK %]=head1[% END %]
[% MACRO head2 BLOCK %]=head2[% END %]
[% pod %]
[% head1 %] NAME
[% type_prefix %][% self.get_name %]
=pod
[% head1 %] SYNOPSIS
=head1 NAME [% type_prefix %][% self.get_name %]
=head1 SYNOPSIS
=head1 DESCRIPTION
[% head1 %] DESCRIPTION
Type class for the XML type [% self.get_name %].
=head1 PROPERTIES
[% head1 %] PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
@@ -302,7 +309,7 @@ Structure as perl hash:
[% structure %]
=cut
[% cut %]
EOT

View File

@@ -336,18 +336,25 @@ __PACKAGE__->__set_ref('[% self.get_ref %]');
__END__
[% MACRO pod BLOCK %]=pod[% END %]
[% MACRO cut BLOCK %]=cut[% END %]
[% MACRO head1 BLOCK %]=head1[% END %]
[% MACRO head2 BLOCK %]=head2[% END %]
[% pod %]
[% head1 %] NAME
=pod
[% element_prefix %][% self.get_name %]
=head1 NAME [% element_prefix %][% self.get_name %]
[% head1 %] SYNOPSIS
=head1 SYNOPSIS
=head1 DESCRIPTION
[% head1 %] DESCRIPTION
Type class for the XML element [% self.get_name %].
=head1 PROPERTIES
[% head1 %] PROPERTIES
The following properties may be accessed using get_PROPERTY / set_PROPERTY
methods:
@@ -358,7 +365,7 @@ methods:
[% END;
END %]
=head1 Object structure
[% head1 %] Object structure
[%- IF (type = self.first_complexType);
FOREACH element = type.get_element;
@@ -382,8 +389,8 @@ Structure as perl hash:
tree.
[% structure %]
=cut
[% cut %]
EOT

View File

@@ -1,11 +1,11 @@
#!/usr/bin/perl
package SOAP::WSDL::XSD::Typelib::ComplexType;
use strict;
use warnings;
use Carp;
use SOAP::WSDL::XSD::Typelib::Builtin;
use Scalar::Util qw(blessed);
use Class::Std::Storable;
use Data::Dumper;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
@@ -29,54 +29,50 @@ sub _factory {
my $type = $CLASSES_OF{ $class }->{ $name }
or die "No class given for $name";
# require all types here - this is a slow check -
# TODO speedup
# require all types here
$type->isa('UNIVERSAL')
or eval "require $type"
or croak $@;
# check now, so we don't need to do it later...
my $is_list = $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list');
*{ "$class\::set_$name" } = sub {
my ($self, $value) = @_;
=for developers
The structure below looks rather weird, but is optimized for performance.
We could use sub calls for sure, but these are much slower. And the logic
is not that easy:
we accept:
a) objects
b) scalars
c) list refs
d) hash refs
e) mixed stuff of all of the above, so we have to set our element to
a) value if it's an object
b) New object of expected class with value for simple values
c 1) New object with value for list values and list type
c 2) List ref of new objects with value for list values and non-list type
c + e 1) List ref of objects for list values (list of objects) and non-list type
c + e 2) List ref of new objects for list values (list of hashes) and non-list type
where the hash ref is passed to new as argument
d) New object with values passed to new for HASH references
We throw an error on
a) list refs of list refs - don't know what to do with this (maybe use for lists of list types ?)
b) wrong object types
c) non-blessed non-ARRAY/HASH references - if you can define semantics
for GLOB references, feel free to add them.
d) we should also die for non-blessed non-ARRAY/HASH references in lists but don't do yet - oh my !
=cut
# The structure below looks rather weird, but is optimized for performance.
#
# We could use sub calls for sure, but these are much slower. And the logic
# is not that easy:
#
# we accept:
# a) objects
# b) scalars
# c) list refs
# d) hash refs
# e) mixed stuff of all of the above, so we have to set our element to
# a) value if it's an object
# b) New object of expected class with value for simple values
# c 1) New object with value for list values and list type
# c 2) List ref of new objects with value for list values and non-list type
# c + e 1) List ref of objects for list values (list of objects) and non-list type
# c + e 2) List ref of new objects for list values (list of hashes) and non-list type
# where the hash ref is passed to new as argument
# d) New object with values passed to new for HASH references
#
# We throw an error on
# a) list refs of list refs - don't know what to do with this (maybe use for lists of list types ?)
# b) wrong object types
# c) non-blessed non-ARRAY/HASH references - if you can define semantics
# for GLOB references, feel free to add them.
# d) we should also die for non-blessed non-ARRAY/HASH references in lists but don't do yet - oh my !
my $is_ref = ref $value;
$attribute_ref->{ ident $self } = ($is_ref)
? $is_ref eq 'ARRAY'
? $is_list
? $type->new({ value => $value })
: [ map {
? $is_list # remembered from outside closure
? $type->new({ value => $value }) # list element - can take list ref as value
: [ map {
ref $_
? ref $_ eq 'HASH'
? $type->new($_)
@@ -95,21 +91,20 @@ is not that easy:
};
*{ "$class\::add_$name" } = sub {
my ($self, $value) = @_;
my $ident = ident $self;
if (not defined $value) {
warn "attempting to add empty value to " . ref $self;
}
return $attribute_ref->{ $ident } = $value
my $ident = ident $_[0];
warn "attempting to add empty value to " . ref $_[0]
if (not defined $_[1]);
# first call
return $attribute_ref->{ $ident } = $_[1]
if not defined $attribute_ref->{ $ident };
# listify previous value if it's no list
# second call: listify previous value if it's no list
$attribute_ref->{ $ident } = [ $attribute_ref->{ $ident } ]
if not ref $attribute_ref->{ $ident } eq 'ARRAY';
# add to list
return push @{ $attribute_ref->{ $ident } }, $value;
# second and following: add to list
return push @{ $attribute_ref->{ $ident } }, $_[1];
};
}
@@ -139,7 +134,7 @@ is not that easy:
# this serialize method works fine for <all> and <sequence>
# complextypes, as well as for <restriction><all> or
# <restriction><sequence>.
# But what about choice, group, extension ?
# But what about choice, extension ?
*{ "$class\::_serialize" } = sub {
my $ident = ident $_[0];
# my $class = ref $_[0];