dinislage/SOAP-WSDL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

import SOAP-WSDL 2.00_24 from CPAN

Browse Source 
git-cpan-module:   SOAP-WSDL
git-cpan-version:  2.00_24
git-cpan-authorid: MKUTTER
git-cpan-file:     authors/id/M/MK/MKUTTER/SOAP-WSDL-2.00_24.tar.gz
This commit is contained in:
Martin Kutter
2009-12-12 19:48:10 -08:00
committed by Michael G. Schwern
parent b955c5ad79
commit 84b53d9261
169 changed files with 3995 additions and 3676 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lib/SOAP/WSDL/XSD/Builtin.pm
+2 -2
View File
@@ -9,7 +9,7 @@ sub serialize {
my $xml;
$opt->{ indent } ||= "";
$opt->{ attributes } ||= [];
$xml .= $opt->{ indent } if ($opt->{ readable });
$xml .= '<' . join ' ', $name, @{ $opt->{ attributes } };
if ( $opt->{ autotype }) {
@@ -20,7 +20,7 @@ sub serialize {
. $self->get_name() . '"' if ($self->get_name() );
}
if (defined $value) {
if (defined $value) {
$xml .= '>';
$xml .= "$value";
$xml .= '</' . $name . '>' ;
lib/SOAP/WSDL/XSD/ComplexType.pm
+16 -17
View File
@@ -53,9 +53,9 @@ sub set_extension {
}
sub init {
my $self = shift;
my @args = @_;
$self->SUPER::init( @args );
my $self = shift;
my @args = @_;
$self->SUPER::init( @args );
}
sub serialize {
@@ -70,12 +70,12 @@ sub serialize {
if ( $opt->{ qualify } ) {
$opt->{ attributes } = [ ' xmlns="' . $self->get_targetNamespace .'"' ];
delete $opt->{ qualify };
}
}
$xml .= join q{ } , "<$name" , @{ $opt->{ attributes } };
delete $opt->{ attributes }; # don't propagate...
if ( $opt->{ autotype }) {
my $ns = $self->get_targetNamespace();
my $prefix = $opt->{ namespace }->{ $ns }
@@ -84,32 +84,31 @@ sub serialize {
if ($self->get_name() );
}
$xml .= '>';
$xml .= "\n" if ( $opt->{ readable } ); # add linebreak
if ( ($flavor eq "sequence") or ($flavor eq "all") )
{
$xml .= "\n" if ( $opt->{ readable } ); # add linebreak
if ( ($flavor eq "sequence") or ($flavor eq "all") ) {
$opt->{ indent } .= "\t";
for my $element (@{ $self->get_element() }) {
# might be list - listify
$value = [ $value ] if not ref $value eq 'ARRAY';
for my $single_value (@{ $value }) {
my $element_value;
if (blessed $single_value) {
my $element_value;
if (blessed $single_value) {
my $method = 'get_' . $element->get_name();
$element_value = $single_value->$method();
$element_value = $single_value->$method();
}
else {
else {
$element_value = $single_value->{ $element->get_name() };
}
$element_value = [ $element_value ]
$element_value = [ $element_value ]
if not ref $element_value eq 'ARRAY';
$xml .= join q{}
, map { $element->serialize( undef, $_, $opt ) }
@{ $element_value };
$xml .= join q{}
, map { $element->serialize( undef, $_, $opt ) }
@{ $element_value };
}
}
$opt->{ indent } =~s/\t$//;
$opt->{ indent } =~s/\t$//;
}
else {
die "sorry, we just handle all and sequence types yet...";
lib/SOAP/WSDL/XSD/Element.pm
+4 -5
View File
@@ -57,7 +57,7 @@ sub serialize {
if ( $opt->{ qualify } ) {
$opt->{ attributes } = [ ' xmlns="' . $self->get_targetNamespace .'"' ];
}
}
# set default and fixed - fixed overrides everything,
@@ -93,9 +93,9 @@ sub serialize {
# lookup type
my ($prefix, $localname) = split /:/ , $self->get_type();
my $ns = $ns_map{ $prefix };
$type = $typelib->find_type(
$ns, $localname
);
$type = $typelib->find_type(
$ns, $localname
);
# safety check
die "no type for $prefix:$localname $ns_map{$prefix}" if (not $type);
@@ -105,4 +105,3 @@ sub serialize {
1;
lib/SOAP/WSDL/XSD/Schema/Builtin.pm
+75 -40
View File
@@ -8,55 +8,90 @@ use base qw(SOAP::WSDL::XSD::Schema);
# all builtin types - add validation (e.g. content restrictions) later...
my %BUILTINS = (
'string' => {},
'boolean' => {},
'decimal' => {},
'dateTime' => {},
'float' => {},
'double' => {},
'duration' => {},
'time' => {},
'date' => {},
'gYearMonth' => {},
'gYear' => {},
'gMonthDay' => {},
'gDay' => {},
'gMonth' => {},
'hexBinary' => {},
'base64Binary' => {},
'anyURI' => {},
'QName' => {},
'NOTATION' => {},
'integer' => {},
'nonPositiveInteger' => {},
'nonNegativeInteger' => {},
'positiveInteger' => {},
'negativeInteger' => {},
'string' => {},
'boolean' => {},
'decimal' => {},
'dateTime' => {},
'float' => {},
'double' => {},
'duration' => {},
'time' => {},
'date' => {},
'gYearMonth' => {},
'gYear' => {},
'gMonthDay' => {},
'gDay' => {},
'gMonth' => {},
'hexBinary' => {},
'base64Binary' => {},
'anyURI' => {},
'QName' => {},
'NOTATION' => {},
'integer' => {},
'nonPositiveInteger' => {},
'nonNegativeInteger' => {},
'positiveInteger' => {},
'negativeInteger' => {},
'long' => {},
'int' => {},
'unsignedInt' => {},
'short' => {},
'unsignedShort' => {},
'byte' => {},
'unsignedByte' => {},
'normalizedString' => {},
'token' => {},
'NMTOKEN' => {},
'int' => {},
'unsignedInt' => {},
'short' => {},
'unsignedShort' => {},
'byte' => {},
'unsignedByte' => {},
'normalizedString' => {},
'token' => {},
'NMTOKEN' => {},
);
sub START {
my $self = shift;
my @args = @_;
my $self = shift;
my @args = @_;
while (my ($name, $value) = each %BUILTINS )
{
$self->push_type( SOAP::WSDL::XSD::Builtin->new({
while (my ($name, $value) = each %BUILTINS )
{
$self->push_type( SOAP::WSDL::XSD::Builtin->new({
name => $name,
targetNamespace => 'http://www.w3.org/2001/XMLSchema',
} )
);
}
);
}
return $self;
}
1;
=pod
=head1 NAME
SOAP:WSDL::XSD::Schema::Builtin - Provides builtin XML Schema datatypes for parsing WSDL
=head1 DESCRIPTION
Used internally by SOAP::WSDL's WSDL parser.
See <SOAP::WSDL::XSD::Typelib::Builtin|SOAP::WSDL::XSD::Typelib::Builtin> for
SOAP::WSDL::XSD's builtin XML Schema datatypes.
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2007 Martin Kutter. All rights reserved.
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: Builtin.pm 391 2007-11-17 21:56:13Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/XSD/Schema/Builtin.pm $
=cut
lib/SOAP/WSDL/XSD/SimpleType.pm
+5 -5
View File
@@ -61,10 +61,10 @@ sub serialize {
my $value = shift;
my $opt = shift;
my $ident = ident $self;
$opt->{ attributes } ||= [];
$opt->{ indent } ||= q{};
return $self->_serialize_single($name, $value , $opt)
if ( $flavor_of{ $ident } eq 'restriction'
or $flavor_of{ $ident } eq 'union'
@@ -81,7 +81,7 @@ sub serialize {
sub _serialize_single {
my ($self, $name, $value, $opt) = @_;
my $xml = '';
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
$xml .= '<' . join ' ', $name, @{ $opt->{ attributes } };
if ( $opt->{ autotype }) {
my $ns = $self->get_targetNamespace();
@@ -89,10 +89,10 @@ sub _serialize_single {
|| die 'No prefix found for namespace '. $ns;
$xml .= ' type="' . $prefix . ':' . $self->get_name() .'"';
}
# nillabel ?
return $xml .'/>' if not defined $value;
$xml .= join q{}, '>' , $value , '</' , $name , '>';
$xml .= "\n" if ($opt->{ readable });
return $xml;
lib/SOAP/WSDL/XSD/Typelib/Builtin.pm
+58 -26
View File
@@ -64,19 +64,21 @@ SOAP::WSDL::XSD::Typelib::Builtin - Built-in XML Schema datatypes
=head1 DESCRIPTION
This module implements all builtin Types from the XML schema specification.
The SOAP::WSDL::XSD::Typelib::Builtin hierarchy implements all builtin types
from the XML schema specification.
Objects of a class may be filled with values and serialize correctly.
All XML schema derived types inherit from
SOAP::WSDL::XSD::Typelib::Builtin::anyType.
These basic type classes are most useful when used as element or simpleType
base classes.
The datatypes classes themselves are split up into
SOAP::WSDL::XSD::Typelib::Builtin::* modules.
Using SOAP::WSDL::XSD::Typelib::Builtin uses all of the builtin datatype
Using SOAP::WSDL::XSD::Typelib::Builtin uses all of the builtin datatype
classes.
All builtin types feature common behaviour described below in
L</OVERLOADED OPERATORS>
=head1 EXAMPLES
my $bool = SOAP::WSDL::XSD::Typelib::Builtin::bool->new({ value => 0} );
@@ -88,7 +90,7 @@ classes.
package MySimpleType;
use SOAP::WSDL::XSD::Typelib::Builtin;
use SOAP::WSDL::XSD::Typelib::SimpleType;
use base qw(SOAP::WSDL::XSD::Typelib::SimpleType
SOAP::WSDL::XSD::Typelib::Builtin::list
SOAP::WSDL::XSD::Typelib::Builtin::string
@@ -177,6 +179,36 @@ The boolean class returns 0 or 1 in numeric context.
decimal, float and double (and derived classes) return their value in
numeric context.
=item * arrayification (@{})
When accessed as a list ref, objects of all classes return a list ref with
the object itself as single element.
This is most useful for writing loops without additional conversions,
especially in mini-languages found in templating systems or the like, which
may not natively support converting to list refs.
Instead of writing something like
my $value = $complexType->get_ELEMENT;
$value = ref $value eq 'ARRAY' ? $value : [ $value ];
for (@{ $value }) { ... }
you can just write
for (@{ $complexType->get_ELEMENT }) {...}
Note that complexTypes with undef elements still return undef when accessing
an undefined element, so when an element may be empty you still have to write
something like:
my $value = $complexType->get_ELEMENT();
if (defined $value) {
for (@{ $value }) {
...
}
}
=back
=head1 Subclasses
@@ -205,14 +237,14 @@ Returns true/false in boolean context.
Returns 1 / 0 in numeric context.
boolean objects have a special method for deleteing their value, because
boolean objects have a special method for deleteing their value, because
calling C<setl_value(undef)> results in the value being set to false.
$obj->delete_value();
=head2 SOAP::WSDL::XSD::Typelib::Builtin::byte
=head2 SOAP::WSDL::XSD::Typelib::Builtin::byte
byte integer objects.
byte integer objects.
=head2 SOAP::WSDL::XSD::Typelib::Builtin::date
@@ -222,12 +254,12 @@ date values are automatically converted into XML date strings during setting:
The time zone is set to the local time zone if not included.
All input variants supported by Date::Parse are supported. You may even pass
in dateTime strings - the time part will be ignored. Note that
All input variants supported by Date::Parse are supported. You may even pass
in dateTime strings - the time part will be ignored. Note that
set_value is around 100 times slower when setting non-XML-time strings
When setting dates before the beginning of the epoch (negative UNIX timestamp),
you should use the XML date string format for setting dates. The behaviour of
When setting dates before the beginning of the epoch (negative UNIX timestamp),
you should use the XML date string format for setting dates. The behaviour of
Date::Parse for dates before the epoch is system dependent.
=head2 SOAP::WSDL::XSD::Typelib::Builtin::dateTime
@@ -236,19 +268,19 @@ dateTime values are automatically converted into XML dateTime strings during set
YYYY-MM-DDThh:mm:ss.nnnnnnn+zz:zz
The fraction of seconds (nnnnnnn) part is optional. Fractions of seconds may
The fraction of seconds (nnnnnnn) part is optional. Fractions of seconds may
be given with arbitrary precision
The fraction of seconds part is excluded in converted values, as it would always be 0.
All input variants supported by Date::Parse are supported. Note that
All input variants supported by Date::Parse are supported. Note that
set_value is around 100 times slower when setting non-XML-time strings
=head2 SOAP::WSDL::XSD::Typelib::Builtin::decimal
decimal is the base of all non-float numbers
=head2 SOAP::WSDL::XSD::Typelib::Builtin::double
=head2 SOAP::WSDL::XSD::Typelib::Builtin::double
=head2 SOAP::WSDL::XSD::Typelib::Builtin::duration
@@ -300,8 +332,8 @@ Derived by SOAP::WSDL::XSD::Typelib::Builtin::list.
=head2 SOAP::WSDL::XSD::Typelib::Builtin::normalizedString
Tab, newline and carriage return characters are replaced by whitespace in
set_value.
Tab, newline and carriage return characters are replaced by whitespace in
set_value.
=head2 SOAP::WSDL::XSD::Typelib::Builtin::NOTATION
@@ -313,7 +345,7 @@ set_value.
=head2 SOAP::WSDL::XSD::Typelib::Builtin::string
String values are XML-escaped on serialization.
String values are XML-escaped on serialization.
The following characters are escaped: <, >, &
@@ -324,12 +356,12 @@ time values are automatically converted into XML time strings during setting:
hh:mm:ss.nnnnnnn+zz:zz
hh:mm:ss+zz:zz
The time zone is set to the local time zone if not included. The optional
The time zone is set to the local time zone if not included. The optional
nanoseconds part is not included in converted values, as it would always be 0.
All input variants supported by Date::Parse are supported. You may even pass
in dateTime strings - the date part will be ignored. Note that
set_value is around 100 times slower when setting non-XML-time strings
All input variants supported by Date::Parse are supported. You may even pass
in dateTime strings - the date part will be ignored. Note that
set_value is around 100 times slower when setting non-XML-time strings.
=head2 SOAP::WSDL::XSD::Typelib::Builtin::token
@@ -347,10 +379,10 @@ set_value is around 100 times slower when setting non-XML-time strings
=item * set_value
In contrast to Class::Std-generated mutators (setters), set_value does
In contrast to Class::Std-generated mutators (setters), set_value does
not return the last value.
This is for speed reasons: SOAP::WSDL never needs to know the last value
This is for speed reasons: SOAP::WSDL never needs to know the last value
when calling set_calue, but calls it over and over again...
=back
lib/SOAP/WSDL/XSD/Typelib/Builtin/ENTITY.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/NCName.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKEN.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/NMTOKENS.pm
+2 -2
View File
@@ -11,9 +11,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/NOTATION.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/Name.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/QName.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm
+3 -3
View File
@@ -16,10 +16,10 @@ sub set_value { $value_of{ ident $_[0] } = $_[1] }
# use $_[n] for speed.
# This is less readable, but notably faster.
#
# use postfix-if for speed. This is slightly faster, as it saves
# use postfix-if for speed. This is slightly faster, as it saves
# perl from creating a pad (variable context).
#
# The methods below may get called zillions of times, so
# The methods below may get called zillions of times, so
# every little statement matters...
sub serialize {
@@ -29,7 +29,7 @@ sub serialize {
return join q{}
, $_[0]->start_tag($_[1], $value_of{ $ident })
, $value_of{ $ident }
, $_[0]->end_tag($_[1]);
, $_[0]->end_tag($_[1]);
}
sub as_bool :BOOLIFY {
lib/SOAP/WSDL/XSD/Typelib/Builtin/anyType.pm
+6 -2
View File
@@ -6,14 +6,14 @@ use Class::Std::Storable;
sub get_xmlns { 'http://www.w3.org/2001/XMLSchema' };
# use $_[1] for performance
sub start_tag {
sub start_tag {
my $opt = $_[1] ||= {};
return '<' . $opt->{name} . ' >' if $opt->{ name };
return q{}
}
# use $_[1] for performance
sub end_tag {
sub end_tag {
return $_[1] && defined $_[1]->{ name }
? "</$_[1]->{name} >"
: q{};
@@ -25,6 +25,10 @@ sub serialize_qualified :STRINGIFY {
return $_[0]->serialize( { qualified => 1 } );
}
sub as_list :ARRAYIFY {
return [ $_[0] ];
}
Class::Std::initialize(); # make :STRINGIFY overloading serializable
1;
lib/SOAP/WSDL/XSD/Typelib/Builtin/anyURI.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/base64Binary.pm
+4 -4
View File
@@ -11,9 +11,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
@@ -24,8 +24,8 @@ BEGIN {
}
# XML Schema facets. We don't know how to implement them yet, but they're
# her, just in case you wanted to know.
# XML Schema facets. We don't know how to implement them yet, but they're
# here, just in case you wanted to know.
#my %length_of :ATTR(:name<length> :default<()>);
#my %minLength_of :ATTR(:name<minLength> :default<()>);
#my %maxLength_of :ATTR(:name<maxLength> :default<()>);
lib/SOAP/WSDL/XSD/Typelib/Builtin/boolean.pm
+2 -2
View File
@@ -15,9 +15,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/byte.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/date.pm
+13 -13
View File
@@ -13,9 +13,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
@@ -30,25 +30,25 @@ sub set_value {
# use set_value from base class if we have a XML-DateTime format
#2037-12-31+01:00
if (
$_[1] =~ m{ ^\d{4} \- \d{2} \- \d{2}
$_[1] =~ m{ ^\d{4} \- \d{2} \- \d{2}
(:? [\+\-] \d{2} \: \d{2} )$
}xms
}xms
) {
$_[0]->SUPER::set_value($_[1])
}
# converting a date is hard work: It needs a timezone, because
# 2007-12-30+12:00 and 2007-12-31-12:00 mean the same day - just in
# converting a date is hard work: It needs a timezone, because
# 2007-12-30+12:00 and 2007-12-31-12:00 mean the same day - just in
# different locations.
# strftime actually prints out the correct date, but always prints the
# strftime actually prints out the correct date, but always prints the
# local timezone with %z.
# So, if our timezone is not 0, we strftime it without timezone and
# So, if our timezone is not 0, we strftime it without timezone and
# append it by hand by the following formula:
# The timezone hours are the int (timesone seconds / 3600)
# The timezone minutes (if someone ever specifies something like that)
# are int( (seconds % 3600) / 60 )
# The timezone minutes (if someone ever specifies something like that)
# are int( (seconds % 3600) / 60 )
# say, int( (seconds modulo 3600) / 60 )
#
# If we have no timezone (meaning the timezone is
# If we have no timezone (meaning the timezone is
else {
# strptime sets empty values to undef - and strftime doesn't like that...
my @time_from = strptime($_[1]);
@@ -57,9 +57,9 @@ sub set_value {
# 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 )
? strftime( '%Y-%m-%d', @time_from )
. sprintf('%+03d%02d', int($time_from[6] / 3600), int ( ($time_from[6] % 3600) / 60 ) )
: do {
: do {
strftime( '%Y-%m-%d%z', @time_from );
};
substr $time_str, -2, 0, ':';
lib/SOAP/WSDL/XSD/Typelib/Builtin/dateTime.pm
+8 -8
View File
@@ -7,8 +7,8 @@ use Date::Parse;
use Date::Format;
# XML Schema facets. We don't know how to implement them yet, but they're
# her, just in case you wanted to know.
# XML Schema facets. We don't know how to implement them yet, but they're
# here, just in case you wanted to know.
#
#my %pattern_of :ATTR(:name<pattern> :default<()>);
#my %enumeration_of :ATTR(:name<enumeration> :default<()>);
@@ -26,9 +26,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
@@ -43,17 +43,17 @@ sub set_value {
#2037-12-31T00:00:00.0000000+01:00
return if not $_[1];
return $_[0]->SUPER::set_value($_[1]) if (
$_[1] =~ m{ ^\d{4} \- \d{2} \- \d{2}
$_[1] =~ m{ ^\d{4} \- \d{2} \- \d{2}
T \d{2} \: \d{2} \: \d{2} (:? \. \d{1,7} )?
[\+\-] \d{2} \: \d{2} $
}xms
}xms
);
# strptime sets empty values to undef - and strftime doesn't like that...
my @time_from = map { ! defined $_ ? 0 : $_ } strptime($_[1]);
return if not (@time_from);
undef $time_from[$#time_from];
my $time_str = strftime( '%Y-%m-%dT%H:%M:%S%z', @time_from );
substr $time_str, -2, 0, ':';
$_[0]->SUPER::set_value($time_str);
lib/SOAP/WSDL/XSD/Typelib/Builtin/decimal.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/double.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/duration.pm
+2 -2
View File
@@ -9,9 +9,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/float.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/gDay.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonth.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/gMonthDay.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/gYear.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/gYearMonth.pm
+2 -2
View File
@@ -9,9 +9,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/hexBinary.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/int.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/integer.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/language.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/list.pm
+6 -4
View File
@@ -25,13 +25,15 @@ SOAP::WSDL::XSD::Typelib::Builtin::list - list derivation base class
=head1 DESCRIPTION
To derive from some class by list, just inherit from list.
Make sure SOAP::WSDL::XSD::Typelib::Builtin::list is before the type
Make sure SOAP::WSDL::XSD::Typelib::Builtin::list is before the type
to derive from in the @ISA list.
=head1 LICENSE
=head1 LICENSE AND COPYRIGHT
This file is part of SOAP-WSDL. You may distribute/modify it under
Copyright (c) 2007 Martin Kutter. All rights reserved.
This file is part of SOAP-WSDL. You may distribute/modify it under
the same terms as perl itself
=head1 AUTHOR
lib/SOAP/WSDL/XSD/Typelib/Builtin/long.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/negativeInteger.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/nonNegativeInteger.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/nonPositiveInteger.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/normalizedString.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/positiveInteger.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/short.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/string.pm
+3 -3
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
@@ -35,7 +35,7 @@ sub serialize {
my ($self, $opt) = @_;
my $ident = ident $self;
$opt ||= {};
my $value = $self->get_value();;
my $value = $self->get_value();
return $self->start_tag({ %{ $opt }, nil => 1})
if not defined $value;
lib/SOAP/WSDL/XSD/Typelib/Builtin/time.pm
+8 -8
View File
@@ -14,9 +14,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
@@ -32,7 +32,7 @@ sub set_value {
if (
$_[1] =~ m{ ^ \d{2} \: \d{2} \: \d{2} (:? \. \d{1,7} )?
[\+\-] \d{2} \: \d{2} $
}xms
}xms
) {
$_[0]->SUPER::set_value($_[1])
}
@@ -43,13 +43,13 @@ sub set_value {
else {
# strptime sets empty values to undef - and strftime doesn't like that...
# we even need to set it to 1 to prevent a "Day '0' out of range 1..31" warning..
# we need to set the current date for correct TZ conversion -
# we need to set the current date for correct TZ conversion -
# could be daylight savings time
my @now = localtime;
my @time_from = map { my $alternative = shift @now;
! defined $_
? $alternative
my @time_from = map { my $alternative = shift @now;
! defined $_
? $alternative
: $_ } strptime($_[1]);
undef $time_from[-1];
my $time_str = strftime( '%H:%M:%S%z', @time_from );
lib/SOAP/WSDL/XSD/Typelib/Builtin/token.pm
+3 -3
View File
@@ -6,13 +6,13 @@ use warnings;
BEGIN {
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::normalizedString);
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedByte.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedInt.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedLong.pm
+2 -2
View File
@@ -10,9 +10,9 @@ BEGIN {
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/Builtin/unsignedShort.pm
+3 -3
View File
@@ -6,13 +6,13 @@ use warnings;
BEGIN {
use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::unsignedInt);
no warnings qw(redefine);
no strict qw(refs);
# Yes, I know it's ugly - but this is the fastest constructor to write
# Yes, I know it's ugly - but this is the fastest constructor to write
# for Class::Std-Style inside out objects..
*{ __PACKAGE__ . '::new' } = sub {
*{ __PACKAGE__ . '::new' } = sub {
my $self = bless \do { my $foo } , shift;
if (@_) {
$self->set_value( $_[0]->{ value } )
lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm
+83 -83
View File
@@ -9,7 +9,7 @@ use Class::Std::Storable;
use base qw(SOAP::WSDL::XSD::Typelib::Builtin::anyType);
our $VERSION = '2.00_23';
our $VERSION = '2.00_24';
my %ELEMENTS_FROM;
my %ATTRIBUTES_OF;
@@ -28,10 +28,10 @@ sub STORABLE_thaw_post {}
# for error reporting. Eases working with data objects...
sub AUTOMETHOD {
my ($self, $ident, @args_from) = @_;
my $class = ref $self || $self;
my $class = ref $self || $self or die "Cannot call AUTOMETHOD as function";
confess "Can't locate object method \"$_\" via package \"$class\". \n"
. "Valid methods are: "
. "Valid methods are: "
. join(', ', map { ("get_$_" , "set_$_") } keys %{ $ATTRIBUTES_OF{ $class } })
. "\n"
}
@@ -45,73 +45,73 @@ sub _factory {
$CLASSES_OF{ $class } = shift;
no strict qw(refs);
no warnings qw(redefine);
no warnings qw(redefine);
while (my ($name, $attribute_ref) = each %{ $ATTRIBUTES_OF{ $class } } ) {
my $type = $CLASSES_OF{ $class }->{ $name }
or croak "No class given for $name";
# require all types here
$type->isa('UNIVERSAL')
or eval "require $type"
or eval "require $type"
or croak $@;
# check now, so we don't need to do it later.
# $is_list is used in the methods created. Filling it now means
# we don't have to check it every time the method is called, but
# can just use $is_list, which will hold the value assigned to
# $is_list is used in the methods created. Filling it now means
# we don't have to check it every time the method is called, but
# can just use $is_list, which will hold the value assigned to
# it when the method was created.
my $is_list = $type->isa('SOAP::WSDL::XSD::Typelib::Builtin::list');
# The set_$name method below looks rather weird,
# The set_$name method below looks rather weird,
# but is optimized for performance.
#
# We could use sub calls for sure, but these are much slower. And
# We could use sub calls for sure, but these are much slower. And
# the logic is not that easy:
#
# we accept:
# a) objects
# b) scalars
# b) scalars
# c) list refs
# d) hash refs
# e) mixed stuff of all of the above, so we have to set our child to
# e) mixed stuff of all of the above, so we have to set our child to
# a) value if it's an object
# b) New object of expected class with value for simple values
# c 1) New object with value for list values and list type
# c 2) List ref of new objects with value for list values and
# c 2) List ref of new objects with value for list values and
# non-list type
# c + e 1) List ref of objects for list values (list of objects)
# c + e 1) List ref of objects for list values (list of objects)
# and non-list type
# c + e 2) List ref of new objects for list values (list of hashes)
# and non-list type where the hash ref is passed to new as
# argument
# c + e 2) List ref of new objects for list values (list of hashes)
# and non-list type where the hash ref is passed to new as
# argument
# d) New object with values passed to new for HASH references
#
# We throw an error on
# a) list refs of list refs - don't know what to do with this (maybe
# a) list refs of list refs - don't know what to do with this (maybe
# use for lists of list types ?)
# b) wrong object types
# c) non-blessed non-ARRAY/HASH references - if you can define semantics
# c) non-blessed non-ARRAY/HASH references - if you can define semantics
# for GLOB or SCALAR references, feel free to add them.
# d) we should also die for non-blessed non-ARRAY/HASH references in
# lists but don't do yet - oh my !
*{ "$class\::set_$name" } = sub {
# d) we should also die for non-blessed non-ARRAY/HASH references in
# lists but don't do yet - oh my !
*{ "$class\::set_$name" } = sub {
my $is_ref = ref $_[1];
$attribute_ref->{ ident $_[0] } = ($is_ref)
? ($is_ref eq 'ARRAY')
? $is_list # remembered from outside closure
$attribute_ref->{ ident $_[0] } = ($is_ref)
? ($is_ref eq 'ARRAY')
? $is_list # remembered from outside closure
? $type->new({ value => $_[1] }) # it's a list element - can take list ref as value
: [ map { # it's not a list element - set value to list of objects
ref $_
ref $_
? ref $_ eq 'HASH'
? $type->new($_)
: ref $_ eq $type
? $_
: croak "cannot use " . ref($_) . " reference as value for $name - $type required"
: $type->new({ value => $_ })
} @{ $_[1] }
} @{ $_[1] }
]
: $is_ref eq 'HASH'
: $is_ref eq 'HASH'
? $type->new( $_[1] )
# neither ARRAY nor HASH - probably an object...
@@ -121,21 +121,21 @@ sub _factory {
# not $is_ref
: $type->new({ value => $_[1] });
return;
return;
};
*{ "$class\::add_$name" } = sub {
my $ident = ident $_[0];
warn "attempting to add empty value to " . ref $_[0]
warn "attempting to add empty value to " . ref $_[0]
if not defined $_[1];
# first call
# test for existance, not for definedness
if (not exists $attribute_ref->{ $ident }) {
$attribute_ref->{ $ident } = $_[1];
return;
}
if (not ref $attribute_ref->{ $ident } eq 'ARRAY') {
# second call: listify previous value if it's no list and add current
$attribute_ref->{ $ident } = [ $attribute_ref->{ $ident }, $_[1] ];
@@ -144,10 +144,10 @@ sub _factory {
# second and following: add to list
push @{ $attribute_ref->{ $ident } }, $_[1];
return;
return;
};
# TODO: remove this alias - we don't use it, and it's pretty much
# TODO: remove this alias - we don't use it, and it's pretty much
# misleading...
*{ "$class\::$name" } = *{ "$class\::add_$name" };
}
@@ -161,20 +161,20 @@ sub _factory {
# my ($self, $ident, $args_of) = @_;
#
# The hanging side comment show you what would be there, then.
# iterate over keys of arguments
# iterate over keys of arguments
# and call set appropriate field in clase
map { ($ATTRIBUTES_OF{ $class }->{ $_ })
map { ($ATTRIBUTES_OF{ $class }->{ $_ })
? do {
my $method = "set_$_";
$self->$method( $_[1]->{ $_ } ); # ( $args_of->{ $_ } );
}
: $_ =~ m{ \A # beginning of string
xmlns # xmlns
}xms
xmlns # xmlns
}xms
? do {}
: do { use Data::Dumper;
croak "unknown field $_ in $class. Valid fields are:\n"
: do { use Data::Dumper;
croak "unknown field $_ in $class. Valid fields are:\n"
. join(', ', @{ $ELEMENTS_FROM{ $class } }) . "\n"
. "Structure given:\n" . Dumper @_ };
} keys %{ $_[1] }; # %$args_of;
@@ -191,7 +191,7 @@ sub _factory {
# return concatenated return value of serialize call of all
# elements retrieved from get_elements expanding list refs.
# get_elements is inlined for performance.
return join q{} , map {
return join q{} , map {
my $element = $ATTRIBUTES_OF{ $class }->{ $_ }->{ $ident };
# do we have some content
@@ -199,38 +199,38 @@ sub _factory {
$element = [ $element ]
if not ref $element eq 'ARRAY';
my $name = $_;
map {
# serialize element elements with their own serializer
# but name them like they're named here.
if ( $_->isa( 'SOAP::WSDL::XSD::Typelib::Element' ) ) {
$_->serialize( { name => $name } );
}
# serialize complextype elments (of other types) with their
# serialize complextype elments (of other types) with their
# serializer, but add element tags around.
else {
join q{}, $_->start_tag({ name => $name })
, $_->serialize()
, $_->end_tag({ name => $name });
, $_->end_tag({ name => $name });
}
} @{ $element }
}
else {
q{};
}
}
} (@{ $ELEMENTS_FROM{ $class } });
};
*{ "$class\::serialize" } = sub {
$_[1] ||= {}; # maybe even replace by assigning a constant var
# do we have a empty element ?
# do we have a empty element ?
return $_[0]->start_tag({ %{ $_[1] }, empty => 1 })
if not defined $ELEMENTS_FROM{ $class } or not @{ $ELEMENTS_FROM{ $class } };
return join q{}, $_[0]->start_tag($_[1]),
$_[0]->_serialize(), $_[0]->end_tag();
}
}
1;
@@ -252,7 +252,7 @@ To subclass, write a package like this:
use base qw(SOAP::WSDL::XSD::Typelib::ComplexType);
# we only need the :get attribute qualifier.
# set and init_arg are automatically created by
# set and init_arg are automatically created by
# SOAP::WSDL::XSD::Typelib::ComplexType
my %first_attr_of :ATTR(:get<first_attr> :default<()>);
my %second_attr_of :ATTR(:get<second_attr> :default<()>);
@@ -274,12 +274,12 @@ To subclass, write a package like this:
second_attr => 'My::SecondElement',
third_attr => 'My::ThirdElement',
);
# call _factory
# call _factory
__PACKAGE__->_factory(
\@elements_from,
\%attributes_of,
\%classes_of
\%classes_of,
);
1;
@@ -288,7 +288,7 @@ When subclassing, the following methods are created in the subclass:
=head2 new
Constructor. For your convenience, new will accept data for the object's
Constructor. For your convenience, new will accept data for the object's
properties in the following forms:
hash refs
@@ -296,22 +296,22 @@ properties in the following forms:
2) of list refs
3) of hash refs
4) of objects
5) mixed stuff of all of the above
5) mixed stuff of all of the above
new() will set the data via the set_FOO methods to the object's element
properties.
new() will set the data via the set_FOO methods to the object's element
properties.
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
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.
Examples:
my $obj = MyClass->new({ MyName => $value });
my $obj = MyClass->new({ MyName => $value });
my $obj = MyClass->new({
MyName => {
DeepName => $value
MyName => {
DeepName => $value,
},
MySecondName => $value,
});
@@ -325,27 +325,27 @@ Examples:
MyThirdName => [ $object1, $object2 ],
});
The new() method from Class::Std will be overridden, so you should not rely
on it's behaviour.
The new() method from Class::Std will be overridden, so you should not rely
on it's behaviour.
Your START and BUILD methods are called, but the class' inheritance tree is
Your START and BUILD methods are called, but the class' inheritance tree is
not traversed.
=head2 set_FOO
A mutator method for every element property.
A mutator method for every element property.
For your convenience, the set_FOO methods will accept all kind of data you
can think of (and all combinations of them) as input - with the exception
For your convenience, the set_FOO methods will accept all kind of data you
can think of (and all combinations of them) as input - with the exception
of GLOBS and filehandles.
This means you may set element properties by passing
This means you may set element properties by passing
a) objects
b) scalars
b) scalars
c) list refs
d) hash refs
e) mixed stuff of all of the above
e) mixed stuff of all of the above
Examples are similar to the examples provided for new() above.
@@ -362,7 +362,7 @@ Variants known to work are:
sequence
all
complexContent containing sequence/all definitions
=item * Thread safety
SOAP::WSDL::XSD::Typelib::Builtin uses Class::Std::Storable which uses
@@ -375,12 +375,12 @@ No facets are implemented yet.
=back
=head1 LICENSE
=head1 LICENSE AND COPYRIGHT
Copyright 2004-2007 Martin Kutter.
Copyright (c) 2007 Martin Kutter. All rights reserved.
This file is part of SOAP-WSDL. 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
@@ -388,10 +388,10 @@ Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
=head1 REPOSITORY INFORMATION
$Rev: 346 $
$Rev: 391 $
$LastChangedBy: kutterma $
$Id: ComplexType.pm 346 2007-11-05 21:38:56Z kutterma $
$Id: ComplexType.pm 391 2007-11-17 21:56:13Z kutterma $
$HeadURL: http://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/XSD/Typelib/ComplexType.pm $
=cut
lib/SOAP/WSDL/XSD/Typelib/Element.pm
+15 -15
View File
@@ -2,7 +2,7 @@
package SOAP::WSDL::XSD::Typelib::Element;
use strict;
our $VERSION = '2.00_23';
our $VERSION = '2.00_24';
my %NAME;
my %NILLABLE;
@@ -27,11 +27,11 @@ BLOCK: {
no strict qw(refs);
while (my ($name, $value) = each %method_lookup ) {
*{ "__set$name" } = sub {
my $class = ref $_[0] || $_[0];
my $class = ref $_[0] || $_[0] or die "Cannot call __set$name without parameter";
$value->{ $class } = $_[1];
};
*{ "__get$name" } = sub {
my $class = ref $_[0] || $_[0];
my $class = ref $_[0] || $_[0] or die "Cannot call __get$name as function";
return $value->{ $class };
};
}
@@ -43,7 +43,7 @@ sub start_tag {
# my ($self, $opt, $value) = @_;
my $ending = ($_[1]->{ empty }) ? '/>' : '>';
my @attr_from = ();
if ($_[1]->{ nil }) {
return q{} if not $NILLABLE{ ref $_[0] };
push @attr_from, 'xsi:nil="true"';
@@ -52,15 +52,15 @@ sub start_tag {
if ($_[1]->{qualified}) {
push @attr_from, 'xmlns="' . $_[0]->get_xmlns . '"';
}
# do we need to check for name ? Element ref="" should have it's own
# do we need to check for name ? Element ref="" should have it's own
# start_tag. If we don't need to check, we can speed things up
return join q{ }, "<$_[1]->{ name }" , @attr_from , $ending if $_[1]->{ name };
return join q{ }, "<$NAME{ ref $_[0]}" , @attr_from , $ending;
}
# use $_[0] and $_[1] for speed.
#
#
# read it as:
#
# my ($self, $opt) = @_;
@@ -68,11 +68,11 @@ sub start_tag {
# return "</$opt->{name}>" if $opt->{name};
# return "</"$NAME{$class}>";
#
# do we need to check for name ? Element ref="" should have it's own
# do we need to check for name ? Element ref="" should have it's own
# end_tag. If we don't need to check, we can speed things up by defining
# end tag with () prototype - perl will inline it for us if we do...
sub end_tag {
return "</$_[1]->{name}>" if $_[1]->{name};
return "</$_[1]->{name}>" if $_[1]->{name};
return "</$NAME{ ref $_[0] }>";
}
@@ -120,10 +120,10 @@ Now we create this XML schema definition type class:
__PACKAGE__->__set_name('MyElementName');
__PACKAGE__->__set_nillable(0);
__PACKAGE__->__set_ref(1);
=head1 NOTES
=over
=over
=item * type="Foo"
@@ -131,14 +131,14 @@ Implemented via inheritance.
=item * ref="Foo"
Implemented via inheritance, too. Calling
Implemented via inheritance, too. Calling
__PACKAGE__->__set_ref(1) is highly encouraged, though it has no
effect yet - it will probably be needed for serialization to XML
__PACKAGE__->__set_ref(1) is highly encouraged, though it has no
effect yet - it will probably be needed for serialization to XML
Schema definitions some day.
=back
=head1 BUGS AND LIMITATIONS
=over