import SOAP-WSDL 2.00_09 from CPAN
git-cpan-module: SOAP-WSDL git-cpan-version: 2.00_09 git-cpan-authorid: MKUTTER git-cpan-file: authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_09.tar.gz
This commit is contained in:
Martin Kutter
committed by
Michael G. Schwern
Michael G. Schwern
parent
312f3d6bbd
commit
a554e87f49
@@ -5,27 +5,8 @@ use warnings;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use XML::Parser::Expat;
|
||||
|
||||
=pod
|
||||
|
||||
=head2 new
|
||||
|
||||
=over
|
||||
|
||||
=item SYNOPSIS
|
||||
|
||||
my $obj = ->new();
|
||||
|
||||
=item DESCRIPTION
|
||||
|
||||
Constructor.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $args = shift;
|
||||
my ($class, $args) = @_;
|
||||
my $self = {
|
||||
class_resolver => $args->{ class_resolver }
|
||||
};
|
||||
@@ -39,9 +20,9 @@ sub class_resolver {
|
||||
}
|
||||
|
||||
sub _initialize {
|
||||
my $self = shift;
|
||||
my ($self, $parser) = @_;
|
||||
|
||||
$self->{ data } = undef;
|
||||
delete $self->{ data };
|
||||
|
||||
my $characters;
|
||||
my $current = undef;
|
||||
@@ -50,7 +31,6 @@ sub _initialize {
|
||||
my $path = []; # current path (without
|
||||
# number)
|
||||
my $skip = 0; # skip elements
|
||||
my $parser = XML::Parser::Expat->new();
|
||||
|
||||
# use "globals" for speed
|
||||
my ($_prefix, $_localname, $_element, $_method,
|
||||
@@ -78,17 +58,16 @@ sub _initialize {
|
||||
or die "Cannot resolve class for "
|
||||
. join('/', @{ $path }) . " via $self->{ class_resolver }";
|
||||
|
||||
if ($_class eq '__SKIP__') {
|
||||
$skip = join '/', @{ $path };
|
||||
return;
|
||||
}
|
||||
# maybe write as "return $skip = join ... if (...)" ?
|
||||
# would save a BLOCK...
|
||||
return $skip = join('/', @{ $path }) if ($_class eq '__SKIP__');
|
||||
|
||||
push @$list, $current; # step down in tree ()remember current)
|
||||
|
||||
$characters = q{}; # empty characters
|
||||
|
||||
# Check whether we have a primitive - we implement them as classes
|
||||
# TODO replace with UNIVERSAL->isa()
|
||||
# We could replace this with UNIVERSAL->isa() - but it's slow...
|
||||
# match is a bit faster if the string does not match, but WAY slower
|
||||
# if $class matches...
|
||||
|
||||
@@ -155,18 +134,17 @@ sub _initialize {
|
||||
}
|
||||
|
||||
sub parse {
|
||||
$_[0]->_initialize->parse( $_[1] );
|
||||
$_[0]->_initialize( XML::Parser::Expat->new() )->parse( $_[1] );
|
||||
return $_[0]->{ data };
|
||||
}
|
||||
|
||||
sub parsefile {
|
||||
$_[0]->_initialize->parsefile( $_[1] );
|
||||
$_[0]->_initialize( XML::Parser::Expat->new() )->parsefile( $_[1] );
|
||||
return $_[0]->{ data };
|
||||
}
|
||||
|
||||
sub get_data {
|
||||
my $self = shift;
|
||||
return $self->{ data };
|
||||
return $_[0]->{ data };
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
@@ -2,148 +2,25 @@
|
||||
package SOAP::WSDL::Expat::MessageStreamParser;
|
||||
use strict;
|
||||
use warnings;
|
||||
use SOAP::WSDL::XSD::Typelib::Builtin;
|
||||
use XML::Parser::Expat;
|
||||
use SOAP::WSDL::Expat::MessageParser;
|
||||
use base qw(SOAP::WSDL::Expat::MessageParser);
|
||||
|
||||
=pod
|
||||
|
||||
=head2 new
|
||||
|
||||
=over
|
||||
|
||||
=item SYNOPSIS
|
||||
|
||||
my $obj = ->new();
|
||||
|
||||
=item DESCRIPTION
|
||||
|
||||
Constructor.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
class_resolver => shift->{ class_resolver }
|
||||
};
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub class_resolver {
|
||||
sub parse_start {
|
||||
my $self = shift;
|
||||
$self->{ class_resolver } = shift;
|
||||
$self->{ parser } = $_[0]->_initialize( XML::Parser::ExpatNB->new() );
|
||||
}
|
||||
|
||||
sub init {
|
||||
my $self = shift;
|
||||
my $xml = shift;
|
||||
$self->{ data } = undef;
|
||||
|
||||
my $characters;
|
||||
my $current = '__STOP__';
|
||||
my $ignore = [ 'Envelope', 'Body' ];
|
||||
my $list = [];
|
||||
my $namespace = {};
|
||||
my $path = [];
|
||||
my $parser = XML::Parser::ExpatNB->new();
|
||||
sub init;
|
||||
*init = \&parse_start;
|
||||
|
||||
no strict qw(refs);
|
||||
$parser->setHandlers(
|
||||
Start => sub {
|
||||
my ($parser, $element, %attrs) = @_;
|
||||
my ($prefix, $localname) = split m{:}xms , $element;
|
||||
# for non-prefixed elements
|
||||
if (not $localname) {
|
||||
$localname = $element;
|
||||
$prefix = q{};
|
||||
}
|
||||
# ignore top level elements
|
||||
if (@{ $ignore } && $localname eq $ignore->[0]) {
|
||||
shift @{ $ignore };
|
||||
return;
|
||||
}
|
||||
# empty characters
|
||||
$characters = q{};
|
||||
|
||||
push @{ $path }, $localname; # step down...
|
||||
push @{ $list }, $current; # remember current
|
||||
|
||||
# resolve class of this element
|
||||
my $class = $self->{ class_resolver }->get_class( $path )
|
||||
or die "Cannot resolve class for "
|
||||
. join('/', @{ $path }) . " via $self->{ class_resolver }";
|
||||
|
||||
# Check whether we have a primitive - we implement them as classes
|
||||
# TODO replace with UNIVERSAL->isa()
|
||||
# match is a bit faster if the string does not match, but WAY slower
|
||||
# if $class matches...
|
||||
# if (not $class=~m{^SOAP::WSDL::XSD::Typelib::Builtin}xms) {
|
||||
|
||||
if (index $class, 'SOAP::WSDL::XSD::Typelib::Builtin', 0 < 0) {
|
||||
|
||||
# check wheter there is a CODE reference for $class::new.
|
||||
# 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 }
|
||||
or eval "require $class" ## no critic qw(ProhibitStringyEval)
|
||||
or die $@;
|
||||
}
|
||||
# create object
|
||||
# set current object
|
||||
$current = $class->new({ %attrs });
|
||||
|
||||
# remember top level element
|
||||
defined $self->{ data }
|
||||
or ($self->{ data } = $current);
|
||||
},
|
||||
Char => sub {
|
||||
$characters .= $_[1];
|
||||
},
|
||||
End => sub {
|
||||
my $element = $_[1];
|
||||
|
||||
my ($prefix, $localname) = split m{:}xms , $element;
|
||||
# for non-prefixed elements
|
||||
if (not $localname) {
|
||||
$localname = $element;
|
||||
$prefix = q{};
|
||||
}
|
||||
|
||||
# This one easily handles ignores for us, too...
|
||||
return if not ref $list->[-1];
|
||||
|
||||
if ( $current
|
||||
->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType') ) {
|
||||
$current->set_value( $characters );
|
||||
}
|
||||
|
||||
# set appropriate attribute in last element
|
||||
# multiple values must be implemented in base class
|
||||
my $method = "add_$localname";
|
||||
|
||||
$list->[-1]->$method( $current );
|
||||
|
||||
# step up in path
|
||||
pop @{ $path };
|
||||
|
||||
# step up in object hierarchy...
|
||||
$current = pop @{ $list };
|
||||
}
|
||||
);
|
||||
|
||||
return $parser;
|
||||
sub parse_more {
|
||||
$_[0]->{ parser }->parse_more( $_[1] );
|
||||
}
|
||||
|
||||
sub get_data {
|
||||
my $self = shift;
|
||||
return $self->{ data };
|
||||
sub parse_done {
|
||||
$_[0]->{ parser }->parse_done();
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
@@ -174,15 +51,7 @@ See L<SOAP::WSDL::Parser> for details.
|
||||
|
||||
=head1 Bugs and Limitations
|
||||
|
||||
=over
|
||||
|
||||
=item * Ignores all namespaces
|
||||
|
||||
=item * Does not handle mixed content
|
||||
|
||||
=item * The SOAP header is ignored
|
||||
|
||||
=back
|
||||
See SOAP::WSDL::Expat::MessageParser
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
|
||||
Reference in New Issue
Block a user