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:
1 parent
874251225f
commit
f0b3bdc201
54 files changed
+1094
-450
No files matched your search
@@ -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] );
|
||||
|
||||
@@ -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 $
|
||||
|
||||
@@ -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 $
|
||||
|
||||
Reference in new issue
Block a user