import SOAP-WSDL 2.00.07 from CPAN
git-cpan-module: SOAP-WSDL git-cpan-version: 2.00.07 git-cpan-authorid: MKUTTER git-cpan-file: authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00.07.tar.gz
This commit is contained in:
Martin Kutter
committed by
Michael G. Schwern
Michael G. Schwern
parent
3de318be40
commit
bfc3247583
@@ -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