import SOAP-WSDL 2.00.07 from CPAN

git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00.07
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00.07.tar.gz
This commit is contained in:
Martin Kutter
2009-12-12 19:48:57 -08:00
committed by Michael G. Schwern
parent 3de318be40
commit bfc3247583
229 changed files with 16685 additions and 2064 deletions
+4 -3
View File
@@ -14,7 +14,7 @@ use Class::Std::Fast constructor => 'none';
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
use LWP::UserAgent;
use version; our $VERSION = qv('2.00.06');
use version; our $VERSION = qv('2.00.07');
my %no_dispatch_of :ATTR(:name<no_dispatch>);
my %wsdl_of :ATTR(:name<wsdl>);
@@ -125,6 +125,7 @@ sub wsdlinit {
? (keep_alive => 1)
: ()
);
$lwp->agent(qq[SOAP::WSDL $VERSION]);
my $response = $lwp->get( $wsdl_of{ $ident } );
croak $response->message() if ($response->code != 200);
@@ -830,9 +831,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 755 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: WSDL.pm 755 2008-12-03 21:36:54Z kutterma $
$Id: WSDL.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL.pm $
=cut
+9 -2
View File
@@ -5,7 +5,7 @@ use List::Util;
use Scalar::Util;
use Carp qw(croak carp confess);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %id_of :ATTR(:name<id> :default<()>);
my %lang_of :ATTR(:name<lang> :default<()>);
@@ -13,7 +13,7 @@ my %name_of :ATTR(:name<name> :default<()>);
my %namespace_of :ATTR(:name<namespace> :default<()>);
my %documentation_of :ATTR(:name<documentation> :default<()>);
my %annotation_of :ATTR(:name<annotation> :default<()>);
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<()>);
my %targetNamespace_of :ATTR(:name<targetNamespace> :default<"">);
my %xmlns_of :ATTR(:name<xmlns> :default<{}>);
my %parent_of :ATTR(:get<parent> :default<()>);
@@ -167,6 +167,13 @@ sub expand {
sub _expand;
*_expand = \&expand;
sub schema {
my $parent = $_[0]->get_parent();
return if ! defined $parent;
return $parent if $parent->isa('SOAP::WSDL::XSD::Schema');
return $parent->schema();
}
1;
__END__
+1 -1
View File
@@ -5,7 +5,7 @@ use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %operation_of :ATTR(:name<operation> :default<()>);
my %type_of :ATTR(:name<type> :default<()>);
+8 -3
View File
@@ -11,7 +11,7 @@ use SOAP::WSDL::Factory::Serializer;
use SOAP::WSDL::Factory::Transport;
use SOAP::WSDL::Expat::MessageParser;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
my %no_dispatch_of :ATTR(:name<no_dispatch> :default<()>);
@@ -24,8 +24,10 @@ my %soap_version_of :ATTR(:get<soap_version> :init_attr<soap_version> :de
my %on_action_of :ATTR(:name<on_action> :default<()>);
my %content_type_of :ATTR(:name<content_type> :default<text/xml; charset=utf-8>); #/#trick editors
my %encoding_of :ATTR(:name<encoding> :default<utf-8>);
my %serializer_of :ATTR(:name<serializer> :default<()>);
my %deserializer_of :ATTR(:name<deserializer> :default<()>);
my %deserializer_args_of :ATTR(:name<deserializer_args> :default<{}>);
sub BUILD {
my ($self, $ident, $attrs_of_ref) = @_;
@@ -147,6 +149,7 @@ sub call {
my $response = $transport->send_receive(
endpoint => $self->get_endpoint(),
content_type => $content_type_of{ $ident },
encoding => $encoding_of{ $ident },
envelope => $envelope,
action => $soap_action,
# on_receive_chunk => sub {} # optional, may be used for parsing large responses as they arrive.
@@ -155,8 +158,10 @@ sub call {
return $response if ($outputxml_of{ $ident } );
# get deserializer
use Data::Dumper;
$deserializer_of{ $ident } ||= SOAP::WSDL::Factory::Deserializer->get_deserializer({
soap_version => $soap_version_of{ $ident },
%{ $deserializer_args_of{ $ident } },
});
# set class resolver if serializer supports it
@@ -395,9 +400,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 744 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: Client.pm 744 2008-10-15 16:58:45Z kutterma $
$Id: Client.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
=cut
+3 -3
View File
@@ -4,7 +4,7 @@ use warnings;
use base 'SOAP::WSDL::Client';
use Scalar::Util qw(blessed);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
sub call {
my ($self, $method, $body, $header) = @_;
@@ -85,9 +85,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: Base.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: Base.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client/Base.pm $
=cut
+3 -3
View File
@@ -5,7 +5,7 @@ use List::Util qw(first);
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %types_of :ATTR(:name<types> :default<[]>);
my %message_of :ATTR(:name<message> :default<[]>);
@@ -115,9 +115,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: Definitions.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: Definitions.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Definitions.pm $
=cut
+3 -3
View File
@@ -8,7 +8,7 @@ use SOAP::WSDL::Expat::Message2Hash;
use SOAP::WSDL::Factory::Deserializer;
SOAP::WSDL::Factory::Deserializer->register( '1.1', __PACKAGE__ );
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
sub BUILD {
my ($self, $ident, $args_of_ref) = @_;
@@ -163,9 +163,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: Hash.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: Hash.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Deserializer/Hash.pm $
=cut
+3 -3
View File
@@ -2,7 +2,7 @@ package SOAP::WSDL::Deserializer::SOM;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
our @ISA;
eval {
@@ -140,9 +140,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: SOM.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: SOM.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Deserializer/SOM.pm $
=cut
+34 -7
View File
@@ -5,25 +5,34 @@ use Class::Std::Fast::Storable;
use SOAP::WSDL::SOAP::Typelib::Fault11;
use SOAP::WSDL::Expat::MessageParser;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
my %class_resolver_of :ATTR(:name<class_resolver> :default<()>);
my %strict_of :ATTR(:get<strict> :init_arg<strict> :default<1>);
my %parser_of :ATTR();
my %parser_of :ATTR();
sub set_strict {
undef $parser_of{${$_[0]}};
$strict_of{${$_[0]}} = $_[1];
}
sub BUILD {
my ($self, $ident, $args_of_ref) = @_;
# ignore all options except 'class_resolver'
for (keys %{ $args_of_ref }) {
delete $args_of_ref->{ $_ } if $_ ne 'class_resolver';
next if $_ eq 'strict';
next if $_ eq 'class_resolver';
delete $args_of_ref->{ $_ };
}
}
sub deserialize {
my ($self, $content) = @_;
$parser_of{ ${ $self } } = SOAP::WSDL::Expat::MessageParser->new()
$parser_of{ ${ $self } } = SOAP::WSDL::Expat::MessageParser->new({
strict => $strict_of{ ${ $self } }
})
if not $parser_of{ ${ $self } };
$parser_of{ ${ $self } }->class_resolver( $class_resolver_of{ ${ $self } } );
eval { $parser_of{ ${ $self } }->parse_string( $content ) };
@@ -75,6 +84,20 @@ SOAP::WSDL.
If you want to use the XSD serializer from SOAP::WSDL, set the outputtree()
property and provide a class_resolver.
=head1 OPTIONS
=over
=item * strict
Enables/disables strict XML processing. Strict processing is enabled by
default. To disable strict XML processing pass the following to the
constructor or use the C<set_strict> method:
strict => 0
=back
=head1 METHODS
=head2 deserialize
@@ -86,6 +109,10 @@ Deserializes the message.
Generates a L<SOAP::WSDL::SOAP::Typelib::Fault11|SOAP::WSDL::SOAP::Typelib::Fault11>
object and returns it.
=head2 set_strict
Enable/disable strict XML parsing. Default is enabled.
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2007 Martin Kutter.
@@ -99,9 +126,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: XSD.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: XSD.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Deserializer/XSD.pm $
=cut
+1 -1
View File
@@ -6,7 +6,7 @@ use XML::Parser::Expat;
# TODO: convert to Class::Std::Fast based class - hash based classes suck.
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
sub new {
my ($class, $arg_ref) = @_;
+1 -1
View File
@@ -4,7 +4,7 @@ use strict;
use warnings;
use base qw(SOAP::WSDL::Expat::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
sub _initialize {
my ($self, $parser) = @_;
+18 -11
View File
@@ -9,7 +9,7 @@ use base qw(SOAP::WSDL::Expat::Base);
BEGIN { require Class::Std::Fast };
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
# GLOBALS
my $OBJECT_CACHE_REF = Class::Std::Fast::OBJECT_CACHE_REF();
@@ -108,7 +108,10 @@ sub _initialize {
return;
}
)
: ();
: (
0 => sub { $depth++ },
1 => sub { $depth++ },
);
# use "globals" for speed
my ($_prefix, $_method, $_class, $_leaf) = ();
@@ -137,11 +140,14 @@ sub _initialize {
return if $skip; # skip inside __SKIP__
# resolve class of this element
$_class = $self->{ class_resolver }->get_class( $path )
or die "Cannot resolve class for "
. join('/', @{ $path }) . " via " . $self->{ class_resolver };
$_class = $self->{ class_resolver }->get_class( $path );
if ($_class eq '__SKIP__') {
if (! defined($_class) and $self->{ strict }) {
die "Cannot resolve class for "
. join('/', @{ $path }) . " via " . $self->{ class_resolver };
}
if (! defined($_class) or ($_class eq '__SKIP__') ) {
$skip = join('/', @{ $path });
$_[0]->setHandlers( Char => undef );
return;
@@ -233,6 +239,9 @@ sub _initialize {
# empty characters
$characters = q{};
# stop believing we're a leaf node
$_leaf = 0;
# return if there's only one elment - can't set it in parent ;-)
# but set as root element if we don't have one already.
if (not defined $list->[-1]) {
@@ -254,8 +263,6 @@ sub _initialize {
$current = pop @$list; # step up in object hierarchy
$_leaf = 0; # stop believing we're a leaf node
return;
}
);
@@ -323,10 +330,10 @@ the same terms as perl itself
=head1 Repository information
$Id: MessageParser.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: MessageParser.pm 795 2009-02-21 00:04:29Z kutterma $
$LastChangedDate: 2008-07-13 21:28:50 +0200 (So, 13 Jul 2008) $
$LastChangedRevision: 728 $
$LastChangedDate: 2009-02-21 01:04:29 +0100 (Sa, 21 Feb 2009) $
$LastChangedRevision: 795 $
$LastChangedBy: kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $
+3 -3
View File
@@ -6,7 +6,7 @@ use XML::Parser::Expat;
use SOAP::WSDL::Expat::MessageParser;
use base qw(SOAP::WSDL::Expat::MessageParser);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
sub parse_start {
my $self = shift;
@@ -69,9 +69,9 @@ the same terms as perl itself
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: MessageStreamParser.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: MessageStreamParser.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageStreamParser.pm $
=cut
+157 -126
View File
@@ -5,7 +5,7 @@ use Carp;
use SOAP::WSDL::TypeLookup;
use base qw(SOAP::WSDL::Expat::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#
# Import child elements of a WSDL / XML Schema tree into the current tree
@@ -18,33 +18,38 @@ use version; our $VERSION = qv('2.00.05');
#
sub _import_children {
my ($self, $name, $imported, $importer, $import_namespace) = @_;
my ( $self, $name, $imported, $importer, $import_namespace ) = @_;
my $targetNamespace = $importer->get_targetNamespace();
my $push_method = "push_$name";
my $get_method = "get_$name";
my $default_namespace = $imported->get_xmlns()->{ '#default' };
my $targetNamespace = $importer->get_targetNamespace();
my $push_method = "push_$name";
my $get_method = "get_$name";
my $default_namespace = $imported->get_xmlns()->{'#default'};
no strict qw(refs);
my $value_ref = $imported->$get_method();
if ($value_ref) {
$value_ref = [ $value_ref ] if (not ref $value_ref eq 'ARRAY');
$value_ref = [$value_ref] if ( not ref $value_ref eq 'ARRAY' );
for ( @{$value_ref} ) {
for (@{ $value_ref }) {
# fixup namespace - new parent may be from different namespace
if (defined ($default_namespace)) {
if ( defined($default_namespace) ) {
my $xmlns = $_->get_xmlns();
# it's a hash ref, so we can just update values
if (! defined $xmlns->{ '#default'}) {
$xmlns->{ '#default' } = $default_namespace;
if ( !defined $xmlns->{'#default'} ) {
$xmlns->{'#default'} = $default_namespace;
}
}
# fixup targetNamespace, but don't override
$_->set_targetNamespace( $import_namespace )
if ( ($import_namespace ne $targetNamespace) && ! $_->get_targetNamespace);
$_->set_targetNamespace($import_namespace)
if ( ( $import_namespace ne $targetNamespace )
&& !$_->get_targetNamespace );
# update parent...
$_->set_parent( $importer );
$_->set_parent($importer);
# push elements into importing WSDL
$importer->$push_method($_);
@@ -53,225 +58,254 @@ sub _import_children {
}
sub _import_namespace_definitions {
my $self = shift;
my $arg_ref = shift;
my $importer = $arg_ref->{ importer };
my $imported = $arg_ref->{ imported };
my $self = shift;
my $arg_ref = shift;
my $importer = $arg_ref->{importer};
my $imported = $arg_ref->{imported};
# import namespace definitions, too
my $importer_ns_of = $importer->get_xmlns();
my %xmlns_of = %{ $imported->get_xmlns() };
my %xmlns_of = %{$imported->get_xmlns()};
# it's a hash ref, we can just add to.
# TODO: check whether prefix is already taken.
# TODO: check wheter URI is the better key.
while (my ($prefix, $url) = each %xmlns_of) {
$importer_ns_of->{ $prefix } = $url;
# TODO: check whether URI is the better key.
while ( my ( $prefix, $url ) = each %xmlns_of ) {
if ( exists( $importer_ns_of->{$prefix} ) ) {
# warn "$prefix already exists";
next;
}
$importer_ns_of->{$prefix} = $url;
}
}
sub xml_schema_import {
my $self = shift;
my $schema = shift;
my $parser = $self->clone();
my %attr_of = @_;
my $import_namespace = $attr_of{ namespace };
my $self = shift;
my $schema = shift;
my $parser = $self->clone();
my %attr_of = @_;
my $import_namespace = $attr_of{namespace};
if (not $attr_of{schemaLocation}) {
warn "cannot import document for namespace >$import_namespace< without location";
if ( not $attr_of{schemaLocation} ) {
warn
"cannot import document for namespace >$import_namespace< without location";
return;
}
if (not $self->get_uri) {
die "cannot import document from namespace >$import_namespace< without base uri. Use >parse_uri< or >set_uri< to set one."
if ( not $self->get_uri ) {
die
"cannot import document from namespace >$import_namespace< without base uri. Use >parse_uri< or >set_uri< to set one.";
}
my $uri = URI->new_abs($attr_of{schemaLocation}, $self->get_uri() );
my $uri = URI->new_abs( $attr_of{schemaLocation}, $self->get_uri() );
my $imported = $parser->parse_uri($uri);
# might already be imported - parse_uri just returns in this case
return if not defined $imported;
$self->_import_namespace_definitions({
importer => $schema,
imported => $imported,
});
$self->_import_namespace_definitions( {
importer => $schema,
imported => $imported,
} );
for my $name ( qw(type element group attribute attributeGroup) ) {
$self->_import_children( $name, $imported, $schema, $import_namespace);
for my $name (qw(type element group attribute attributeGroup)) {
$self->_import_children( $name, $imported, $schema,
$import_namespace );
}
}
sub wsdl_import {
my $self = shift;
my $definitions = shift;
my $parser = $self->clone();
my %attr_of = @_;
my $import_namespace = $attr_of{ namespace };
my $self = shift;
my $definitions = shift;
my $parser = $self->clone();
my %attr_of = @_;
my $import_namespace = $attr_of{namespace};
if (not $attr_of{location}) {
warn "cannot import document for namespace >$import_namespace< without location";
if ( not $attr_of{location} ) {
warn
"cannot import document for namespace >$import_namespace< without location";
return;
}
if (not $self->get_uri) {
die "cannot import document from namespace >$import_namespace< without base uri. Use >parse_uri< or >set_uri< to set one."
if ( not $self->get_uri ) {
die
"cannot import document from namespace >$import_namespace< without base uri. Use >parse_uri< or >set_uri< to set one.";
}
my $uri = URI->new_abs($attr_of{location}, $self->get_uri() );
my $uri = URI->new_abs( $attr_of{location}, $self->get_uri() );
my $imported = $parser->parse_uri($uri);
# might already be imported - parse_uri just returns in this case
return if not defined $imported;
$self->_import_namespace_definitions({
importer => $definitions,
imported => $imported,
});
$self->_import_namespace_definitions( {
importer => $definitions,
imported => $imported,
} );
for my $name ( qw(types message binding portType service) ) {
$self->_import_children( $name, $imported, $definitions, $import_namespace);
for my $name (qw(types message binding portType service)) {
$self->_import_children( $name, $imported, $definitions,
$import_namespace );
}
}
sub _initialize {
my ($self, $parser) = @_;
my ( $self, $parser ) = @_;
# init object data
$self->{ parser } = $parser;
delete $self->{ data };
$self->{parser} = $parser;
delete $self->{data};
# setup local variables for keeping temp data
my $characters = undef;
my $current = undef;
my $list = []; # node list
my $characters = undef;
my $current = undef;
my $list = []; # node list
my $elementFormQualified = 1; # default for WSDLs, schema may override
# TODO skip non-XML Schema namespace tags
$parser->setHandlers(
Start => sub {
# handle attrs as list - expat uses dual-vars for looking
# up namespace information, and hash keys don't allow dual vars...
my ($parser, $localname, @attrs) = @_;
my ( $parser, $localname, @attrs ) = @_;
$characters = q{};
my $action = SOAP::WSDL::TypeLookup->lookup(
$parser->namespace($localname),
$localname
);
my $action =
SOAP::WSDL::TypeLookup->lookup( $parser->namespace($localname),
$localname );
return if not $action;
if ($action->{ type } eq 'CLASS') {
if ( $action->{type} eq 'CLASS' ) {
eval "require $action->{ class }";
croak $@ if ($@);
my $obj = $action->{ class }->new({
parent => $current,
my $obj = $action->{class}->new( {
parent => $current,
namespace => $parser->namespace($localname),
})
->init( _fixup_attrs( $parser, @attrs ) );
defined($current)
? ( xmlns => $current->get_xmlns() )
: ()} )->init( _fixup_attrs( $parser, @attrs ) );
if ($current) {
if ( defined $list->[-1]
&& $list->[-1]->isa('SOAP::WSDL::XSD::Schema') ) {
$elementFormQualified =
$list->[-1]->get_elementFormDefault() eq
'qualified';
}
# inherit namespace, but don't override
$obj->set_targetNamespace( $current->get_targetNamespace() )
if not $obj->get_targetNamespace();
if ($elementFormQualified) {
$obj->set_targetNamespace(
$current->get_targetNamespace() )
if not $obj->get_targetNamespace();
}
# push on parent's element/type list
my $method = "push_$localname";
no strict qw(refs);
$current->$method( $obj );
$current->$method($obj);
# remember element for stepping back
push @{ $list }, $current;
push @{$list}, $current;
}
# set new element (step down)
$current = $obj;
}
elsif ($action->{ type } eq 'PARENT') {
$current->init( _fixup_attrs($parser, @attrs) );
elsif ( $action->{type} eq 'PARENT' ) {
$current->init( _fixup_attrs( $parser, @attrs ) );
}
elsif ($action->{ type } eq 'METHOD') {
my $method = $action->{ method };
elsif ( $action->{type} eq 'METHOD' ) {
my $method = $action->{method};
no strict qw(refs);
# call method with
# - default value ($action->{ value } if defined,
# dereferencing lists
# - the values of the elements Attributes hash
# TODO: add namespaces declared to attributes.
# Expat consumes them, so we have to re-add them here.
$current->$method( defined $action->{ value }
? ref $action->{ value }
? @{ $action->{ value } }
: ($action->{ value })
: _fixup_attrs($parser, @attrs)
);
$current->$method(
defined $action->{value}
? ref $action->{value}
? @{$action->{value}}
: ( $action->{value} )
: _fixup_attrs( $parser, @attrs ) );
}
elsif ($action->{type} eq 'HANDLER') {
my $method = $self->can($action->{method});
$method->($self, $current, @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';
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 );
if ( $localname !~
m{ \A (:? annotation | documentation ) \z }xms );
}
return;
},
Char => sub { $characters .= $_[1]; return; },
Char => sub { $characters .= $_[1]; return; },
End => sub {
my ($parser, $localname) = @_;
my ( $parser, $localname ) = @_;
my $action = SOAP::WSDL::TypeLookup->lookup(
$parser->namespace( $localname ),
$localname
) || {};
my $action =
SOAP::WSDL::TypeLookup->lookup( $parser->namespace($localname),
$localname )
|| {};
if (! defined $list->[-1]) {
$self->{ data } = $current;
if ( !defined $list->[-1] ) {
$self->{data} = $current;
return;
}
return if not ($action->{ type });
if ( $action->{ type } eq 'CLASS' ) {
$current = pop @{ $list };
return if not( $action->{type} );
if ( $action->{type} eq 'CLASS' ) {
$current = pop @{$list};
if ( defined $list->[-1] && $list->[-1]->isa('SOAP::WSDL::XSD::Schema') ) {
$elementFormQualified = 1;
}
}
elsif ($action->{ type } eq 'CONTENT' ) {
my $method = $action->{ method };
elsif ( $action->{type} eq 'CONTENT' ) {
my $method = $action->{method};
# normalize whitespace
$characters =~s{ ^ \s+ (.+) \s+ $ }{$1}xms;
$characters =~s{ \s+ }{ }xmsg;
$characters =~ s{ ^ \s+ (.+) \s+ $ }{$1}xms;
$characters =~ s{ \s+ }{ }xmsg;
no strict qw(refs);
$current->$method( $characters );
$current->$method($characters);
}
return;
}
);
} );
return $parser;
}
# make attrs SAX style
sub _fixup_attrs {
my ($parser, @attrs) = @_;
my ( $parser, @attrs ) = @_;
my @attr_key_from = ();
my @attr_key_from = ();
my @attr_value_from = ();
while (@attrs) {
push @attr_key_from, shift @attrs;
push @attr_key_from, shift @attrs;
push @attr_value_from, shift @attrs;
}
@@ -281,20 +315,18 @@ sub _fixup_attrs {
#
# add namespaces before attributes: Attributes may be namespace-qualified
#
push @attrs_from, map {
{
Name => "xmlns:$_",
Value => $parser->expand_ns_prefix( $_ ),
push @attrs_from, map { {
Name => "xmlns:$_",
Value => $parser->expand_ns_prefix($_),
LocalName => $_
}
} $parser->new_ns_prefixes();
push @attrs_from, map {
{
push @attrs_from, map { {
Name => defined $parser->namespace($_)
? $parser->namespace($_) . '|' . $_
: '|' . $_,
Value => shift @attr_value_from, # $attrs_of{ $_ },
? $parser->namespace($_) . '|' . $_
: '|' . $_,
Value => shift @attr_value_from, # $attrs_of{ $_ },
LocalName => $_
}
} @attr_key_from;
@@ -304,7 +336,6 @@ sub _fixup_attrs {
1;
=pod
=head1 NAME
@@ -336,10 +367,10 @@ the same terms as perl itself
=head1 Repository information
$Id: WSDLParser.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: WSDLParser.pm 795 2009-02-21 00:04:29Z kutterma $
$LastChangedDate: 2008-07-13 21:28:50 +0200 (So, 13 Jul 2008) $
$LastChangedRevision: 728 $
$LastChangedDate: 2009-02-21 01:04:29 +0100 (Sa, 21 Feb 2009) $
$LastChangedRevision: 795 $
$LastChangedBy: kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/WSDLParser.pm $
+1 -1
View File
@@ -2,7 +2,7 @@ package SOAP::WSDL::Factory::Deserializer;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %DESERIALIZER = (
'1.1' => 'SOAP::WSDL::Deserializer::XSD',
+1 -1
View File
@@ -2,7 +2,7 @@ package SOAP::WSDL::Factory::Generator;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %GENERATOR = (
'XSD' => 'SOAP::WSDL::Generator::Template::XSD',
+3 -3
View File
@@ -2,7 +2,7 @@ package SOAP::WSDL::Factory::Serializer;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %SERIALIZER = (
'1.1' => 'SOAP::WSDL::Serializer::XSD',
@@ -138,9 +138,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: Serializer.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: Serializer.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Serializer.pm $
=cut
+3 -3
View File
@@ -1,7 +1,7 @@
package SOAP::WSDL::Factory::Transport;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %registered_transport_of = ();
@@ -243,9 +243,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: Transport.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: Transport.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Factory/Transport.pm $
=cut
+3 -2
View File
@@ -2,7 +2,7 @@ package SOAP::WSDL::Generator::Iterator::WSDL11;
use strict; use warnings;
use Class::Std::Fast;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %definitions_of :ATTR(:name<definitions> :default<[]>);
my %nodes_of :ATTR(:name<nodes> :default<[]>);
@@ -73,7 +73,8 @@ my %METHOD_OF = (
$node->get_type()
? do {
die "unsupported global type <"
. $node->get_type . "> found in part ". $node->get_name();
. $node->get_type . "> found in part <". $node->get_name() . ">\n"
. "Looks like a rpc/literal WSDL, which is not supported by SOAP::WSDL\n";
## use this once we can auto-generate an element for RPC bindings
# $types->find_type( $node->expand($node->get_type) )
}
+1 -1
View File
@@ -3,7 +3,7 @@ use strict; use warnings;
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %namespace_prefix_map_of :ATTR(:name<namespace_prefix_map> :default<{}>);
my %namespace_map_of :ATTR(:name<namespace_map> :default<{}>);
+37 -1
View File
@@ -5,7 +5,7 @@ use Class::Std::Fast::Storable;
use Carp;
use SOAP::WSDL::Generator::PrefixResolver;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %tt_of :ATTR(:get<tt>);
my %definitions_of :ATTR(:name<definitions> :default<()>);
@@ -70,3 +70,39 @@ sub _process :PROTECTED {
}
1;
=pod
=head1 NAME
SOAP::WSDL::Generator::Template - Template-based code generator
=head1 DESCRIPTION
SOAP::WSDL's template based code generator
Base class for writing template based generators
=head1 AUTHOR
Replace the whitespace by @ for E-Mail Address.
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 LICENSE AND COPYRIGHT
Copyright 2008, 2009 Martin Kutter.
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself
=head1 Repository information
$Id: WSDLParser.pm 770 2009-01-24 22:55:54Z kutterma $
$LastChangedDate: 2009-01-24 23:55:54 +0100 (Sa, 24 Jan 2009) $
$LastChangedRevision: 770 $
$LastChangedBy: kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/WSDLParser.pm $
@@ -4,7 +4,7 @@ use warnings;
use Carp qw(confess);
use Class::Std::Fast::Storable constructor => 'none';
use Scalar::Util qw(blessed);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %namespace_prefix_map_of :ATTR(:name<namespace_prefix_map> :default<{}>);
my %namespace_map_of :ATTR(:name<namespace_map> :default<{}>);
+114 -7
View File
@@ -5,15 +5,15 @@ use Class::Std::Fast::Storable;
use File::Basename;
use File::Spec;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
use SOAP::WSDL::Generator::Visitor::Typemap;
use SOAP::WSDL::Generator::Visitor::Typelib;
use SOAP::WSDL::Generator::Template::Plugin::XSD;
use base qw(SOAP::WSDL::Generator::Template);
my %output_of :ATTR(:name<output> :default<()>);
my %typemap_of :ATTR(:name<typemap> :default<({})>);
my %silent_of :ATTR(:name<silent> :default<0>);
sub BUILD {
my ($self, $ident, $arg_ref) = @_;
@@ -113,7 +113,8 @@ sub _generate_interface {
$service,
$port,
));
print "Creating interface class $output\n";
print "Creating interface class $output\n"
if not $silent_of{ident $self};
$self->_process($template_name,
{
@@ -173,7 +174,8 @@ sub generate_typemap {
my $output = $arg_ref->{ output }
? $arg_ref->{ output }
: $self->_generate_filename( $self->get_name_resolver()->create_typemap_name($service) );
print "Creating typemap class $output\n";
print "Creating typemap class $output\n"
if not $silent_of{ident $self};
$self->_process('Typemap.tt',
{
service => $service,
@@ -205,7 +207,8 @@ sub visit_XSD_Element {
my $output = defined $output_of{ ident $self }
? $output_of{ ident $self }
: $self->_generate_filename( $self->get_name_resolver()->create_xsd_name($element) );
warn "Creating element class $output \n";
warn "Creating element class $output \n"
if not $silent_of{ ident $self};
$self->_process('element.tt', { element => $element } , $output);
}
@@ -214,7 +217,8 @@ sub visit_XSD_SimpleType {
my $output = defined $output_of{ ident $self }
? $output_of{ ident $self }
: $self->_generate_filename( $self->get_name_resolver()->create_xsd_name($type) );
warn "Creating simpleType class $output \n";
warn "Creating simpleType class $output \n"
if not $silent_of{ ident $self};
$self->_process('simpleType.tt', { simpleType => $type } , $output);
}
@@ -223,8 +227,111 @@ sub visit_XSD_ComplexType {
my $output = defined $output_of{ ident $self }
? $output_of{ ident $self }
: $self->_generate_filename( $self->get_name_resolver()->create_xsd_name($type) );
warn "Creating complexType class $output \n";
warn "Creating complexType class $output \n"
if not $silent_of{ ident $self};
$self->_process('complexType.tt', { complexType => $type } , $output);
}
1;
=pod
=head1 NAME
SOAP::WSDL::Generator::Template::XSD - XSD code generator
=head1 DESCRIPTION
SOAP::WSDL's XSD code generator
=head1 SYNOPSIS
See L<wsdl2perl.pl|wsdl2perl.pl> for an example on how to use this class.
=head1 METHODS
=head2 new
Constructor.
Options (Options can also be set via set_OPTION methods):
=over
=item * silent
Suppress warnings about what's being generated
=back
=head2 generate
Shortcut for calling L<generate_typelib> and L<generate_client>
=head2 generate_client
Generates a client interface
=head2 generate_server
Generates a server class
=head2 generate_typelib
Generates type and element classes
=head2 generate_typemap
Generate a typemap class required by SOAP::WSDL's MessageParser
=head2 generate_interface
(Deprecated) alias for generate_client
=head2 get_name_resolver
Returns a name resolver template plugin
=head2 visit_XSD_Attribute
Visitor method for SOAP::WSDL::XSD::Attribute. Should be factored out into
visitor class.
=head2 visit_XSD_ComplexType
Visitor method for SOAP::WSDL::XSD::ComplexType. Should be factored out into
visitor class.
=head2 visit_XSD_Element
Visitor method for SOAP::WSDL::XSD::Element. Should be factored out into
visitor class.
=head2 visit_XSD_SimpleType
Visitor method for SOAP::WSDL::XSD::SimpleType. Should be factored out into
visitor class.
=head1 AUTHOR
Replace the whitespace by @ for E-Mail Address.
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 LICENSE AND COPYRIGHT
Copyright 2008, 2009 Martin Kutter.
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself
=head1 Repository information
$Id: WSDLParser.pm 770 2009-01-24 22:55:54Z kutterma $
$LastChangedDate: 2009-01-24 23:55:54 +0100 (Sa, 24 Jan 2009) $
$LastChangedRevision: 770 $
$LastChangedBy: kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/WSDLParser.pm $
@@ -7,7 +7,6 @@ our [% USE Dumper(varname = 'typemap_'); Dumper.dump( typemap ) %];
sub get_class {
my $name = join '/', @{ $_[1] };
exists $typemap_1->{ $name } or die "Cannot resolve $name via " . __PACKAGE__;
return $typemap_1->{ $name };
}
@@ -8,6 +8,10 @@ use warnings;
# may be sub-packages...
#-%]
__PACKAGE__->_set_element_form_qualified([%-
IF complexType.schema.get_elementFormDefault == 'qualified'
-%]1[% ELSE %]0[% END %]);
[% INCLUDE complexType/contentModel.tt %]
1;
@@ -102,9 +102,9 @@ perl code only, XML output uses the original name:
[% END %]
[% END; %]
=back
[% END;
END;
[% END;
END; -%]
+1 -1
View File
@@ -3,7 +3,7 @@ use strict;
use warnings;
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %definitions_of :ATTR(:name<definitions> :default<()>);
my %type_prefix_of :ATTR(:name<type_prefix> :default<()>);
@@ -1,11 +0,0 @@
package SOAP::WSDL::Generator::Visitor::Typelib;
use strict;
use warnings;
use base qw(SOAP::WSDL::Generator::Visitor
SOAP::WSDL::Generator::Template
);
use version; our $VERSION = qv('2.00.05');
1;
+37 -1
View File
@@ -5,7 +5,7 @@ use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Generator::Visitor);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %path_of :ATTR(:name<path> :default<[]>);
my %typemap_of :ATTR(:name<typemap> :default<()>);
@@ -182,3 +182,39 @@ sub visit_XSD_ComplexType {
}
1;
__END__
=pod
=head1 NAME
SOAP::WSDL::Generator::Visitor::Typemap - Visitor class for generating typemaps
=head1 DESCRIPTION
Visitor used by SOAP::WSDL's XSD generator for creating typemaps
=head1 AUTHOR
Replace the whitespace by @ for E-Mail Address.
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 LICENSE AND COPYRIGHT
Copyright 2008, 2009 Martin Kutter.
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself
=head1 Repository information
$Id: WSDLParser.pm 770 2009-01-24 22:55:54Z kutterma $
$LastChangedDate: 2009-01-24 23:55:54 +0100 (Sa, 24 Jan 2009) $
$LastChangedRevision: 770 $
$LastChangedBy: kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/WSDLParser.pm $
+91
View File
@@ -0,0 +1,91 @@
=pod
=head1 Writing Code-First Web Services with SOAP::WSDL
B<Note: This document is just a collection of thought. There's no implementation yet>.
=head2 How Data Class definitions could look like
=head3 Moose
Of course SOAP::WSDL could (and probably should) just use Moose - it provides the full
Metaclass Framework needed for generating Schemas from class definitions.
However, Moose is way too powerful for building (just) simple Data Transfer Objects which
can be expressed in XML.
With Moose, a class could look like this:
package MyElements::GenerateBarCode;
use Moose;
has 'xmlns' =>
is => 'ro',
default => 'http://webservicex.net';
has 'xmlname' =>
is => 'ro',
default => 'GenerateBarCode';
has 'BarCodeParam' =>
is => 'rw',
type => 'MyTypes::BarCodeData';
has 'BarCodeText' =>
is => 'rw',
type => 'String';
1;
This is - despite the condensed syntax - a lot of line noise.
=head3 Native SOAP::WSDL
SOAP::WSDL::XSD::Typelib::ComplexType (should) provide a simple setup method allowing a even shorter
description (and offering the additional performance boost SOAP::WSDL has over Moose):
package MyElements::GenerateBarCode;
use strice; use warnings;
use SOAP::WSDL::XSD::Typelib::Element;
use SOAP::WSDL::XSD::Typelib::ComplexType;
_namespace 'http://webservicex.net'; # might be better in the SOAP server interface
_name 'GenerateBarCode';
_elements
BarCodeParam => 'MyTypes::BarCodeData',
BarCodeText => 'string';
This would result in the following XML Schema (inside a schema with the namespace
"http://webservicex.net" - the namespaces could even be declared outside the DTO classes.
<complexType name="GenerateBarCode">
<sequence>
<element name="BarCodeParam" type="tns:BarCodeData"/>
<element name="BarCodeText" type="xsd:string"/>
</sequence>
</complexType>
=head2 Interface definitions
Perl does not have the concept of interfaces. However, Moose provides Roles, which can be used for defining
interfaces.
However, it's not really necessary to define a interface Interface (in the sense of a Jave interface) -
a interface class is sufficient.
Subroutine attributes could be used for providing additional information - attributes in perl are much like
annotations in Java
A interface could look like this:
package MyServer::BarCode;
use strict; use warnings;
use SOAP::WSDL::Server::CodeFirst;
sub generateBarCode :WebMethod(name=<GenerateBarCode>
return=<MyElements::GenerateBarcodeResponse>
body=<MyElements::GenerateBarcode>) {
my ($self, $body, $header) = @_;
my $result = MyElements::GenerateBarcodeResponse->new();
return $result;
};
1;
+74 -4
View File
@@ -12,7 +12,7 @@ You need Crypt::SSLeay installed to access HTTPS webservices.
Passing a username and password, or a client certificate and key, to the
transport layer is highly dependent on the transport backend. The descriptions
below are for HTTP(S) transport usingLWP::UserAgent
below are for HTTP(S) transport using LWP::UserAgent
=head3 Accessing HTTP(S) webservices with basic/digest authentication
@@ -121,12 +121,82 @@ or nil elements):
return "<$prefix:$name>";
}
=head1 Skipping unknown XML elements - "lax" XML processing
SOAP::WSDL's default serializer
L<SOAP::WSDL::Deserializer::XSD|SOAP::WSDL::Deserializer::XSD> is a "strict"
XML processor in the sense that it throws an exception on encountering unknown
XML elements.
L<SOAP::WSDL::Deserializer::XSD|SOAP::WSDL::Deserializer::XSD> allows
switching off the stric XML processing by passing the C<strict =E<gt> 0>
option.
=head2 Disabling strict XML processing in a Client
Pass the following as C<deserializer_args>:
{ strict => 0 }
Example: The generated SOAP client is assumed to be "MyInterface::Test".
use MyInterface::Test;
my $soap = MyInterface::Test->new({
deserializer_args => { strict => 0 }
});
my $result = $soap->SomeMethod();
=head2 Disabling strict XML processing in a CGI based server
You have to set the deserializer in the transport class explicitely to
a L<SOAP::WSDL::Deserializer|SOAP::WSDL::Deserializer> object with the
C<strict> option set to 0.
Example: The generated SOAP server is assumed to be "MyServer::Test".
use strict;
use MyServer::Test;
use SOAP::WSDL::Deserializer::XSD;
my $soap = MyServer::Test->new({
transport_class => 'SOAP::WSDL::Server::CGI',
dispatch_to => 'main',
});
$soap->get_transport()->set_deserializer(
SOAP::WSDL::Deserializer::XSD->new({ strict => 0 })
);
$soap->handle();
=head2 Disabling strict XML processing in a mod_perl based server
Sorry, this is not implemented yet - you'll have to write your own handler
class based on L<SOAP::WSDL::Server::Mod_Perl2|SOAP::WSDL::Server::Mod_Perl2>.
=head1 Changing the encoding of a SOAP request
SOAP::WSDL uses utf-8 per default: utf-8
is the de-facto standard for webservice ommunication.
However, you can change the encoding the transport layer announces by calling
C<set_encoding($encoding)> on a client object.
You probably have to write your own serializer class too, because the default
serializer has the utf-8 encoding hardcoded in the envelope.
Just look into SOAP::WSDL::Serializer on how to do that.
Don't forget to register your serializer at the serializer factory
SOAP::WSDL::Factory::Serializer.
=head1 LICENSE AND COPYRIGHT
Copyright 2008 Martin Kutter.
Copyright 2008, 2009 Martin Kutter.
This library is free software. You may distribute/modify it under
the same terms as perl itself
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself.
=head1 AUTHOR
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %part_of :ATTR(:name<part> :default<[]>);
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %body_of :ATTR(:name<body> :default<[]>);
my %header_of :ATTR(:name<header> :default<[]>);
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %operation_of :ATTR(:name<operation> :default<()>);
my %input_of :ATTR(:name<input> :default<[]>);
+1 -1
View File
@@ -6,7 +6,7 @@ use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %element_of :ATTR(:name<element> :default<()>);
my %type_of :ATTR(:name<type> :default<()>);
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %binding_of :ATTR(:name<binding> :default<()>);
my %address_of :ATTR(:name<address> :default<()>);
+1 -1
View File
@@ -5,7 +5,7 @@ use Class::Std::Fast::Storable;
use List::Util;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %operation_of :ATTR(:name<operation> :default<()>);
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use base qw(SOAP::WSDL::Base);
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %location :ATTR(:name<location> :default<()>);
1;
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use base qw(SOAP::WSDL::Base);
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %use_of :ATTR(:name<use> :default<q{}>);
my %namespace_of :ATTR(:name<namespace> :default<q{}>);
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use base qw(SOAP::WSDL::Base);
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %use_of :ATTR(:name<use> :default<q{}>);
my %namespace_of :ATTR(:name<namespace> :default<q{}>);
+1 -1
View File
@@ -3,6 +3,6 @@ use strict;
use warnings;
use base qw(SOAP::WSDL::Header);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
1;
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %style_of :ATTR(:name<style> :default<()>);
my %soapAction_of :ATTR(:name<soapAction> :default<()>);
+3 -3
View File
@@ -3,7 +3,7 @@ use strict;
use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
use SOAP::WSDL::XSD::Typelib::ComplexType;
use SOAP::WSDL::XSD::Typelib::Element;
@@ -101,9 +101,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: Fault11.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: Fault11.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/SOAP/Typelib/Fault11.pm $
=cut
+3 -3
View File
@@ -5,7 +5,7 @@ use warnings;
use Class::Std::Fast::Storable;
use Scalar::Util qw(blessed);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
use SOAP::WSDL::Factory::Serializer;
@@ -132,9 +132,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 735 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: XSD.pm 735 2008-08-14 07:36:54Z kutterma $
$Id: XSD.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Serializer/XSD.pm $
=cut
+7 -7
View File
@@ -6,7 +6,7 @@ use Scalar::Util qw(blessed);
use SOAP::WSDL::Factory::Deserializer;
use SOAP::WSDL::Factory::Serializer;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %dispatch_to_of :ATTR(:name<dispatch_to> :default<()>);
my %action_map_ref_of :ATTR(:name<action_map_ref> :default<{}>);
@@ -42,7 +42,7 @@ sub handle {
};
if ($@) {
die $deserializer_of{ $ident }->generate_fault({
code => 'soap:Server',
code => 'SOAP-ENV:Server',
role => 'urn:localhost',
message => "Error deserializing message: $@. \n"
});
@@ -65,7 +65,7 @@ sub handle {
if (!$dispatch_to_of{ $ident }) {
die $deserializer_of{ $ident }->generate_fault({
code => 'soap:Server',
code => 'SOAP-ENV:Server',
role => 'urn:localhost',
message => "No handler registered",
});
@@ -73,7 +73,7 @@ sub handle {
if (! defined $request->header('SOAPAction') ) {
die $deserializer_of{ $ident }->generate_fault({
code => 'soap:Server',
code => 'SOAP-ENV:Server',
role => 'urn:localhost',
message => "Not found: No SOAPAction given",
});
@@ -81,7 +81,7 @@ sub handle {
if (! defined $method_name) {
die $deserializer_of{ $ident }->generate_fault({
code => 'soap:Server',
code => 'SOAP-ENV:Server',
role => 'urn:localhost',
message => "Not found: No method found for the SOAPAction '$soap_action'",
});
@@ -92,7 +92,7 @@ sub handle {
if (!$method_ref) {
die $deserializer_of{ $ident }->generate_fault({
code => 'soap:Server',
code => 'SOAP-ENV:Server',
role => 'urn:localhost',
message => "Not implemented: The handler does not implement the method $method_name",
});
@@ -190,7 +190,7 @@ SOAP::Server's deserializer create one for you:
my $soap = MyServer::SomeService->new();
die $soap->get_deserializer()->generate_fault({
code => 'soap:Server',
code => 'SOAP-ENV:Server',
role => 'urn:localhost',
message => "The error message to pas back",
detail => "Some details on the error",
+1 -1
View File
@@ -14,7 +14,7 @@ use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Server);
use version; our $VERSION = qv('2.00.06');
use version; our $VERSION = qv('2.00.07');
# mostly copied from SOAP::Lite. Unfortunately we can't use SOAP::Lite's CGI
# server directly - we would have to swap out it's base class...
+1 -1
View File
@@ -16,7 +16,7 @@ use Apache2::Const -compile => qw(
HTTP_LENGTH_REQUIRED
);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %LOADED_OF = ();
+161
View File
@@ -0,0 +1,161 @@
package SOAP::WSDL::Server::Simple;
use strict;
use warnings;
use Encode;
use HTTP::Request;
use HTTP::Response;
use HTTP::Status;
use HTTP::Headers;
use Scalar::Util qw(blessed);
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Server);
use version; our $VERSION = qv('2.00.07');
# mostly copied from SOAP::Lite. Unfortunately we can't use SOAP::Lite's CGI
# server directly - we would have to swap out it's base class...
#
# This should be a warning for us: We should not handle methods via inheritance,
# but via some plugin mechanism, to allow alternative handlers to be plugged
# in.
sub handle {
my ($self, $cgi) = @_;
my $response;
my $content = $cgi->param('POSTDATA');
my $request = HTTP::Request->new(
$ENV{'REQUEST_METHOD'} || '' => $ENV{'SCRIPT_NAME'},
HTTP::Headers->new(
map {
(/^HTTP_(.+)/i
? ($1=~m/SOAPACTION/)
?('SOAPAction')
:($1)
: $_
) => $ENV{$_}
} keys %ENV),
$content,
);
# we copy the response message around here.
# Passing by reference would be much better...
my $response_message = eval { $self->SUPER::handle($request) };
# caveat: SOAP::WSDL::SOAP::Typelib::Fault11 is false in bool context...
if ($@ || blessed $@) {
my $exception = $@;
$response = HTTP::Response->new(500);
$response->header('Content-type' => 'text/xml; charset="utf-8"');
if (blessed($exception)) {
$response->content( $self->get_serializer->serialize({
body => $exception
})
);
}
else {
$response->content($exception);
}
}
else {
$response = HTTP::Response->new(200);
$response->header('Content-type' => 'text/xml; charset="utf-8"');
$response->content( encode('utf8', $response_message ) );
{
use bytes;
$response->header('Content-length', length $response_message);
}
}
$self->_output($response);
return;
}
sub _output :PRIVATE {
my ($self, $response) = @_;
my $code = $response->code;
binmode(STDOUT);
print STDOUT "HTTP/1.0 $code ", HTTP::Status::status_message($code)
, "\015\012", $response->headers_as_string("\015\012")
, "\015\012", $response->content;
warn "HTTP/1.0 $code ", HTTP::Status::status_message($code)
, "\015\012", $response->headers_as_string("\015\012")
, $response->content, "\n\n";
}
1;
=pod
=head1 NAME
SOAP::WSDL::Server::Simple - CGI based SOAP server for HTTP::Server::Simple
=head1 SYNOPSIS
package TestServer;
use base qw(HTTP::Server::Simple::CGI);
use MyServer::TestService::TestPort;
sub handle_request {
my ($self, $cgi) = @_;
my $server = MyServer::TestService::TestPort->new({
dispatch_to => 'main',
transport_class => 'SOAP::WSDL::Server::Simple',
});
$server->handle($cgi);
}
my $httpd = __PACKAGE__->new();
$httpd->run();
=head1 USAGE
To use SOAP::WSDL::Server::Simple efficiently, you should first create a server
interface using L<wsdl2perl.pl|wsdl2perl.pl>.
SOAP::WSDL::Server::Simple dispatches all calls to appropriately named methods in the
class or object set via C<dispatch_to>.
See the generated server class on details.
=head1 DESCRIPTION
Lightweight SOAP server for use with HTTP::Server::Simple, mainly designed
for testing purposes. It allows to set up a simple SOAP server without having
to configure CGI or mod_perl stuff.
SOAP::WSDL::Server::Simple is not recommended for production use.
=head1 METHODS
=head2 handle
See synopsis above.
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2008 Martin Kutter.
This file is part of SOAP-WSDL. You may distribute/modify it under the same
terms as perl itself
=head1 AUTHOR
Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 391 $
$LastChangedBy: kutterma $
$Id: Client.pm 391 2007-11-17 21:56:13Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
=cut
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %port_of :ATTR(:name<port> :default<[]>);
+7 -3
View File
@@ -2,7 +2,7 @@ package SOAP::WSDL::Transport::HTTP;
use strict; use warnings;
use base qw(LWP::UserAgent);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
# create methods normally inherited from SOAP::Client
SUBFACTORY: {
@@ -16,6 +16,10 @@ SUBFACTORY: {
}
}
sub _agent {
return qq[SOAP::WSDL $VERSION];
}
sub send_receive {
my ($self, %parameters) = @_;
my ($envelope, $soap_action, $endpoint, $encoding, $content_type) =
@@ -91,9 +95,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 744 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: HTTP.pm 744 2008-10-15 16:58:45Z kutterma $
$Id: HTTP.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Transport/HTTP.pm $
=cut
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'basic';
use SOAP::WSDL::Factory::Transport;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
# register on loading
SOAP::WSDL::Factory::Transport->register( http => __PACKAGE__ );
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use SOAP::WSDL::Factory::Transport;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
SOAP::WSDL::Factory::Transport->register( http => __PACKAGE__ );
SOAP::WSDL::Factory::Transport->register( https => __PACKAGE__ );
+1 -1
View File
@@ -2,7 +2,7 @@ package SOAP::WSDL::TypeLookup;
use strict;
use warnings;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %TYPE_FROM = (
# wsdl:
+1 -1
View File
@@ -5,7 +5,7 @@ use SOAP::WSDL::XSD::Schema::Builtin;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %schema_of :ATTR(:name<schema> :default<[]>);
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<enumeration value="">
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<attribute
# default = string
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<attributeGroup
# id = ID
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
# only used in SOAP::WSDL - will be obsolete once SOAP::WSDL uses the
# generative approach, too
+8 -3
View File
@@ -5,7 +5,7 @@ use Class::Std::Fast::Storable;
use Scalar::Util qw(blessed);
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.06');
use version; our $VERSION = qv('2.00.07');
# id provided by Base
# name provided by Base
@@ -87,13 +87,11 @@ sub serialize {
my $variety = $self->get_variety();
my $xml = ($opt->{ readable }) ? $opt->{ indent } : q{}; # add indentation
if ( $opt->{ qualify } ) {
$opt->{ attributes } = [ ' xmlns="' . $self->get_targetNamespace .'"' ];
delete $opt->{ qualify };
}
$xml .= join q{ } , "<$name" , @{ $opt->{ attributes } };
delete $opt->{ attributes }; # don't propagate...
@@ -108,6 +106,13 @@ sub serialize {
}
$xml .= '>';
$xml .= "\n" if ( $opt->{ readable } ); # add linebreak
if ($self->schema) {
if ($self->schema()->get_elementFormDefault() ne "qualified") {
push @{$opt->{ attributes } }, q{xmlns=""}
if ($self->get_targetNamespace() ne "");
}
}
if ( ($variety eq "sequence") or ($variety eq "all") ) {
$opt->{ indent } .= "\t";
for my $element (@{ $self->get_element() }) {
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
# id provided by Base
# name provided by Base
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<enumeration value="">
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<pattern value="">
# id provided by Base
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<xs:group name="myModelGroup">
# <xs:sequence>
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<minExclusive value="">
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<minExclusive value="">
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<minExclusive value="">
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<maxLength value="">
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<minExclusive value="">
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<minExclusive value="">
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<minExclusive value="">
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<pattern value="">
+6 -3
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
# child elements
my %attributeGroup_of :ATTR(:name<attributeGroup> :default<[]>);
@@ -14,9 +14,9 @@ my %group_of :ATTR(:name<group> :default<[]>);
my %type_of :ATTR(:name<type> :default<[]>);
# attributes
my %attributeFormDefault_of :ATTR(:name<attributeFormDefault> :default<()>);
my %attributeFormDefault_of :ATTR(:name<attributeFormDefault> :default<unqualified>);
my %blockDefault_of :ATTR(:name<blockDefault> :default<()>);
my %elementFormDefault_of :ATTR(:name<elementFormDefault> :default<()>);
my %elementFormDefault_of :ATTR(:name<elementFormDefault> :default<unqualified>);
my %finalDefault_of :ATTR(:name<finalDefault> :default<()>);
my %version_of :ATTR(:name<version> :default<()>);
@@ -58,6 +58,8 @@ sub find_element {
my ($self, @args) = @_;
my @found_at = grep {
$_->get_targetNamespace() eq $args[0] &&
# warn $_->get_name() . " default NS:" . $_->get_xmlns()->{'#default'} . "\n";
# $_->get_xmlns()->{'#default'} eq $args[0] &&
$_->get_name() eq $args[1]
}
@{ $element_of{ ident $self } };
@@ -68,6 +70,7 @@ sub find_type {
my ($self, @args) = @_;
my @found_at = grep {
$_->get_targetNamespace() eq $args[0] &&
# $_->get_xmlns()->{'#default'} eq $args[0] &&
$_->get_name() eq $args[1]
}
@{ $type_of{ ident $self } };
+6 -3
View File
@@ -6,7 +6,7 @@ use SOAP::WSDL::XSD::Schema;
use SOAP::WSDL::XSD::Builtin;
use base qw(SOAP::WSDL::XSD::Schema);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
# all builtin types - add validation (e.g. content restrictions) later...
my %BUILTINS = (
@@ -65,6 +65,9 @@ sub START {
$self->push_type( SOAP::WSDL::XSD::Builtin->new({
name => $name,
targetNamespace => 'http://www.w3.org/2001/XMLSchema',
xmlns => {
'#default' => 'http://www.w3.org/2001/XMLSchema',
}
} )
);
}
@@ -100,9 +103,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: Builtin.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: Builtin.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/XSD/Schema/Builtin.pm $
=cut
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %length_of :ATTR(:name<length> :default<[]>);
my %minLength_of :ATTR(:name<minLength> :default<[]>);
+2 -2
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<totalDigits value="">
@@ -14,5 +14,5 @@ use version; our $VERSION = qv('2.00.05');
# may be defined as atomic simpleType
my %value_of :ATTR(:name<value> :default<()>);
my %fixed_of :ATTR(:name<fixed> :default<()>);
1;
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use base qw(SOAP::WSDL::XSD::Typelib::Element);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
sub start_tag {
# my ($self, $opt, $value) = @_;
+1 -1
View File
@@ -3,7 +3,7 @@ use strict;
use warnings;
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
sub serialize {
# we work on @_ for performance.
+1 -1
View File
@@ -3,7 +3,7 @@ use strict;
use warnings;
use Class::Std::Fast::Storable;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
use SOAP::WSDL::XSD::Typelib::Builtin::anyType;
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
+21 -6
View File
@@ -3,7 +3,7 @@ use strict;
use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
sub get_xmlns { 'http://www.w3.org/2001/XMLSchema' };
@@ -20,13 +20,28 @@ sub start_tag {
# return attribute start if it's an attribute
return qq{ $_[1]->{name}="} if $_[1]->{ attr };
# return with xsi:nil="true" if it is nil
return join q{} , "<$_[1]->{ name }" , $_[0]->serialize_attr() , q{ xsi:nil="true"/>}
if ($_[1]->{ nil });
return join
q{} ,
"<$_[1]->{ name }" ,
(defined $_[1]->{ xmlns }) ? qq{ xmlns="$_[1]->{ xmlns }"} : (),
$_[0]->serialize_attr($_[1]) ,
q{ xsi:nil="true"/>}
if ($_[1]->{ nil });
# return "empty" start tag if it's empty
return join q{}, "<$_[1]->{ name }" , $_[0]->serialize_attr() , '/>'
return join
q{},
"<$_[1]->{ name }",
(defined $_[1]->{ xmlns }) ? qq{ xmlns="$_[1]->{ xmlns }"} : (),
$_[0]->serialize_attr($_[1]) ,
'/>'
if ($_[1]->{ empty });
# return XML element start tag
return join q{}, "<$_[1]->{ name }" , $_[0]->serialize_attr() , '>';
return join
q{},
"<$_[1]->{ name }",
(defined $_[1]->{ xmlns }) ? qq{ xmlns="$_[1]->{ xmlns }"} : (),
, $_[0]->serialize_attr($_[1])
, '>';
}
# start_tag creates a XML end tag either for a XML element or a attribute.
@@ -42,7 +57,7 @@ sub end_tag {
return "</$_[1]->{name}>";
};
sub serialize_attr { () };
sub serialize_attr {};
# sub serialize { q{} };
+1 -1
View File
@@ -3,7 +3,7 @@ use strict;
use warnings;
use Class::Std::Fast::Storable constructor => 'none', cache => 1;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
+15 -7
View File
@@ -37,13 +37,21 @@ sub set_value {
@time_from = map { (! defined $_) ? 0 : $_ } @time_from;
# use Data::Dumper;
# warn Dumper \@time_from, sprintf('%+03d%02d', $time_from[6] / 3600, $time_from[6] % 60 );
my $time_str = defined $time_zone_seconds
? strftime( '%Y-%m-%d', @time_from )
. sprintf('%+03d%02d', int($time_from[6] / 3600), int ( ($time_from[6] % 3600) / 60 ) )
: do {
strftime( '%Y-%m-%d%z', @time_from );
};
substr $time_str, -2, 0, ':';
my $time_str;
if (defined $time_zone_seconds) {
$time_str = sprintf('%04d-%02d-%02d%+03d:%02d', $time_from[5]+1900, $time_from[4]+1, $time_from[3], int($time_from[6] / 3600), int($time_from[6] % 3600) / 60);
}
else {
$time_str = strftime( '%Y-%m-%d%z', @time_from );
substr $time_str, -2, 0, ':';
}
# ? strftime( '%Y-%m-%d', @time_from )
# . sprintf('%+03d%02d', int($time_from[6] / 3600), int ( ($time_from[6] % 3600) / 60 ) )
# : do {
# strftime( '%Y-%m-%d%z', @time_from );
# };
# substr $time_str, -2, 0, ':';
$_[0]->SUPER::set_value($time_str);
}
}
+30 -9
View File
@@ -3,29 +3,50 @@ use strict;
use warnings;
use Date::Parse;
use Date::Format;
use Time::Zone;
use Class::Std::Fast::Storable constructor => 'none', cache => 1;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
sub set_value {
# use set_value from base class if we have a XML-DateTime format
#2037-12-31T00:00:00.0000000+01:00
return $_[0]->SUPER::set_value($_[1]) if not $_[1];
return $_[0]->SUPER::set_value($_[1]) if (
return $_[0]->SUPER::set_value( $_[1] ) if not defined $_[1];
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
);
);
# strptime sets empty values to undef - and strftime doesn't like that...
my @time_from = map { ! defined $_ ? 0 : $_ } strptime($_[1]);
my @time_from = strptime( $_[1] );
undef $time_from[-1];
die "Illegal date" if not defined $time_from[5];
my $time_str = strftime( '%Y-%m-%dT%H:%M:%S%z', @time_from );
# strftime doesn't like undefs
@time_from = map { !defined $_ ? 0 : $_ } @time_from;
my $time_str;
if ( $time_from[-1] ) {
$time_str = sprintf(
'%04d-%02d-%02dT%02d:%02d:%02d.0000000%+03d:%02d',
$time_from[5] + 1900,
$time_from[4] + 1,
$time_from[3],
$time_from[2],
$time_from[1],
$time_from[0],
int( $time_from[6] / 3600 ),
int( $time_from[6] % 3600 ) / 60
);
}
else {
$time_str = strftime( '%Y-%m-%dT%H:%M:%S%z', @time_from );
substr $time_str, -2, 0, ':';
}
# insert : in timezone info
substr $time_str, -2, 0, ':';
$_[0]->SUPER::set_value($time_str);
}
+1 -1
View File
@@ -6,7 +6,7 @@ use Date::Format;
use Class::Std::Fast::Storable constructor => 'none', cache => 1;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
sub set_value {
# use set_value from base class if we have a XML-Time format
+163 -39
View File
@@ -10,8 +10,12 @@ require Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
# remove in 2.1
our $AS_HASH_REF_WITHOUT_ATTRIBUTES = 0;
my %ELEMENT_FORM_QUALIFIED_OF; # denotes whether elements are qualified
my %ELEMENTS_FROM; # order of elements in a class
my %ATTRIBUTES_OF; # references to value hashes
my %CLASSES_OF; # class names of elements in a class
@@ -63,18 +67,20 @@ sub AUTOMETHOD {
}
sub attr {
my $self = shift;
my $class = $self->__get_attr_class()
# We're working on @_ for speed.
# Normally, the first line would look like this:
# my $self = shift;
my $class = $_[0]->__get_attr_class()
or return;
# disable strictness - in perl 5.10 %{ "$foo\::_bar" } triggers a
# symbolic reference error with strictness enabled
if (@_) {
# setter
return $xml_attr_of{ $$self } = $class->new(@_);
# pass arguments to attributes constructor (if any);
# lets attr($foo) work as setter
if ($_[1]) {
return $xml_attr_of{ ${$_[0]} } = $class->new($_[1]);
}
return $xml_attr_of{ $$self } if exists $xml_attr_of{ $$self };
return $xml_attr_of{ $$self } = $class->new();
return $xml_attr_of{ ${$_[0]} } if exists $xml_attr_of{ ${$_[0]} };
return $xml_attr_of{ ${$_[0]} } = $class->new();
}
sub serialize_attr {
@@ -86,29 +92,46 @@ sub serialize_attr {
sub as_bool :BOOLIFY { 1 }
sub as_hash_ref {
my $self = shift;
my $attributes_ref = $ATTRIBUTES_OF{ ref $self };
my $ident = ${ $self };
# we're working on $_[0] for speed (as always...)
#
# Normally the first line would read:
# my ($self, $ignore_attributes) = @_;
#
my $attributes_ref = $ATTRIBUTES_OF{ ref $_[0] };
my $hash_of_ref = {};
foreach my $attribute (keys %{ $attributes_ref }) {
next if not defined $attributes_ref->{ $attribute }->{ $ident };
my $value = $attributes_ref->{ $attribute }->{ $ident };
if ($_[0]->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')) {
$hash_of_ref->{ value } = $_[0]->get_value();
}
else {
foreach my $attribute (keys %{ $attributes_ref }) {
next if not defined $attributes_ref->{ $attribute }->{ ${ $_[0] } };
my $value = $attributes_ref->{ $attribute }->{ ${ $_[0] } };
$hash_of_ref->{ $attribute } = blessed $value
? $value->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
? $value->get_value()
: $value->as_hash_ref()
: ref $value eq 'ARRAY'
? [
map {
$_->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
? $_->get_value()
: $_->as_hash_ref()
} @{ $value }
]
: die "Neither blessed obj nor list ref";
};
$hash_of_ref->{ $attribute } = blessed $value
? $value->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
? $value->get_value()
: $value->as_hash_ref($_[1])
: ref $value eq 'ARRAY'
? [
map {
$_->isa('SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType')
? $_->get_value()
: $_->as_hash_ref($_[1])
} @{ $value }
]
: die "Neither blessed obj nor list ref";
};
}
# $AS_HASH_REF_WITHOUT_ATTRIBUTES is deprecated by NOW and will be removed
# in 2.1
return $hash_of_ref if $_[1] or $AS_HASH_REF_WITHOUT_ATTRIBUTES;
if (exists $xml_attr_of{ ${ $_[0] } }) {
$hash_of_ref->{ xmlattr } = $xml_attr_of{ ${ $_[0] } }->as_hash_ref();
}
return $hash_of_ref;
}
@@ -237,13 +260,30 @@ sub _factory {
# TODO Could be moved as normal method into base class, e.g. here.
# Hmm. let's see...
*{ "$class\::new" } = sub {
my $self = bless \(my $o = Class::Std::Fast::ID()), $_[0];
# We're working on @_ for speed.
# Normally, the first line would look like this:
# my ($self, $ident, $args_of) = @_;
# my ($class, $args_of) = @_;
#
# The hanging side comment show you what would be there, then.
# Read as:
# my $self = bless \(my $o = Class::Std::Fast::ID()), $class;
my $self = bless \(my $o = Class::Std::Fast::ID()), $_[0];
# Set attributes if passed via { xmlattr => \%attributes }
#
# This works just because
# a) xmlattr cannot be used as valid XML identifier (it starts
# with "xml" which is banned by the XML schema standard)
# b) $o->attr($attribute_ref) passes $attribute_ref to the
# attribute object's constructor
# c) we are in the object's constructor here (which means that)
# no attributes object can have been legally constructed
# before.
if (exists $_[1]->{xmlattr}) { # $args_of->{xmlattr}
$self->attr(delete $_[1]->{xmlattr});
}
# iterate over keys of arguments
# and call set appropriate field in clase
map { ($ATTRIBUTES_OF{ $class }->{ $_ })
@@ -287,13 +327,14 @@ sub _factory {
# do we have some content
if (defined $element) {
$element = [ $element ] if not ref $element eq 'ARRAY';
# from 2.00.02 on $NAMES_OF is filled - use || $_; for
# from 2.00.07 on $NAMES_OF is filled - use || $_; for
# backward compatibility
my $name = $NAMES_OF{$class}->{$_} || $_;
my $target_namespace = $_[0]->get_xmlns();
map {
# serialize element elements with their own serializer
# but name them like they're named here.
# TODO: check. element ref="" has a name???
if ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) {
# serialize elements of different namespaces
# with namespace declaration
@@ -306,9 +347,31 @@ sub _factory {
else {
# TODO: check whether we have to handle
# types from different namespaces special, too
join q{}, $_->start_tag({ name => $name , %{ $option_ref } })
, $_->serialize($option_ref)
, $_->end_tag({ name => $name , %{ $option_ref } });
if (!defined $ELEMENT_FORM_QUALIFIED_OF{ $class }
or $ELEMENT_FORM_QUALIFIED_OF{ $class }
) {
join q{}, $_->start_tag({ name => $name , %{ $option_ref } })
, $_->serialize($option_ref)
, $_->end_tag({ name => $name , %{ $option_ref } });
}
else {
# remove xmlns option if there is one
my $set_xmlns = delete $option_ref->{xmlns}
if (exists $option_ref->{xmlns});
# serialize start tag with xmlns="" if out parent
# did not do that
join q{}, $_->start_tag({
name => $name,
%{ $option_ref },
(! defined $set_xmlns)
? (xmlns => "")
: ()
})
# add xmlns = "" to child serialize options
# to avoid putting xmlns="" everywhere
, $_->serialize({ %{$option_ref}, xmlns => "" })
, $_->end_tag({ name => $name , %{ $option_ref } });
}
}
} @{ $element }
}
@@ -325,7 +388,12 @@ sub _factory {
};
}
# just a fallback
sub _set_element_form_qualified {
$ELEMENT_FORM_QUALIFIED_OF{ $_[0] } = $_[1];
}
# Just as fallback: return no attribute set class as default.
# Subclasses may override
sub __get_attr_class {};
# hidden complex serializer
@@ -415,6 +483,11 @@ Data passed to new must comply to the object's structure or new() will
complain. Objects passed must be of the expected type, or new() will
complain, too.
The special key B<xmlattr> may be used to pass XML attributes. This key is
chosen, because "xmlattr" cannot legally be used as XML name (it starts with
"xml"). Passing a hash ref structure as value to "xmlattr" has the same
effect as passing the same structure to a call to C<$obj->attr()>
Examples:
my $obj = MyClass->new({ MyName => $value });
@@ -435,6 +508,16 @@ Examples:
MyThirdName => [ $object1, $object2 ],
});
my $obj = MyClass->new({
xmlattr => { name => 'foo' },
MyName => {
DeepName => $value,
},
MySecondName => $value,
});
In case your building on Class::Std, please note the following limitations:
The new() method from Class::Std will be overridden, so you should not rely
on it's behaviour.
@@ -466,10 +549,51 @@ To delete a property, say:
$obj->set_FOO();
=head2 attr
Returns / sets the attribute object associated with the object. XML Attributes
are modeled as attribute objects - their classes are usually private (i.e.
part of the associated class' file, not in a separate file named after the
attribute class).
Note that attribute support is still experimental.
=head2 as_bool
Returns the boolean value of the complexType (always true).
=head2 as_hash_ref
Returns a hash ref representation of the complexType object
Attributes are included under the special key "xmlattr" (if any).
The inclusion of attributes can be suppressed by calling
$obj->as_has_ref(1);
or even globally by setting
$SOAP::WSDL::XSD::Typelib::ComplexType::AS_HASH_REF_WITHOUT_ATTRIBUTES = 1;
Note that using the $AS_HASH_REF_WITHOUT_ATTRIBUTES global variable is
strongly discouraged. Use of this variable is deprecated and will be removed
as of version 2.1
as_hash_ref can be used for deep cloning. The following statement creates
a deep clone of a SOAP::WSDL::ComplexType-based object
my $clone = ref($obj)->new($obj->as_hash_ref());
=head2 serialize_attr
Serialize a complexType's attributes
=head2 serialize
Serialize a ComplexType object to XML. Exported via symbol table into derived
classes.
=head1 Bugs and limitations
=over
@@ -509,9 +633,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 731 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: ComplexType.pm 731 2008-07-22 21:33:07Z kutterma $
$Id: ComplexType.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm $
=cut
+3 -3
View File
@@ -2,7 +2,7 @@ package SOAP::WSDL::XSD::Typelib::Element;
use strict; use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
my %NAME;
my %NILLABLE;
@@ -177,9 +177,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: Element.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: Element.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/XSD/Typelib/Element.pm $
=cut
+4 -4
View File
@@ -2,14 +2,14 @@ package SOAP::WSDL::XSD::Typelib::SimpleType;
use strict; use warnings;
use SOAP::WSDL::XSD::Typelib::Builtin;
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
package SOAP::WSDL::XSD::Typelib::SimpleType::restriction;
use strict;
use SOAP::WSDL::XSD::Typelib::Builtin;
use base qw(SOAP::WSDL::XSD::Typelib::SimpleType);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
1;
__END__
@@ -132,9 +132,9 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 728 $
$Rev: 795 $
$LastChangedBy: kutterma $
$Id: SimpleType.pm 728 2008-07-13 19:28:50Z kutterma $
$Id: SimpleType.pm 795 2009-02-21 00:04:29Z kutterma $
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/XSD/Typelib/SimpleType.pm $
=cut
+1 -1
View File
@@ -4,7 +4,7 @@ use warnings;
use Class::Std::Fast::Storable constructor => 'none';
use base qw(SOAP::WSDL::Base);
use version; our $VERSION = qv('2.00.05');
use version; our $VERSION = qv('2.00.07');
#<pattern value="">