File Coverage

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