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:
committed by
Michael G. Schwern
parent
3de318be40
commit
bfc3247583
+4
-3
@@ -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
|
||||
|
||||
@@ -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__
|
||||
|
||||
@@ -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<()>);
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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) = @_;
|
||||
|
||||
@@ -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) = @_;
|
||||
|
||||
@@ -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 $
|
||||
|
||||
@@ -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
@@ -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 $
|
||||
|
||||
@@ -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',
|
||||
|
||||
@@ -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',
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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) )
|
||||
}
|
||||
|
||||
@@ -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<{}>);
|
||||
|
||||
@@ -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<{}>);
|
||||
|
||||
@@ -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; -%]
|
||||
|
||||
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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 $
|
||||
|
||||
|
||||
@@ -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;
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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<[]>);
|
||||
|
||||
|
||||
@@ -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<[]>);
|
||||
|
||||
@@ -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<[]>);
|
||||
|
||||
@@ -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<()>);
|
||||
|
||||
@@ -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<()>);
|
||||
|
||||
@@ -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<()>);
|
||||
|
||||
|
||||
@@ -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;
|
||||
@@ -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{}>);
|
||||
|
||||
@@ -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{}>);
|
||||
|
||||
@@ -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;
|
||||
@@ -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,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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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",
|
||||
|
||||
@@ -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...
|
||||
|
||||
@@ -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 = ();
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -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<[]>);
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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__ );
|
||||
|
||||
@@ -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__ );
|
||||
|
||||
@@ -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:
|
||||
|
||||
@@ -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<[]>);
|
||||
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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() }) {
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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>
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
@@ -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,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
|
||||
|
||||
@@ -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<[]>);
|
||||
|
||||
@@ -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;
|
||||
@@ -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) = @_;
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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{} };
|
||||
|
||||
|
||||
@@ -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);
|
||||
|
||||
|
||||
@@ -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);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -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);
|
||||
}
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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="">
|
||||
|
||||
|
||||
Reference in New Issue
Block a user