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/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 $