import SOAP-WSDL 2.00_31 from CPAN

git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_31
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_31.tar.gz
This commit is contained in:
Martin Kutter authored and Michael G. Schwern committed 2009-12-12 19:48:21 -08:00
1 parent 874251225f
commit f0b3bdc201
54 files changed
+1094 -450

No files matched your search

+31 -1
View File
@@ -1,17 +1,47 @@
package SOAP::WSDL::Expat::Base;
use strict;
use warnings;
use URI;
use XML::Parser::Expat;
# TODO: convert to Class::Std::Fast based class - hash based classes suck.
our $VERSION = '2.00_27';
sub new {
my ($class, $args) = @_;
my ($class, $arg_ref) = @_;
my $self = {};
bless $self, $class;
$self->set_user_agent($arg_ref->{ user_agent })
if $arg_ref->{ user_agent };
return $self;
}
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 parse_uri {
my $self = shift;
my $uri = shift;
$self->set_uri( $uri );
if (not $self->{ user_agent }) {
require LWP::UserAgent;
$self->{ user_agent } = LWP::UserAgent->new();
}
my $response = $self->{ user_agent }->get($uri);
die $response->message() if $response->code() ne '200';
return $self->parse( $response->content() );
}
sub parse {
eval {
$_[0]->_initialize( XML::Parser::Expat->new( Namespaces => 1 ) )->parse( $_[1] );
+4 -3
View File
@@ -128,7 +128,7 @@ sub _initialize {
return &{$content_check{ $depth }}
if exists $content_check{ $depth };
push @{ $path }, $_[1]; # step down in path
push @{ $path }, $_[1]; # step down in path
return if $skip; # skip inside __SKIP__
# resolve class of this element
@@ -171,6 +171,7 @@ sub _initialize {
$current = bless \$o, $_class;
}
# set attributes if there are any
$current->attr({ @_[2..$#_] }) if (@_ > 2);
$depth++;
@@ -294,8 +295,8 @@ the same terms as perl itself
$Id: $
$LastChangedDate: 2008-01-19 13:57:57 +0100 (Sa, 19 Jan 2008) $
$LastChangedRevision: 497 $
$LastChangedDate: 2008-02-02 10:19:45 +0100 (Sa, 02 Feb 2008) $
$LastChangedRevision: 516 $
$LastChangedBy: kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $
+67 -3
View File
@@ -5,7 +5,57 @@ use Carp;
use SOAP::WSDL::TypeLookup;
use base qw(SOAP::WSDL::Expat::Base);
our $VERSION = q{2.00_29};
our $VERSION = q{2.00_31};
sub _import_children {
my ($self, $name, $imported, $importer, $import_namespace) = @_;
my $targetNamespace = $importer->get_targetNamespace();
my $push_method = "push_$name";
my $get_method = "get_$name";
no strict qw(refs);
my $value_ref = $imported->$get_method();
if ($value_ref) {
$value_ref = [ $value_ref ] if (not ref $value_ref eq 'ARRAY');
# set xmlns - can be different from parent
for (@{ $value_ref }) {
# fixup targetNamespace, but don't override
$_->set_targetNamespace( $import_namespace )
if ( ($import_namespace ne $targetNamespace) && ! $_->get_targetNamespace);
# update parent...
$_->set_parent( $importer );
}
# push elements into importing WSDL
$importer->$push_method(@{ $value_ref });
}
}
sub xml_schema_import {
my $self = shift;
my $schema = shift;
my $parser = ref($self)->new();
my %attr_of = @_;
my $import_namespace = $attr_of{ namespace };
my $uri = URI->new_abs($attr_of{schemaLocation}, $self->get_uri() );
my $import = $parser->parse_uri($uri);
for my $name ( qw(type element group) ) {
$self->_import_children( $name, $import, $schema, $import_namespace);
}
}
sub wsdl_import {
my $self = shift;
my $definitions = shift;
my $parser = ref($self)->new();
my %attr_of = @_;
my $import_namespace = $attr_of{ namespace };
my $uri = URI->new_abs($attr_of{location}, $self->get_uri() );
my $import = $parser->parse_uri($uri);
for my $name ( qw(types message binding portType service) ) {
$self->_import_children( $name, $import, $definitions, $import_namespace);
}
}
sub _initialize {
my ($self, $parser) = @_;
@@ -81,6 +131,20 @@ sub _initialize {
: _fixup_attrs($parser, %attrs)
);
}
elsif ($action->{type} eq 'HANDLER') {
my $method = $self->can($action->{method});
$method->($self, $current, %attrs);
}
else {
# TODO replace by hash lookup of known namespaces.
my $namespace = $parser->namespace($localname) || q{};
my $part = $namespace eq 'http://schemas.xmlsoap.org/wsdl/'
? 'WSDL 1.1'
: 'XML Schema';
warn "$part element <$localname> is not implemented yet"
if ($localname !~m{ \A (:? annotation | documentation ) \z }xms );
}
return;
},
@@ -179,8 +243,8 @@ the same terms as perl itself
$Id: $
$LastChangedDate: 2007-12-24 11:23:52 +0100 (Mo, 24 Dez 2007) $
$LastChangedRevision: 477 $
$LastChangedDate: 2008-02-11 00:14:27 +0100 (Mo, 11 Feb 2008) $
$LastChangedRevision: 522 $
$LastChangedBy: kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/WSDLParser.pm $