File Coverage

blib/lib/JSON/Schema/AsType/Draft4.pm
Criterion Covered Total %
statement 139 141 98.5
branch 27 30 90.0
condition n/a
subroutine 43 43 100.0
pod n/a
total 209 214 97.6


line stmt bran cond sub pod time code
1             package JSON::Schema::AsType::Draft4;
2             our $AUTHORITY = 'cpan:YANICK';
3             # ABSTRACT: Role processing draft4 JSON Schema
4             $JSON::Schema::AsType::Draft4::VERSION = '0.4.2';
5              
6 9     9   6338 use strict;
  9         25  
  9         272  
7 9     9   49 use warnings;
  9         22  
  9         243  
8              
9 9     9   43 use Moose::Role;
  9         21  
  9         72  
10              
11 9     9   51887 use Type::Utils;
  9         23  
  9         100  
12 9     9   14559 use Scalar::Util qw/ looks_like_number /;
  9         24  
  9         555  
13 9     9   54 use List::Util qw/ reduce pairmap pairs /;
  9         25  
  9         622  
14 9     9   57 use List::MoreUtils qw/ any all none uniq zip /;
  9         23  
  9         69  
15 9     9   8813 use Types::Standard qw/InstanceOf HashRef StrictNum Any Str ArrayRef Int slurpy Dict Optional slurpy /;
  9         24  
  9         129  
16              
17 9     9   16041 use JSON;
  9         21  
  9         65  
18              
19 9     9   1029 use JSON::Schema::AsType;
  9         23  
  9         216  
20              
21 9     9   2321 use JSON::Schema::AsType::Draft4::Types '-all';
  9         29  
  9         96  
