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.4';
5              
6 12     12   142373 use strict;
  12         25  
  12         540  
7 12     12   59 use warnings;
  12         24  
  12         785  
8              
9 12     12   474 use Moose::Role;
  12         438278  
  12         143  
10              
11 12     12   76060 use Type::Utils;
  12         73131  
  12         173  
12 12     12   21428 use Scalar::Util qw/ looks_like_number /;
  12         32  
  12         877  
13 12     12   94 use List::Util qw/ reduce pairmap pairs /;
  12         46  
  12         963  
14 12     12   684 use List::MoreUtils qw/ any all none uniq zip /;
  12         10132  
  12         107  
15 12     12   18774 use Types::Standard qw/InstanceOf HashRef StrictNum Any Str ArrayRef Int slurpy Dict Optional slurpy /;
  12         77082  
  12         132  
16              
17 12     12   49475 use JSON;
  12         13771  
  12         95  
18              
19 12     12   2208 use JSON::Schema::AsType;
  12         31  
  12         379  
20              
21 12     12   3408 use JSON::Schema::AsType::Draft4::Types '-all';
  12         45  
  12         121  
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 1283     1283   4348 my( $self, $ref ) = @_;
34              
35             return Type::Tiny->new(
36             name => 'Ref',
37             display_name => "Ref($ref)",
38             constraint => sub {
39            
40 1542     1542   141246 my $r = $self->resolve_reference($ref);
41              
42 1542         614405 $r->check($_);
43             },
44             message => sub {
45 12     12   1757 my $schema = $self->resolve_reference($ref);
46              
47 12         558 join "\n", "ref schema is " . to_json($schema->schema, { allow_nonref => 1 }), @{$schema->validate_explain($_)}
  12         754  
48             }
49 1283         21037 );
50             } );
51              
52             sub _keyword_id {
53 434     434   1351 my( $self, $id ) = @_;
54              
55 434 100       13836 unless( $self->uri ) {
56 396         5025 my $id = $self->absolute_id($id);
57 396         10816 $self->uri($id);
58             }
59              
60 434         13927 return;
61             }
62              
63             sub _keyword_definitions {
64 87     87   230 my( $self, $defs ) = @_;
65              
66 87         708 $self->sub_schema( $_ ) for values %$defs;
67              
68 87         117186 return;
69             };
70              
71             sub _keyword_pattern {
72 38     38   152 my( $self, $pattern ) = @_;
73              
74 38         276 Pattern[$pattern];
75             }
76              
77             sub _keyword_enum {
78 286     286   849 my( $self, $enum ) = @_;
79            
80 286         2303 Enum[@$enum];
81             }
82              
83             sub _keyword_uniqueItems {
84 219     219   728 my( $self, $unique ) = @_;
85              
86 219 50       2132 return unless $unique; # unique false? all is good
87              
88 219         3046 return UniqueItems;
89             }
90              
91             sub _keyword_dependencies {
92 27     27   116 my( $self, $dependencies ) = @_;
93              
94             return Dependencies[
95 27 100   51   325 pairmap { $a => ref $b eq 'HASH' ? $self->sub_schema($b) : $b } %$dependencies
  51         412  
96             ];
97              
98             }
99              
100             sub _keyword_additionalProperties {
101 153     153   504 my( $self, $addi ) = @_;
102              
103 153         332 my $add_schema;
104 153 100       1012 $add_schema = $self->sub_schema($addi) if ref $addi eq 'HASH';
105              
106             my @known_keys = (
107 153         377 eval { keys %{ $self->schema->{properties} } },
  153         4785  
108 153         143825 map { qr/$_/ } eval { keys %{ $self->schema->{patternProperties} } } );
  6         203  
  153         1767  
  153         4257  
109              
110 153 100       5364 return AdditionalProperties[ \@known_keys, $add_schema ? $add_schema->type : $addi ];
111             }
112              
113             sub _keyword_patternProperties {
114 163     163   530 my( $self, $properties ) = @_;
115              
116             my %prop_schemas = pairmap {
117 23     23   626 $a => $self->sub_schema($b)->type
118 163         2058 } %$properties;
119              
120 163         2629 return PatternProperties[ %prop_schemas ];
121             }
122              
123             sub _keyword_properties {
124 632     632   2442 my( $self, $properties ) = @_;
125              
126             Properties[
127             pairmap {
128 1819     1819   18891 my $schema = $self->sub_schema($b);
129 1819         646540 $a => $schema->type;
130 632         8550 } %$properties
131             ];
132              
133             }
134              
135             sub _keyword_maxProperties {
136 2     2   6 my( $self, $max ) = @_;
137              
138 2         14 MaxProperties[ $max ];
139             }
140              
141             sub _keyword_minProperties {
142 2     2   6 my( $self, $min ) = @_;
143              
144 2         14 MinProperties[ $min ];
145             }
146              
147             sub _keyword_required {
148 420     420   1444 my( $self, $required ) = @_;
149              
150 420         2971 Required[@$required];
151             }
152              
153             sub _keyword_not {
154 10     10   31 my( $self, $schema ) = @_;
155 10         48 Not[ $self->sub_schema($schema) ];
156             }
157              
158             sub _keyword_oneOf {
159 9     9   31 my( $self, $options ) = @_;
160              
161 9         29 OneOf[ map { $self->sub_schema( $_ ) } @$options ];
  52         1823  
162             }
163              
164              
165             sub _keyword_anyOf {
166 151     151   505 my( $self, $options ) = @_;
167              
168 151         521 AnyOf[ map { $self->sub_schema($_)->type } @$options ];
  302         18585  
169             }
170              
171             sub _keyword_allOf {
172 47     47   161 my( $self, $options ) = @_;
173              
174 47         143 AllOf[ map { $self->sub_schema($_)->type } @$options ];
  95         8131  
175             }
176              
177             sub _keyword_type {
178 2006     2006   6290 my( $self, $struct_type ) = @_;
179              
180             my %keyword_map = map {
181 2006         15281 lc $_->name => $_
  14042         123516  
182             } Integer, Number, String, Object, Array, Boolean, Null;
183              
184 2006 100       87334 unless( $self->strict_string ) {
185 9         71 $keyword_map{number} = LaxNumber;
186 9         41 $keyword_map{integer} = LaxInteger;
187 9         32 $keyword_map{string} = LaxString;
188             }
189              
190              
191             return $keyword_map{$struct_type}
192 2006 100       24527 if $keyword_map{$struct_type};
193              
194 8 50       60 if( ref $struct_type eq 'ARRAY' ) {
195 8         33 return AnyOf[map { $self->_keyword_type($_) } @$struct_type];
  16         126  
196             }
197              
198 0         0 return;
199             }
200              
201             sub _keyword_multipleOf {
202 6     6   23 my( $self, $num ) = @_;
203              
204 6         41 MultipleOf[$num];
205             };
206              
207             sub _keyword_maxItems {
208 7     7   22 my( $self, $max ) = @_;
209              
210 7         48 MaxItems[$max];
211             }
212              
213             sub _keyword_minItems {
214 232     232   695 my( $self, $min ) = @_;
215              
216 232         1516 MinItems[$min];
217             }
218              
219             sub _keyword_maxLength {
220 8     8   26 my( $self, $max ) = @_;
221              
222 8         55 MaxLength[$max];
223             }
224              
225             sub _keyword_minLength {
226 10     10   33 my( $self, $min ) = @_;
227              
228 10         74 return MinLength[$min];
229             }
230              
231             sub _keyword_maximum {
232 13     13   39 my( $self, $maximum ) = @_;
233              
234             return $self->schema->{exclusiveMaximum}
235 13 100       318 ? ExclusiveMaximum[$maximum]
236             : Maximum[$maximum];
237              
238             }
239              
240             sub _keyword_minimum {
241 123     123   443 my( $self, $minimum ) = @_;
242              
243 123 100       3429 if ( $self->schema->{exclusiveMinimum} ) {
244 36         986 return ExclusiveMinimum[$minimum];
245             }
246              
247 87         1397 return Minimum[$minimum];
248             }
249              
250             sub _keyword_additionalItems {
251 12     12   42 my( $self, $s ) = @_;
252              
253 12 100       83 unless($s) {
254 9 100       359 my $items = $self->schema->{items} or return;
255 6 100       115 return if ref $items eq 'HASH'; # it's a schema, nevermind
256 3         9 my $size = @$items;
257              
258 3         21 return AdditionalItems[$size];
259             }
260              
261 3         17 my $schema = $self->sub_schema($s);
262              
263 3         83 my $to_skip = @{ $self->schema->{items} };
  3         74  
264              
265 3         171 return AdditionalItems[$to_skip,$schema];
266              
267             }
268              
269             sub _keyword_items {
270 289     289   800 my( $self, $items ) = @_;
271              
272 289 50       1567 if ( Boolean->check($items) ) {
273 0         0 return Items[$items];
274             }
275              
276 289 100       2223 if( ref $items eq 'HASH' ) {
277 279         1251 my $type = $self->sub_schema($items)->type;
278              
279 279         22312 return Items[$type];
280             }
281              
282             # TODO forward declaration not workie
283 10         27 my @types;
284 10         32 for ( @$items ) {
285 16         1498 push @types, $self->sub_schema($_)->type;
286             }
287              
288 10         1280 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 for '', 's';
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.4
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) 2024 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