File Coverage

lib/XML/Compile/Schema/Specs.pm
Criterion Covered Total %
statement 31 32 96.8
branch 12 18 66.6
condition 8 12 66.6
subroutine 8 9 88.8
pod 3 3 100.0
total 62 74 83.7


line stmt bran cond sub pod time code
1             # Copyrights 2006-2019 by [Mark Overmeer ].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.02.
5             # This code is part of distribution XML-Compile. Meta-POD processed with
6             # OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package XML::Compile::Schema::Specs;
10 50     50   311 use vars '$VERSION';
  50         91  
  50         2550  
11             $VERSION = '1.62';
12              
13              
14 50     50   266 use warnings;
  50         91  
  50         1078  
15 50     50   208 use strict;
  50         78  
  50         953  
16              
17 50     50   232 use Log::Report 'xml-compile';
  50         103  
  50         309  
18              
19 50     50   32727 use XML::Compile::Schema::BuiltInTypes qw/%builtin_types/;
  50         249  
  50         7244  
20 50     50   385 use XML::Compile::Util qw/SCHEMA1999 SCHEMA2000 SCHEMA2001 unpack_type/;
  50         91  
  50         29569  
21              
22              
23             ### Who will extend this?
24             # everything which is not caught by a special will need to pass through
25             # the official meta-scheme: the scheme of the scheme. These lists are
26             # used to restrict the namespace to the specified, hiding all helper
27             # types.
28              
29             my @builtin_common = qw/
30             boolean
31             byte
32             date
33             decimal
34             double
35             duration
36             ENTITIES
37             ENTITY
38             float
39             ID
40             IDREF
41             IDREFS
42             int
43             integer
44             language
45             long
46             Name
47             NCName
48             negativeInteger
49             NMTOKEN
50             NMTOKENS
51             nonNegativeInteger
52             nonPositiveInteger
53             NOTATION
54             pattern
55             positiveInteger
56             QName
57             short
58             string
59             time
60             token
61             unsignedByte
62             unsignedInt
63             unsignedLong
64             unsignedShort
65             yearMonthDuration
66             /;
67              
68             my @builtin_extra_1999 = qw/
69             binary
70             recurringDate
71             recurringDay
72             recurringDuration
73             timeDuration
74             timeInstant
75             timePeriod
76             uriReference
77             year
78             /;
79              
80             my @builtin_extra_2000 = (@builtin_extra_1999, qw/
81             anyType
82             CDATA
83             / );
84              
85             my @builtin_extra_2001 = qw/
86             anySimpleType
87             anyType
88             anyURI
89             base64Binary
90             dateTime
91             dayTimeDuration
92             error
93             gDay
94             gMonth
95             gMonthDay
96             gYear
97             gYearMonth
98             hexBinary
99             normalizedString
100             precisionDecimal
101             /;
102              
103             my %builtin_public_1999 = map { ($_ => $_) }
104             @builtin_common, @builtin_extra_1999;
105              
106             my %builtin_public_2000 = map { ($_ => $_) }
107             @builtin_common, @builtin_extra_2000;
108              
109             my %builtin_public_2001 = map { ($_ => $_) }
110             @builtin_common, @builtin_extra_2001;
111              
112             my %sloppy_int_version =
113             ( integer => 'int'
114             , long => 'int'
115             , nonNegativeInteger => 'unsigned_int'
116             , nonPositiveInteger => 'non_pos_int'
117             , positiveInteger => 'positive_int'
118             , negativeInteger => 'negative_int'
119             , unsignedLong => 'unsigned_int'
120             , unsignedInt => 'unsigned_int'
121             );
122              
123             my %sloppy_float_version = map +($_ => 'sloppy_float'),
124             qw/decimal precisionDecimal float double/;
125              
126             my %schema_1999 =
127             ( uri_xsd => SCHEMA1999
128             , uri_xsi => SCHEMA1999.'-instance'
129              
130             , builtin_public => \%builtin_public_1999
131             );
132              
133             my %schema_2000 =
134             ( uri_xsd => SCHEMA2000
135             , uri_xsi => SCHEMA2000.'-instance'
136              
137             , builtin_public => \%builtin_public_2000
138             );
139              
140             my %schema_2001 =
141             ( uri_xsd => SCHEMA2001
142             , uri_xsi => SCHEMA2001 .'-instance'
143              
144             , builtin_public => \%builtin_public_2001
145             );
146              
147             my %schemas = map { ($_->{uri_xsd} => $_) }
148             \%schema_1999, \%schema_2000, \%schema_2001;
149              
150              
151 0     0 1 0 sub predefinedSchemas() { keys %schemas }
152              
153              
154 58 50   58 1 633 sub predefinedSchema($) { defined $_[1] ? $schemas{$_[1]} : () }
155              
156              
157             sub builtInType($$;$@)
158 2740     2740 1 5902 { my ($class, $node, $ns) = (shift, shift, shift);
159 2740 50       6542 my $name = @_ % 1 ? shift : undef;
160 2740 50       8064 ($ns, $name) = unpack_type $ns
161             unless defined $name;
162              
163 2740 100       9907 my $schema = $schemas{$ns}
164             or return ();
165              
166 1591         5024 my %args = @_;
167              
168             return $builtin_types{boolean_with_Types_Serialiser}
169 1591 50 33     3927 if $args{json_friendly} && $name eq 'boolean';
170              
171             return $builtin_types{$sloppy_int_version{$name}}
172 1591 100 100     3814 if $args{sloppy_integers} && exists $sloppy_int_version{$name};
173              
174 1559 100 100     3680 if($args{sloppy_floats} && (my $maptype = $sloppy_float_version{$name}))
175             { return $builtin_types{sloppy_float_force_NV}
176 28 50 33     64 if $args{json_friendly} && $maptype eq 'sloppy_float';
177              
178 28         100 return $builtin_types{$maptype};
179             }
180              
181             # only official names are exported this way
182 1531         3534 my $public = $schema->{builtin_public}{$name};
183 1531 50       5570 defined $public ? $builtin_types{$public} : ();
184             }
185              
186             1;