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

import SOAP-WSDL 2.00_12 from CPAN

Browse Source 
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_12
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_12.tar.gz
This commit is contained in:
Martin Kutter
2009-12-12 19:47:49 -08:00
committed by Michael G. Schwern
parent c2da74b5ae
commit fd0854e34a
28 changed files with 312 additions and 1070 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lib/SOAP/WSDL.pm
+6 -10
View File
@@ -5,13 +5,11 @@ use vars qw($AUTOLOAD);
use Carp;
use Scalar::Util qw(blessed);
use SOAP::WSDL::Client;
use SOAP::WSDL::Envelope;
use SOAP::WSDL::SAX::WSDLHandler;
use SOAP::WSDL::Expat::WSDLParser;
use Class::Std;
use XML::LibXML;
use LWP::UserAgent;
our $VERSION='2.00_10';
our $VERSION='2.00_12';
my %no_dispatch_of :ATTR(:name<no_dispatch>);
my %wsdl_of :ATTR(:name<wsdl>);
@@ -98,13 +96,11 @@ sub wsdlinit {
croak $response->message() if ($response->code != 200);
# TODO: Port parser to expat and remove XML::LibXML dependency
my $parser = XML::LibXML->new();
my $filter = SOAP::WSDL::SAX::WSDLHandler->new();
$parser->set_handler( $filter );
my $parser = SOAP::WSDL::Expat::WSDLParser->new();
$parser->parse_string( $response->content() );
# sanity checks
my $wsdl_definitions = $filter->get_data() or die "unable to parse WSDL";
my $wsdl_definitions = $parser->get_data() or die "unable to parse WSDL";
my $types = $wsdl_definitions->first_types()
or die "unable to extract schema from WSDL";
my $ns = $wsdl_definitions->get_xmlns()
@@ -662,9 +658,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 176 $
$Rev: 188 $
$LastChangedBy: kutterma $
$Id: WSDL.pm 176 2007-08-31 15:28:29Z kutterma $
$Id: WSDL.pm 188 2007-09-03 15:15:19Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL.pm $
=cut
lib/SOAP/WSDL/Client.pm
+4 -2
View File
@@ -13,6 +13,8 @@ use SOAP::WSDL::Factory::Transport;
use SOAP::WSDL::Expat::MessageParser;
use SOAP::WSDL::SOAP::Typelib::Fault11;
our $VERSION='2.00_12';
# Package global for speed and memory savings.
# But should be factored out into serializer/deserializer...
my $PARSER;
@@ -381,9 +383,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 176 $
$Rev: 188 $
$LastChangedBy: kutterma $
$Id: Client.pm 176 2007-08-31 15:28:29Z kutterma $
$Id: Client.pm 188 2007-09-03 15:15:19Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
=cut
lib/SOAP/WSDL/Expat/MessageParser.pm
+28 -18
View File
@@ -8,7 +8,7 @@ use XML::Parser::Expat;
sub new {
my ($class, $args) = @_;
my $self = {
class_resolver => $args->{ class_resolver }
class_resolver => $args->{ class_resolver },
};
bless $self, $class;
return $self;
@@ -20,9 +20,9 @@ sub class_resolver {
}
sub _initialize {
my ($self, $parser) = @_;
my ($self, $parser) = @_;
delete $self->{ data };
delete $self->{ data }; # remove potential old results
my $characters;
my $current = undef;
@@ -34,17 +34,25 @@ sub _initialize {
# use "globals" for speed
my ($_prefix, $_localname, $_element, $_method,
$_class, $_parser, %_attrs) = ();
no strict qw(refs);
$parser->setHandlers(
Start => sub {
($_parser, $_element, %_attrs) = @_;
($_prefix, $_localname) = split m{:}xms , $_element;
$_localname ||= $_element; # for non-prefixed elements
$_localname ||= $_element; # for non-prefixed elements
# ignore top level elements
if (@{ $ignore } && $_localname eq $ignore->[0]) {
if (@{ $ignore } && $_localname eq $ignore->[0]) {
CHECK_ENVELOPE: {
last CHECK_ENVELOPE if $_localname ne 'Envelope';
last CHECK_ENVELOPE if exists $_attrs{ 'xmlns' }
&& $_attrs{ 'xmlns' } eq 'http://schemas.xmlsoap.org/soap/envelope/';
last CHECK_ENVELOPE if $_attrs{ "xmlns:$_prefix"}
eq 'http://schemas.xmlsoap.org/soap/envelope/';
die "Bad namespace for SOAP envelope: " . $parser->recognized_string();
}
shift @{ $ignore };
return;
}
@@ -52,10 +60,10 @@ sub _initialize {
push @{ $path }, $_localname; # step down in path
return if $skip; # skip inside __SKIP__
# resolve class of this element
# resolve class of this element
$_class = $self->{ class_resolver }->get_class( $path )
or die "Cannot resolve class for "
. join('/', @{ $path }) . " via $self->{ class_resolver }";
. join('/', @{ $path }) . " via " . $self->{ class_resolver };
# maybe write as "return $skip = join ... if (...)" ?
# would save a BLOCK...
@@ -71,15 +79,17 @@ sub _initialize {
# if $class matches...
if (index $_class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
# check wheter there is a CODE reference for $class::new.
# check wheter there is a non-empty ARRAY reference for $_class::ISA
# or a "new" method
# If not, require it - all classes required here MUST
# define new()
# This is the same as $class->can('new'), but it's way faster
*{ "$_class\::new" }{ CODE }
# This is not exactly the same as $class->can('new'), but it's way faster
defined *{ "$_class\::new" }{ CODE }
or scalar @{ *{ "$_class\::ISA" }{ ARRAY } }
or eval "require $_class" ## no critic qw(ProhibitStringyEval)
or die $@;
or die $@;
}
$current = $_class->new({ %_attrs }); # set new current object
# remember top level element
@@ -124,8 +134,8 @@ sub _initialize {
# set appropriate attribute in last element
# multiple values must be implemented in base class
$_method = "add_$_localname";
$$list[-1]->$_method( $current );
$$list[-1]->$_method( $current );
$current = pop @$list; # step up in object hierarchy...
}
);
@@ -208,8 +218,8 @@ This module may be used under the same terms as perl itself.
$ID: $
$LastChangedDate: 2007-08-31 17:28:29 +0200 (Fr, 31 Aug 2007) $
$LastChangedRevision: 176 $
$LastChangedDate: 2007-09-02 21:05:18 +0200 (So, 02 Sep 2007) $
$LastChangedRevision: 184 $
$LastChangedBy: kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $
lib/SOAP/WSDL/Manual.pod
-3
View File
@@ -35,9 +35,6 @@ the service's interface structure.
The results of all calls to your service object's methods (except new)
are objects based on SOAP::WSDL's XML schema implementation.
These objects are false in boolean context, and serialize to XML when
printed.
To access the object's properties use get_NAME / set_NAME getter/setter
methods whith NAME corresponding to the XML tag name.
lib/SOAP/WSDL/Manual/WS_I_BasicProfile_Compliance.pod → lib/SOAP/WSDL/Manual/WS_I.pod
+12 -11
View File
@@ -2,7 +2,7 @@
=head1 NAME
SOAP::WSDL WS-I Basic Profile Compliance - How SOAP::WSDL complies to WS-I Basic Profile 1.0
SOAP::WSDL::Manual::WS_I - How SOAP::WSDL complies to WS-I Basic Profile 1.0
=head1 DESCRIPTION
@@ -292,7 +292,18 @@ the SOAPAction header from the operation name and the top node's namespace.
SOAP::WSDL::Client always assures the SOAPaction header is quoted, thus
automatically inserts the empty string if no SOAPAction header is defined.
=head2 R1015
A RECEIVER MUST generate a fault if they encounter a message whose document
element has a local name of "Envelope" but a namespace name that is not
"http://schemas.xmlsoap.org/soap/envelope/".
SOAP::WSDL::Expat::MessageParser checks the namespace of the SOAP envelope.
SOAP::WSDL::Expat::MessageParser does not check that Envelope is the root
element, yet.
=head1 RULES NOT CONFIRMED
@@ -347,16 +358,6 @@ However, rpc-literal bindings are not supported, yet.
TODO support rpc-literal bindings.
=head2 R1015
A RECEIVER MUST generate a fault if they encounter a message whose document
element has a local name of "Envelope" but a namespace name that is not
"http://schemas.xmlsoap.org/soap/envelope/".
SOAP::WSDL::Expat::MessageParser does not check the namespace of the SOAP envelope.
TODO implement checking namespace of the SOAP envelope and emit fault if not "http://schemas.xmlsoap.org/soap/envelope/".
=head2 R2008
In a DESCRIPTION the value of the location attribute of a wsdl:import element
lib/SOAP/WSDL/RELEASE_NOTES
-71
View File
@@ -1,71 +0,0 @@
Release notes for SOAP::WSDL 2.00_11
-------
I'm happy to present a new pre-release version of SOAP::WSDL.
The following features were added (the numbers in brackets are the tracker IDs
from https://sourceforge.net/tracker/?group_id=111978&atid=660924):
* [1767963] Transport plugins via SOAP::WSDL::Factory::Transport.
SOAP::WSDL uses SOAP::Lite's tranport modules as default, with a
lightweight HTTP(S) transport plugin as fallback.
Custom transport modules can be registered via
SOAP::WSDL::Factory::Transport.
* [ 1772730 ] Serializer plugins via SOAP::WSDL::Factory::Serializer
The default serializer for SOAP1.1 is SOAP::WSDL::Serializer::SOAP11.
Custom serializers classes can be registered via
SOAP::WSDL::Factory::Serializer or set via SOAP::Lite's set_serializer
method.
The following bugs have been fixed (the numbers in brackets are the tracker IDs
from https://sourceforge.net/tracker/?group_id=111978&atid=660921):
* [ 1764854 ] Port WSDL parser to expat and remove XML::LibXML dependency
SOAP::WSDL now requires only XML::Parser to be installed.
XML::LibXML is not required any more, though XML::LibXML based modules still
exist.
The following uncategorized improvements have been made
* The number of dependencies has been reduced. SOAP::WSDL no longer requires the
following modules to be installed:
- XML::SAX::Base
- XML::SAX::ParserFactory
- Pod::Simple::Text
* The missing prerequisite Template has been added.
* Documentation has been improved.
The following changes were made in former pre-relase versions:
2.00_10
----
* Changed Makefile.PL to use Module::Build (passthrough mode)
* fixed element ref="" handling
2.00_09
----
* SOAP::WSDL::XSD::Typelib::Builtin::boolean objects now return their numerical
value in bool context, not "true" or "false" (always true...)
* date/time test are now timezone-sensitive
* examples added
2.00_08
---
* SOAP message parser may skip unwanted parts of the message - see
SOAP::WSDL::Expat::MessageParser for details.
* HTTP Content-Type is configurable now
* SOAP::WSDL::XSD::Typelib::ComplexType based objects now accept a
list ref of hash refs as parameter to set_value.
* SOAP::WSDL::XSD::Typelib::Builtin::dateTime and ::date now converts date
strings into XML date strings
* SOAP::WSDL::Definitions::create now
- converts '.' in service names to '::' (.NET class separator to perl class
separator)
- outputs Typemaps and Interface classes in UTF8 to allow proper inclusion
of UTF8 documentation from WSDL
* WSDLHandler now handles <wsdl:documentation> tags
* SOAP::WSDL::Definitions now includes some usable doc in generated interface classes
* fixed explain in SimpleType, ComplexType and Element (someway)
lib/SOAP/WSDL/XSD/ComplexType.pm
+1 -1
View File
@@ -181,7 +181,7 @@ sub to_class {
my $template = <<'EOT';
package [% type_prefix %][% self.get_name %];
use strict;
use Class::Std::Storable;
use SOAP::WSDL::XSD::Typelib::ComplexType;
use base qw(
SOAP::WSDL::XSD::Typelib::ComplexType
lib/SOAP/WSDL/XSD/Element.pm
+1 -1
View File
@@ -244,7 +244,7 @@ sub to_class {
my $template = <<'EOT';
package [% element_prefix %][% self.get_name %];
use strict;
use Class::Std::Storable;
use SOAP::WSDL::XSD::Typelib::Element;
[% IF (type = self.first_simpleType) %]
lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm
+9 -18
View File
@@ -37,29 +37,20 @@ BEGIN {
sub set_value {
# use set_value from base class if we have a XML-DateTime format
#2037-12-31T00:00:00.0000000+01:00
if (
return $_[0]->SUPER::set_value($_[1]) if (
$_[1] =~ m{ ^\d{4} \- \d{2} \- \d{2}
T \d{2} \: \d{2} \: \d{2} (:? \. \d{1,7} )?
[\+\-] \d{2} \: \d{2} $
}xms
) {
$_[0]->SUPER::set_value($_[1])
}
# use a combination of strptime and strftime for converting the date
# strptime does not emit timezone info, so we're pretty fucked up here.
#
# Unfortunately, strftime outputs the time zone as [+-]0000, whereas XML
# whants it as [+-]00:00
# We leave out the optional nanoseconds part, as it would always be empty.
else {
# strptime sets empty values to undef - and strftime doesn't like that...
my @time_from = map { ! defined $_ ? 0 : $_ } strptime($_[1]);
undef $time_from[-1];
);
# strptime sets empty values to undef - and strftime doesn't like that...
my @time_from = map { ! defined $_ ? 0 : $_ } strptime($_[1]);
undef $time_from[-1];
my $time_str = strftime( '%Y-%m-%dT%H:%M:%S%z', @time_from );
substr $time_str, -2, 0, ':';
$_[0]->SUPER::set_value($time_str);
}
my $time_str = strftime( '%Y-%m-%dT%H:%M:%S%z', @time_from );
substr $time_str, -2, 0, ':';
$_[0]->SUPER::set_value($time_str);
}
1;
lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
+30 -16
View File
@@ -4,9 +4,9 @@ use strict;
use warnings;
use Carp;
use SOAP::WSDL::XSD::Typelib::Builtin;
use Scalar::Util qw(blessed);
use Class::Std::Storable;
use Scalar::Util qw(blessed refaddr);
use Data::Dumper;
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
@@ -64,7 +64,7 @@ sub _factory {
my $is_list = $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list');
*{ "$class\::set_$name" } = sub {
my ($self, $value) = @_;
# my ($self, $value) = @_;
# The structure below looks rather weird, but is optimized for performance.
#
@@ -93,11 +93,11 @@ sub _factory {
# 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)
my $is_ref = ref $_[1];
$attribute_ref->{ ident $_[0] } = ($is_ref)
? $is_ref eq 'ARRAY'
? $is_list # remembered from outside closure
? $type->new({ value => $value }) # list element - can take list ref as value
? $type->new({ value => $_[1] }) # list element - can take list ref as value
: [ map {
ref $_
? ref $_ eq 'HASH'
@@ -106,20 +106,20 @@ sub _factory {
? $_
: croak "cannot use " . ref($_) . " reference as value for $name - $type required"
: $type->new({ value => $_ })
} @{ $value }
} @{ $_[1] }
]
: $is_ref eq 'HASH'
? $type->new( $value )
? $type->new( $_[1] )
: $is_ref eq $type
? $value
? $_[1]
: die croak "cannot use $is_ref reference as value for $name - $type required"
: $type->new({ value => $value });
: $type->new({ value => $_[1] });
};
*{ "$class\::add_$name" } = sub {
my $ident = ident $_[0];
warn "attempting to add empty value to " . ref $_[0]
if (not defined $_[1]);
if not defined $_[1];
# first call
return $attribute_ref->{ $ident } = $_[1]
@@ -133,16 +133,30 @@ sub _factory {
return push @{ $attribute_ref->{ $ident } }, $_[1];
};
*{ "$class\::$name" } = *{ "$class\::add_$name" };
}
*{ "$class\::new" } = sub {
my $self = bless \my ($o), $_[0];
$self->BUILD( ident $self, $_[1] ) if exists &BUILD;
$self->_init( ident $self, $_[1] );
$self->START( ident $self, $_[1] ) if exists &START;
return $self;
};
*{ "$class\::START" } = sub {
my ($self, $ident, $args_of) = @_;
*{ "$class\::_init" } = sub {
# We're working on @_ for speed.
# Normally, the first line would look like this:
# my ($self, $ident, $args_of) = @_;
#
# The hanging side comment show you what would be there, then.
# iterate over keys of arguments
# and call set appropriate field in clase
map { ($ATTRIBUTES_OF{ $class }->{ $_ })
? do {
my $method = "set_$_";
$self->$method( $args_of->{ $_ } );
$_[0]->$method( $_[2]->{ $_ } ); # ( $args_of->{ $_ } );
}
: $_ =~ m{ \A # beginning of string
xmlns # xmlns
@@ -152,8 +166,8 @@ sub _factory {
croak "unknown field $_ in $class. Valid fields are:\n"
. join(', ', @{ $ELEMENTS_FROM{ $class } }) . "\n"
. "Structure given:\n" . Dumper @_ };
} keys %$args_of;
return $self;
} keys %{ $_[2] }; # %$args_of;
return $_[0]; # $self;
};
lib/SOAP/WSDL/XSD/Typelib/Element.pm
-2
View File
@@ -1,8 +1,6 @@
#!/usr/bin/perl
package SOAP::WSDL::XSD::Typelib::Element;
use strict;
use Class::Std::Storable;
use Data::Dumper;
my %NAME;
my %NILLABLE;