22              
23             override all_keywords => sub {
24             my $self = shift;
25            
26             # $ref trumps all
27             return '$ref' if $self->schema->{'$ref'};
28              
29             return uniq 'id', super();
30             };
31              
32             __PACKAGE__->meta->add_method( '_keyword_$ref' => sub {
33 805     805   2353 my( $self, $ref ) = @_;
34              
35             return Type::Tiny->new(
36             name => 'Ref',
37             display_name => "Ref($ref)",
38             constraint => sub {
39            
40 1542     1542   205315 my $r = $self->resolve_reference($ref);
41              
42 1542         85108 $r->check($_);
43             },
44             message => sub {
45 12     12   1711 my $schema = $self->resolve_reference($ref);
46              
47 12         501 join "\n", "ref schema is " . to_json($schema->schema, { allow_nonref => 1 }), @{$schema->validate_explain($_)}
  12         731  
48             }
49 805         9291 );
50             } );
51              
52             sub _keyword_id {
53 411     411   1041 my( $self, $id ) = @_;
54              
55 411 100       8798 unless( $self->uri ) {
56 396         4158 my $id = $self->absolute_id($id);
57 396         7853 $self->uri($id);
58             }
59              
60 411         10428 return;
61             }
62              
63             sub _keyword_definitions {
64 70     70   224 my( $self, $defs ) = @_;
65              
66 70         495 $self->sub_schema( $_ ) for values %$defs;
67              
68 70         10150 return;
69             };
70              
71             sub _keyword_pattern {
72 38     38   119 my( $self, $pattern ) = @_;
73              
74 38         211 Pattern[$pattern];
75             }
76              
77             sub _keyword_enum {
78 269     269   652 my( $self, $enum ) = @_;
79            
80 269         1550 Enum[@$enum];
81             }
82              
83             sub _keyword_uniqueItems {
84 150     150   429 my( $self, $unique ) = @_;
85              
86 150 50       1031 return unless $unique; # unique false? all is good
87              
88 150         1926 return UniqueItems;
89             }
90              
91             sub _keyword_dependencies {
92 12     12   40 my( $self, $dependencies ) = @_;
93              
94             return Dependencies[
95 12 100   21   129 pairmap { $a => ref $b eq 'HASH' ? $self->sub_schema($b) : $b } %$dependencies
  21         150  
96             ];
97              
98             }
99              
100             sub _keyword_additionalProperties {
101 67     67   287 my( $self, $addi ) = @_;
102              
103 67         152 my $add_schema;
104 67 100       422 $add_schema = $self->sub_schema($addi) if ref $addi eq 'HASH';
105              
106             my @known_keys = (
107 67         153 eval { keys %{ $self->schema->{properties} } },
  67         1458  
108 67         1586 map { qr/$_/ } eval { keys %{ $self->schema->{patternProperties} } } );
  6         177  
  67         738  
  67         1419  
109              
110 67 100       1911 return AdditionalProperties[ \@known_keys, $add_schema ? $add_schema->type : $addi ];
111             }
112              
113             sub _keyword_patternProperties {
114 77     77   252 my( $self, $properties ) = @_;
115              
116             my %prop_schemas = pairmap {
117 23     23   429 $a => $self->sub_schema($b)->type
118 77         858 } %$properties;
119              
120 77         1365 return PatternProperties[ %prop_schemas ];
121             }
122              
123             sub _keyword_properties {
124 547     547   1456 my( $self, $properties ) = @_;
125              
126             Properties[
127             pairmap {
128 1262     1262   27819 my $schema = $self->sub_schema($b);
129 1262         59661 $a => $schema->type;
130 547         5000 } %$properties
131             ];
132              
133             }
134              
135             sub _keyword_maxProperties {
136 2     2   8 my( $self, $max ) = @_;
137              
138 2         15 MaxProperties[ $max ];
139             }
140              
141             sub _keyword_minProperties {
142 2     2   11 my( $self, $min ) = @_;
143              
144 2         16 MinProperties[ $min ];
145             }
146              
147             sub _keyword_required {
148 420     420   1126 my( $self, $required ) = @_;
149              
150 420         1955 Required[@$required];
151             }
152              
153             sub _keyword_not {
154 10     10   27 my( $self, $schema ) = @_;
155 10         34 Not[ $self->sub_schema($schema) ];
156             }
157              
158             sub _keyword_oneOf {
159 9     9   37 my( $self, $options ) = @_;
160              
161 9         36 OneOf[ map { $self->sub_schema( $_ ) } @$options ];
  52         1381  
162             }
163              
164              
165             sub _keyword_anyOf {
166 70     70   226 my( $self, $options ) = @_;
167              
168 70         210 AnyOf[ map { $self->sub_schema($_)->type } @$options ];
  140         7723  
169             }
170              
171             sub _keyword_allOf {
172 30     30   97 my( $self, $options ) = @_;
173              
174 30         95 AllOf[ map { $self->sub_schema($_)->type } @$options ];
  61         3074  
175             }
176              
177             sub _keyword_type {
178 1591     1591   3977 my( $self, $struct_type ) = @_;
179              
180             my %keyword_map = map {
181 1591         5381 lc $_->name => $_
  11137         75143  
182             } Integer, Number, String, Object, Array, Boolean, Null;
183              
184 1591 100       49286 unless( $self->strict_string ) {
185 9         104 $keyword_map{number} = LaxNumber;
186 9         77 $keyword_map{integer} = LaxInteger;
187 9         71 $keyword_map{string} = LaxString;
188             }
189              
190              
191             return $keyword_map{$struct_type}
192 1591 100       15085 if $keyword_map{$struct_type};
193              
194 6 50       37 if( ref $struct_type eq 'ARRAY' ) {
195 6         25 return AnyOf[map { $self->_keyword_type($_) } @$struct_type];
  12         94  
196             }
197              
198 0         0 return;
199             }
200              
201             sub _keyword_multipleOf {
202 6     6   22 my( $self, $num ) = @_;
203              
204 6         34 MultipleOf[$num];
205             };
206              
207             sub _keyword_maxItems {
208 7     7   27 my( $self, $max ) = @_;
209              
210 7         47 MaxItems[$max];
211             }
212              
213             sub _keyword_minItems {
214 160     160   432 my( $self, $min ) = @_;
215              
216 160         748 MinItems[$min];
217             }
218              
219             sub _keyword_maxLength {
220 8     8   30 my( $self, $max ) = @_;
221              
222 8         54 MaxLength[$max];
223             }
224              
225             sub _keyword_minLength {
226 10     10   40 my( $self, $min ) = @_;
227              
228 10         67 return MinLength[$min];
229             }
230              
231             sub _keyword_maximum {
232 13     13   46 my( $self, $maximum ) = @_;
233              
234             return $self->schema->{exclusiveMaximum}
235 13 100       262 ? ExclusiveMaximum[$maximum]
236             : Maximum[$maximum];
237              
238             }
239              
240             sub _keyword_minimum {
241 67     67   252 my( $self, $minimum ) = @_;
242              
243 67 100       1364 if ( $self->schema->{exclusiveMinimum} ) {
244 15         377 return ExclusiveMinimum[$minimum];
245             }
246              
247 52         704 return Minimum[$minimum];
248             }
249              
250             sub _keyword_additionalItems {
251 12     12   32 my( $self, $s ) = @_;
252              
253 12 100       50 unless($s) {
254 9 100       244 my $items = $self->schema->{items} or return;
255 6 100       78 return if ref $items eq 'HASH'; # it's a schema, nevermind
256 3         10 my $size = @$items;
257              
258 3         18 return AdditionalItems[$size];
259             }
260              
261 3         14 my $schema = $self->sub_schema($s);
262              
263 3         50 my $to_skip = @{ $self->schema->{items} };
  3         64  
264              
265 3         43 return AdditionalItems[$to_skip,$schema];
266              
267             }
268              
269             sub _keyword_items {
270 217     217   665 my( $self, $items ) = @_;
271              
272 217 50       890 if ( Boolean->check($items) ) {
273 0         0 return Items[$items];
274             }
275              
276 217 100       1608 if( ref $items eq 'HASH' ) {
277 207         861 my $type = $self->sub_schema($items)->type;
278              
279 207         9207 return Items[$type];
280             }
281              
282             # TODO forward declaration not workie
283 10         17 my @types;
284 10         29 for ( @$items ) {
285 16         1101 push @types, $self->sub_schema($_)->type;
286             }
287              
288 10         917 return Items[\@types];
289             }
290              
291             JSON::Schema::AsType->new(
292             specification => 'draft4',
293             uri => 'http://json-schema.org/draft-04/schema',
294             schema => from_json <<'END_JSON' )->type;
295             {
296             "id": "http://json-schema.org/draft-04/schema#",
297             "$schema": "http://json-schema.org/draft-04/schema#",
298             "description": "Core schema meta-schema",
299             "definitions": {
300             "schemaArray": {
301             "type": "array",
302             "minItems": 1,
303             "items": { "$ref": "#" }
304             },
305             "positiveInteger": {
306             "type": "integer",
307             "minimum": 0
308             },
309             "positiveIntegerDefault0": {
310             "allOf": [ { "$ref": "#/definitions/positiveInteger" }, { "default": 0 } ]
311             },
312             "simpleTypes": {
313             "enum": [ "array", "boolean", "integer", "null", "number", "object", "string" ]
314             },
315             "stringArray": {
316             "type": "array",
317             "items": { "type": "string" },
318             "minItems": 1,
319             "uniqueItems": true
320             }
321             },
322             "type": "object",
323             "properties": {
324             "id": {
325             "type": "string",
326             "format": "uri"
327             },
328             "$schema": {
329             "type": "string",
330             "format": "uri"
331             },
332             "title": {
333             "type": "string"
334             },
335             "description": {
336             "type": "string"
337             },
338             "default": {},
339             "multipleOf": {
340             "type": "number",
341             "minimum": 0,
342             "exclusiveMinimum": true
343             },
344             "maximum": {
345             "type": "number"
346             },
347             "exclusiveMaximum": {
348             "type": "boolean",
349             "default": false
350             },
351             "minimum": {
352             "type": "number"
353             },
354             "exclusiveMinimum": {
355             "type": "boolean",
356             "default": false
357             },
358             "maxLength": { "$ref": "#/definitions/positiveInteger" },
359             "minLength": { "$ref": "#/definitions/positiveIntegerDefault0" },
360             "pattern": {
361             "type": "string",
362             "format": "regex"
363             },
364             "additionalItems": {
365             "anyOf": [
366             { "type": "boolean" },
367             { "$ref": "#" }
368             ],
369             "default": {}
370             },
371             "items": {
372             "anyOf": [
373             { "$ref": "#" },
374             { "$ref": "#/definitions/schemaArray" }
375             ],
376             "default": {}
377             },
378             "maxItems": { "$ref": "#/definitions/positiveInteger" },
379             "minItems": { "$ref": "#/definitions/positiveIntegerDefault0" },
380             "uniqueItems": {
381             "type": "boolean",
382             "default": false
383             },
384             "maxProperties": { "$ref": "#/definitions/positiveInteger" },
385             "minProperties": { "$ref": "#/definitions/positiveIntegerDefault0" },
386             "required": { "$ref": "#/definitions/stringArray" },
387             "additionalProperties": {
388             "anyOf": [
389             { "type": "boolean" },
390             { "$ref": "#" }
391             ],
392             "default": {}
393             },
394             "definitions": {
395             "type": "object",
396             "additionalProperties": { "$ref": "#" },
397             "default": {}
398             },
399             "properties": {
400             "type": "object",
401             "additionalProperties": { "$ref": "#" },
402             "default": {}
403             },
404             "patternProperties": {
405             "type": "object",
406             "additionalProperties": { "$ref": "#" },
407             "default": {}
408             },
409             "dependencies": {
410             "type": "object",
411             "additionalProperties": {
412             "anyOf": [
413             { "$ref": "#" },
414             { "$ref": "#/definitions/stringArray" }
415             ]
416             }
417             },
418             "enum": {
419             "type": "array",
420             "minItems": 1,
421             "uniqueItems": true
422             },
423             "type": {
424             "anyOf": [
425             { "$ref": "#/definitions/simpleTypes" },
426             {
427             "type": "array",
428             "items": { "$ref": "#/definitions/simpleTypes" },
429             "minItems": 1,
430             "uniqueItems": true
431             }
432             ]
433             },
434             "allOf": { "$ref": "#/definitions/schemaArray" },
435             "anyOf": { "$ref": "#/definitions/schemaArray" },
436             "oneOf": { "$ref": "#/definitions/schemaArray" },
437             "not": { "$ref": "#" }
438             },
439             "dependencies": {
440             "exclusiveMaximum": [ "maximum" ],
441             "exclusiveMinimum": [ "minimum" ]
442             },
443             "default": {}
444             }
445             END_JSON
446              
447             1;
448              
449             __END__
450              
451             =pod
452              
453             =encoding UTF-8
454              
455             =head1 NAME
456              
457             JSON::Schema::AsType::Draft4 - Role processing draft4 JSON Schema
458              
459             =head1 VERSION
460              
461             version 0.4.2
462              
463             =head1 DESCRIPTION
464              
465             This role is not intended to be used directly. It is used internally
466             by L<JSON::Schema::AsType> objects.
467              
468             Importing this module auto-populate the Draft4 schema in the
469             L<JSON::Schema::AsType> schema cache.
470              
471             =head1 AUTHOR
472              
473             Yanick Champoux <yanick@babyl.dyndns.org>
474              
475             =head1 COPYRIGHT AND LICENSE
476              
477             This software is copyright (c) 2015 by Yanick Champoux.
478              
479             This is free software; you can redistribute it and/or modify it under
480             the same terms as the Perl 5 programming language system itself.
481              
482             =cut