1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
package SOAP::WSDL::XSD::SimpleType;
use strict;
use warnings;
use Class::Std::Fast::Storable;
use base qw(SOAP::WSDL::Base);
our $VERSION = 3.004;
my %length_of :ATTR(:name<length> :default<[]>);
my %minLength_of :ATTR(:name<minLength> :default<[]>);
my %maxLength_of :ATTR(:name<maxLength> :default<[]>);
my %pattern_of :ATTR(:name<pattern> :default<[]>);
my %enumeration_of :ATTR(:name<enumeration> :default<[]>);
my %whiteSpace_of :ATTR(:name<whiteSpace> :default<[]>);
my %totalDigits_of :ATTR(:name<totalDigits> :default<[]>);
my %fractionDigits_of :ATTR(:name<fractionDigits> :default<[]>);
my %minExclusive :ATTR(:name<minExclusive> :default<[]>);
my %minInclusive :ATTR(:name<minInclusive> :default<[]>);
my %maxExclusive :ATTR(:name<maxExclusive> :default<[]>);
my %maxInclusive :ATTR(:name<maxInclusive> :default<[]>);
my %fixed :ATTR(:name<fixed> :default<[]>);
my %annotation_of :ATTR(:name<annotation> :default<()>);
my %base_of :ATTR(:name<base> :default<()>);
my %itemType_of :ATTR(:name<itemType> :default<()>);
# TODO rename flavor to variety to be consistent with the XML Schema
# specs - though flavor is the cooler name..
# set to restriction|list|union|enumeration
my %flavor_of :ATTR(:name<flavor> :default<()>);
# for simpleType containing atomic simple types
my %type_of :ATTR(:name<type> :default<()>);
sub get_simpleType; *get_simpleType = \&get_type;
sub set_simpleType; *set_simpleType = \&set_type;
sub get_variety; *get_variety = \&get_flavor;
sub set_restriction {
my $self = shift;
my @attributes = @_;
$self->set_flavor( 'restriction' );
for (@attributes) {
next if (not $_->{ LocalName } eq 'base');
$self->set_base( $_->{ Value } );
}
}
sub set_list {
my $self = shift;
my @attributes = @_;
$self->set_flavor( 'list' );
for (@attributes) {
next if (not $_->{ LocalName } eq 'itemType');
$self->set_itemType( $_->{ Value } );
}
}
sub set_union {
my $self = shift;
my @attributes = @_;
$self->set_flavor( 'union' );
for (@attributes) {
next if (not $_->{ LocalName } eq 'memberTypes');
$self->set_base( [ split /\s/, $_->{ Value } ] );
}
}
sub serialize {
my $self = shift;
my $name = shift;
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'
or $flavor_of{ $ident } eq 'enumeration');
if ($flavor_of{ $ident } eq 'list' )
{
$value ||= [];
$value = [ $value ] if ( ref( $value) ne 'ARRAY' );
return $self->_serialize_single($name, join( q{ }, @{ $value } ), $opt);
}
}
sub _serialize_single {
my ($self, $name, $value, $opt) = @_;
my $xml = '';
$xml .= $opt->{ indent } if ($opt->{ readable }); # add indentation
$xml .= '<' . join ' ', $name, @{ $opt->{ attributes } };
if ( $opt->{ autotype }) {
# reverse namespace by prefix hash
my $ns = $self->get_targetNamespace();
# build a list of hash keys (eg '#default', 'tns') whose values match our namespace (eg 'urn:myNamespace')
(my @possible_namespace_names) = grep { $opt->{ namespace }->{$_} eq $ns } keys %{ $opt->{ namespace } };
# put any '#default' option last
@possible_namespace_names = sort { $a eq '#default' ? 1 : $b eq '#default' ? -1 : $a cmp $b } @possible_namespace_names;
if( grep( $_ ne '#default', @possible_namespace_names ) > 1 or ! @possible_namespace_names ) {
die "No prefix found for namespace $ns, or too many possible names: ``@possible_namespace_names''; there should be just one and maybe a '#default' entry";
}
my $prefix = $possible_namespace_names[0];
$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;
}
1;
|
