File Coverage

blib/lib/JSONSchema/Validator/Constraints/Draft4.pm
Criterion Covered Total %
statement 333 366 90.9
branch 140 192 72.9
condition 19 33 57.5
subroutine 40 42 95.2
pod 0 32 0.0
total 532 665 80.0


line stmt bran cond sub pod time code
1             package JSONSchema::Validator::Constraints::Draft4;
2              
3             # ABSTRACT: JSON Schema Draft4 specification constraints
4              
5 6     6   42 use strict;
  6         14  
  6         173  
6 6     6   31 use warnings;
  6         12  
  6         203  
7 6     6   30 use Scalar::Util 'weaken';
  6         11  
  6         213  
8 6     6   31 use URI;
  6         10  
  6         104  
9 6     6   25 use Carp 'croak';
  6         12  
  6         216  
10              
11 6     6   36 use JSONSchema::Validator::Error 'error';
  6         23  
  6         247  
12 6     6   38 use JSONSchema::Validator::JSONPointer 'json_pointer';
  6         20  
  6         275  
13 6     6   2680 use JSONSchema::Validator::Util qw(serialize unbool round is_type detect_type);
  6         17  
  6         606  
14 6         2319 use JSONSchema::Validator::Format qw(
15             validate_date_time validate_date validate_time
16             validate_email validate_hostname
17             validate_idn_email
18             validate_ipv4 validate_ipv6
19             validate_uuid
20             validate_byte
21             validate_int32 validate_int64
22             validate_float validate_double
23             validate_regex
24             validate_json_pointer validate_relative_json_pointer
25             validate_uri validate_uri_reference
26             validate_iri validate_iri_reference
27             validate_uri_template
28 6     6   3093 );
  6         25  
29              
30 6         21772 use constant FORMAT_VALIDATIONS => {
31             'date-time' => ['string', \&validate_date_time],
32             'date' => ['string', \&validate_date],
33             'time' => ['string', \&validate_time],
34             'email' => ['string', \&validate_email],
35             'idn-email' => ['string', \&validate_idn_email],
36             'hostname' => ['string', \&validate_hostname],
37             'ipv4' => ['string', \&validate_ipv4],
38             'ipv6' => ['string', \&validate_ipv6],
39             'uuid' => ['string', \&validate_uuid],
40             'byte' => ['string', \&validate_byte],
41             'int32' => ['integer', \&validate_int32],
42             'int64' => ['integer', \&validate_int64],
43             'float' => ['number', \&validate_float],
44             'double' => ['number', \&validate_double],
45             'regex' => ['string', \&validate_regex],
46             'json-pointer' => ['string', \&validate_json_pointer],
47             'relative-json-pointer' => ['string', \&validate_relative_json_pointer],
48             'uri' => ['string', \&validate_uri],
49             'uri-reference' => ['string', \&validate_uri_reference],
50             'iri' => ['string', \&validate_iri],
51             'iri-reference' => ['string', \&validate_iri_reference],
52             'uri-template' => ['string', \&validate_uri_template]
53 6     6   65 };
  6         14  
54              
55             sub new {
56 321     321 0 1058 my ($class, %params) = @_;
57              
58 321 50       940 my $validator = $params{validator} or croak 'validator is required';
59 321   50     877 my $strict = $params{strict} // 1;
60              
61 321         940 weaken($validator);
62              
63 321         1066 my $self = {
64             validator => $validator,
65             errors => [],
66             strict => $strict
67             };
68              
69 321         648 bless $self, $class;
70              
71 321         887 return $self;
72             }
73              
74 3467     3467 0 9691 sub validator { shift->{validator} }
75 2993     2993 0 9295 sub strict { shift->{strict} }
76              
77             # params: $self, $value, $type, $strict
78             sub check_type {
79 4285   100 4285 0 11707 return is_type($_[1], $_[2], $_[3] // $_[0]->strict);
80             }
81              
82             sub type {
83 835     835 0 2032 my ($self, $instance, $types, $schema, $instance_path, $schema_path, $data) = @_;
84 835 100       1927 my @types = ref $types ? @$types : ($types);
85              
86 835 100       1396 return 1 if grep { $self->check_type($instance, $_) } @types;
  897         1942  
87              
88 135         222 push @{$data->{errors}}, error(
  135         488  
89             message => "type mismatch",
90             instance_path => $instance_path,
91             schema_path => $schema_path
92             );
93 135         432 return 0;
94             }
95              
96             sub minimum {
97 25     25 0 86 my ($self, $instance, $minimum, $schema, $instance_path, $schema_path, $data) = @_;
98 25 100       65 return 1 unless $self->check_type($instance, 'number');
99 24 100       96 return 1 if $instance >= $minimum;
100 7         19 push @{$data->{errors}}, error(
  7         72  
101             message => "${instance} is less than ${minimum}",
102             instance_path => $instance_path,
103             schema_path => $schema_path
104             );
105 7         28 return 0;
106             }
107              
108             sub maximum {
109 13     13 0 43 my ($self, $instance, $maximum, $schema, $instance_path, $schema_path, $data) = @_;
110 13 50       41 return 1 unless $self->check_type($instance, 'number');
111 13 100       51 return 1 if $instance <= $maximum;
112 3         6 push @{$data->{errors}}, error(
  3         26  
113             message => "${instance} is greater than ${maximum}",
114             instance_path => $instance_path,
115             schema_path => $schema_path
116             );
117 3         12 return 0;
118             }
119              
120             sub exclusiveMaximum {
121 0     0 0 0 my ($self, $instance, $exclusiveMaximum, $schema, $instance_path, $schema_path, $data) = @_;
122 0 0       0 return 1 unless $self->check_type($instance, 'number');
123 0 0       0 return 1 unless exists $schema->{maximum};
124              
125 0         0 my $maximum = $schema->{maximum};
126              
127 0         0 my $res = $self->maximum($instance, $maximum, $schema, $instance_path, $schema_path, $data);
128 0 0       0 return 0 unless $res;
129              
130 0 0       0 return 1 unless $exclusiveMaximum;
131 0 0       0 return 1 if $instance != $maximum;
132              
133 0         0 push @{$data->{errors}}, error(
  0         0  
134             message => "${instance} is equal to ${maximum}",
135             instance_path => $instance_path,
136             schema_path => $schema_path
137             );
138 0         0 return 0;
139             }
140              
141             sub exclusiveMinimum {
142 0     0 0 0 my ($self, $instance, $exclusiveMinimum, $schema, $instance_path, $schema_path, $data) = @_;
143 0 0       0 return 1 unless $self->check_type($instance, 'number');
144 0 0       0 return 1 unless exists $schema->{minimum};
145              
146 0         0 my $minimum = $schema->{minimum};
147              
148 0         0 my $res = $self->minimum($instance, $minimum, $schema, $instance_path, $schema_path, $data);
149 0 0       0 return 0 unless $res;
150              
151 0 0       0 return 1 unless $exclusiveMinimum;
152 0 0       0 return 1 if $instance != $minimum;
153              
154 0         0 push @{$data->{errors}}, error(
  0         0  
155             message => "${instance} is equal to ${minimum}",
156             instance_path => $instance_path,
157             schema_path => $schema_path
158             );
159 0         0 return 0;
160             }
161              
162             sub minItems {
163 16     16 0 61 my ($self, $instance, $min, $schema, $instance_path, $schema_path, $data) = @_;
164 16 50       57 return 1 unless $self->check_type($instance, 'array');
165 16 100       87 return 1 if scalar(@$instance) >= $min;
166 1         2 push @{$data->{errors}}, error(
  1         8  
167             message => "minItems (>= ${min}) constraint violated",
168             instance_path => $instance_path,
169             schema_path => $schema_path
170             );
171 1         3 return 0;
172             }
173              
174             sub maxItems {
175 4     4 0 12 my ($self, $instance, $max, $schema, $instance_path, $schema_path, $data) = @_;
176 4 100       12 return 1 unless $self->check_type($instance, 'array');
177 3 100       14 return 1 if scalar(@$instance) <= $max;
178 1         3 push @{$data->{errors}}, error(
  1         7  
179             message => "maxItems (<= ${max}) constraint violated",
180             instance_path => $instance_path,
181             schema_path => $schema_path
182             );
183 1         4 return 0;
184             }
185              
186             sub minLength {
187 3     3 0 10 my ($self, $instance, $min, $schema, $instance_path, $schema_path, $data) = @_;
188 3 50       9 return 1 unless $self->check_type($instance, 'string');
189 3 100       14 return 1 if length $instance >= $min;
190 1         2 push @{$data->{errors}}, error(
  1         6  
191             message => "minLength (>= ${min}) constraint violated",
192             instance_path => $instance_path,
193             schema_path => $schema_path
194             );
195 1         4 return 0;
196             }
197              
198             sub maxLength {
199 4     4 0 12 my ($self, $instance, $max, $schema, $instance_path, $schema_path, $data) = @_;
200 4 100       12 return 1 unless $self->check_type($instance, 'string');
201 3 100       13 return 1 if length $instance <= $max;
202 1         2 push @{$data->{errors}}, error(
  1         8  
203             message => "maxLength (<= ${max}) constraint violated",
204             instance_path => $instance_path,
205             schema_path => $schema_path
206             );
207 1         30 return 0;
208             }
209              
210             sub dependencies {
211 37     37 0 110 my ($self, $instance, $dependencies, $schema, $instance_path, $schema_path, $data) = @_;
212              
213             # ignore non-object
214 37 100       184 return 1 unless $self->check_type($instance, 'object');
215              
216 34         88 my $result = 1;
217              
218 34         114 for my $prop (keys %$dependencies) {
219 64 100       161 next unless exists $instance->{$prop};
220 2         5 my $dep = $dependencies->{$prop};
221 2         6 my $spath = json_pointer->append($schema_path, $prop);
222              
223             # need strict check beacase of schema check
224 2 50       6 if ($self->check_type($dep, 'array', 1)) {
225 2         4 for my $idx (0 .. $#{$dep}) {
  2         7  
226 2         6 my $p = $dep->[$idx];
227 2 100       36 next if exists $instance->{$p};
228              
229 1         2 push @{$data->{errors}}, error(
  1         7  
230             message => "dependencies constraint violated: property $p is ommited",
231             instance_path => $instance_path,
232             schema_path => json_pointer->append($spath, $idx)
233             );
234 1         4 $result = 0;
235             }
236             } else {
237             # $dep is object or boolean (starting draft 6 boolean is valid schema)
238 0         0 my $r = $self->validator->_validate_schema($instance, $dep, $instance_path, $spath, $data);
239 0 0       0 $result = 0 unless $r;
240             }
241             }
242              
243 34         117 return $result;
244             }
245              
246             sub additionalItems {
247 10     10 0 29 my ($self, $instance, $additionalItems, $schema, $instance_path, $schema_path, $data) = @_;
248 10 50       34 return 1 unless $self->check_type($instance, 'array');
249             # need strict check beacase of schema check
250 10 50 50     36 return 1 if $self->check_type($schema->{items} // {}, 'object', 1);
251              
252 10         20 my $len_items = scalar @{$schema->{items}};
  10         21  
253              
254             # need strict check beacase of schema check
255 10 100       22 if ($self->check_type($additionalItems, 'boolean', 1)) {
256 8 50       54 return 1 if $additionalItems;
257 8 100       83 if (scalar @$instance > $len_items) {
258 2         4 push @{$data->{errors}}, error(
  2         10  
259             message => 'additionalItems constraint violated',
260             instance_path => $instance_path,
261             schema_path => $schema_path
262             );
263 2         8 return 0;
264             }
265              
266 6         21 return 1;
267             }
268              
269             # additionalItems is object
270              
271 2         4 my $result = 1;
272 2         5 my @items_last_part = @$instance[$len_items .. $#{$instance}];
  2         9  
273              
274 2         7 for my $index (0 .. $#items_last_part) {
275 6         12 my $item = $items_last_part[$index];
276              
277 6         15 my $ipath = json_pointer->append($instance_path, $len_items + $index);
278 6         16 my $r = $self->validator->_validate_schema($item, $additionalItems, $ipath, $schema_path, $data);
279 6 100       15 $result = 0 unless $r;
280             }
281              
282 2         7 return $result;
283             }
284              
285             sub additionalProperties {
286 143     143 0 345 my ($self, $instance, $addProps, $schema, $instance_path, $schema_path, $data) = @_;
287 143 100       296 return 1 unless $self->check_type($instance, 'object');
288              
289 137   100     607 my $patterns = join '|', keys %{$schema->{patternProperties} // {}};
  137         527  
290              
291 137         268 my @extra_props;
292 137         364 for my $p (keys %$instance) {
293 235 100 100     695 next if $schema->{properties} && exists $schema->{properties}{$p};
294 99 100 100     626 next if $patterns && $p =~ m/$patterns/u;
295 87         194 push @extra_props, $p;
296             }
297              
298 137 100       405 return 1 unless @extra_props;
299              
300             # need strict check beacase of schema check
301 57 100       141 if ($self->check_type($addProps, 'object', 1)) {
302 39         82 my $result = 1;
303 39         77 for my $p (@extra_props) {
304 69         181 my $ipath = json_pointer->append($instance_path, $p);
305 69         183 my $r = $self->validator->_validate_schema($instance->{$p}, $addProps, $ipath, $schema_path, $data);
306 69 100       190 $result = 0 unless $r;
307             }
308 39         124 return $result;
309             }
310              
311             # addProps is boolean
312              
313 18 50       95 return 1 if $addProps;
314              
315 18         155 push @{$data->{errors}}, error(
  18         86  
316             message => 'additionalProperties constraint violated; properties: ' . join(', ', @extra_props),
317             instance_path => $instance_path,
318             schema_path => $schema_path
319             );
320 18         58 return 0;
321             }
322              
323             sub allOf {
324 69     69 0 172 my ($self, $instance, $allOf, $schema, $instance_path, $schema_path, $data) = @_;
325              
326 69         131 my $result = 1;
327 69         108 for my $idx (0 .. $#{$allOf}) {
  69         202  
328 160         272 my $subschema = $allOf->[$idx];
329 160         353 my $spath = json_pointer->append($schema_path, $idx);
330 160         337 my $r = $self->validator->_validate_schema($instance, $subschema, $instance_path, $spath, $data);
331 160 100       385 $result = 0 unless $r;
332             }
333              
334 69         155 return $result;
335             }
336              
337             sub anyOf {
338 68     68 0 206 my ($self, $instance, $anyOf, $schema, $instance_path, $schema_path, $data) = @_;
339              
340 68         150 my $errors = $data->{errors};
341 68         161 my $local_errors = [];
342              
343 68         133 my $result = 0;
344 68         228 for my $idx (0 .. $#$anyOf) {
345 70         149 $data->{errors} = [];
346 70         179 my $spath = json_pointer->append($schema_path, $idx);
347 70         189 $result = $self->validator->_validate_schema($instance, $anyOf->[$idx], $instance_path, $spath, $data);
348 70 100       169 unless ($result) {
349 3         14 push @{$local_errors}, error(
350             message => qq'${idx} part of "anyOf" has errors',
351             context => $data->{errors},
352 3         5 instance_path => $instance_path,
353             schema_path => $spath
354             );
355             }
356 70 100       209 last if $result;
357             }
358 68         164 $data->{errors} = $errors;
359 68 100       221 return 1 if $result;
360              
361 1         2 push @{$data->{errors}}, error(
  1         5  
362             message => 'instance does not satisfy any schema of "anyOf"',
363             context => $local_errors,
364             instance_path => $instance_path,
365             schema_path => $schema_path
366             );
367 1         3 return 0;
368             }
369              
370             sub oneOf {
371 64     64 0 133 my ($self, $instance, $oneOf, $schema, $instance_path, $schema_path, $data) = @_;
372              
373 64         100 my $errors = $data->{errors};
374 64         127 my ($local_errors, $valid_schemas) = ([], []);
375              
376 64         94 my $num = 0;
377 64         145 for my $idx (0 .. $#$oneOf) {
378 136         255 $data->{errors} = [];
379 136         287 my $spath = json_pointer->append($schema_path, $idx);
380 136         293 my $r = $self->validator->_validate_schema($instance, $oneOf->[$idx], $instance_path, $spath, $data);
381 136 100       262 if ($r) {
382 64         77 push @{$valid_schemas}, $spath;
  64         133  
383             } else {
384 72         249 push @{$local_errors}, error(
385             message => qq'${idx} part of "oneOf" has errors',
386             context => $data->{errors},
387 72         93 instance_path => $instance_path,
388             schema_path => $spath
389             );
390             }
391 136 100       341 ++$num if $r;
392             }
393 64         111 $data->{errors} = $errors;
394 64 100       297 return 1 if $num == 1;
395              
396 2 100       6 if ($num > 1) {
397 1         3 push @{$data->{errors}}, error(
  1         7  
398             message => 'instance is valid under more than one schema of "oneOf": ' . join(' ', @$valid_schemas),
399             instance_path => $instance_path,
400             schema_path => $schema_path
401             );
402             } else {
403 1         2 push @{$data->{errors}}, error(
  1         7  
404             message => 'instance is not valid under any of given schemas of "oneOf"',
405             context => $local_errors,
406             instance_path => $instance_path,
407             schema_path => $schema_path
408             );
409             }
410              
411 2         9 return 0;
412             }
413              
414             sub enum {
415 181     181 0 457 my ($self, $instance, $enum, $schema, $instance_path, $schema_path, $data) = @_;
416              
417 181         321 my $result = 0;
418 181         400 for my $e (@$enum) {
419             # schema must have strict check
420 601 100 33     1290 if ($self->check_type($e, 'boolean', 1)) {
    50 33        
    100 0        
    50          
    0          
421 4 50       73 $result = $self->check_type($instance, 'boolean')
422             ? unbool($instance) eq unbool($e)
423             : 0
424             } elsif ($self->check_type($e, 'object', 1) || $self->check_type($e, 'array', 1)) {
425 0 0 0     0 $result = $self->check_type($instance, 'object') ||
426             $self->check_type($instance, 'array')
427             ? serialize($instance) eq serialize($e)
428             : 0;
429             } elsif ($self->check_type($e, 'number', 1)) {
430 4 50       10 $result = $self->check_type($instance, 'number')
431             ? $e == $instance
432             : 0;
433             } elsif (defined $e && defined $instance) {
434 593         1141 $result = $e eq $instance;
435             } elsif (!defined $e && !defined $instance) {
436 0         0 $result = 1;
437             } else {
438 0         0 $result = 0;
439             }
440 601 100       1438 last if $result;
441             }
442              
443 181 100       550 return 1 if $result;
444              
445 19         28 push @{$data->{errors}}, error(
  19         55  
446             message => "instance is not of enums",
447             instance_path => $instance_path,
448             schema_path => $schema_path
449             );
450 19         58 return 0;
451             }
452              
453             sub items {
454 49     49 0 178 my ($self, $instance, $items, $schema, $instance_path, $schema_path, $data) = @_;
455 49 100       127 return 1 unless $self->check_type($instance, 'array');
456              
457 47         107 my $result = 1;
458 47 100       108 if ($self->check_type($items, 'array', 1)) {
459 10 100       14 my $min = $#{$items} > $#{$instance} ? $#{$instance} : $#{$items};
  10         19  
  10         23  
  2         5  
  8         17  
460 10         32 for my $i (0 .. $min) {
461 17         33 my $item = $instance->[$i];
462 17         27 my $subschema = $items->[$i];
463 17         42 my $spath = json_pointer->append($schema_path, $i);
464 17         41 my $ipath = json_pointer->append($instance_path, $i);
465 17         44 my $r = $self->validator->_validate_schema($item, $subschema, $ipath, $spath, $data);
466 17 50       50 $result = 0 unless $r;
467             }
468             } else {
469             # items is object
470 37         73 for my $i (0 .. $#{$instance}) {
  37         128  
471 71         147 my $item = $instance->[$i];
472 71         166 my $ipath = json_pointer->append($instance_path, $i);
473 71         250 my $r = $self->validator->_validate_schema($item, $items, $ipath, $schema_path, $data);
474 71 100       237 $result = 0 unless $r;
475             }
476             }
477 47         125 return $result;
478             }
479              
480             sub format {
481 53     53 0 165 my ($self, $instance, $format, $schema, $instance_path, $schema_path, $data) = @_;
482 53 50       178 return 1 unless exists FORMAT_VALIDATIONS->{$format};
483              
484 53         79 my ($type, $checker) = @{FORMAT_VALIDATIONS->{$format}};
  53         182  
485 53 100       457 return 1 unless $self->check_type($instance, $type);
486              
487 48         287 my $result = $checker->($instance);
488 48 50       279 return 1 if $result;
489              
490 0         0 push @{$data->{errors}}, error(
  0         0  
491             message => "instance is not $format",
492             instance_path => $instance_path,
493             schema_path => $schema_path
494             );
495 0         0 return 0;
496             }
497              
498             sub maxProperties {
499 2     2 0 8 my ($self, $instance, $maxProperties, $schema, $instance_path, $schema_path, $data) = @_;
500 2 50       21 return 1 unless $self->check_type($instance, 'object');
501 2 100       12 return 1 if scalar(keys %$instance) <= $maxProperties;
502              
503 1         2 push @{$data->{errors}}, error(
  1         7  
504             message => "instance has more than $maxProperties properties",
505             instance_path => $instance_path,
506             schema_path => $schema_path
507             );
508 1         3 return 0;
509             }
510              
511             sub minProperties {
512 7     7 0 34 my ($self, $instance, $minProperties, $schema, $instance_path, $schema_path, $data) = @_;
513 7 50       20 return 1 unless $self->check_type($instance, 'object');
514 7 100       35 return 1 if scalar(keys %$instance) >= $minProperties;
515              
516 1         2 push @{$data->{errors}}, error(
  1         8  
517             message => "instance has less than $minProperties properties",
518             instance_path => $instance_path,
519             schema_path => $schema_path
520             );
521 1         4 return 0;
522             }
523              
524             sub multipleOf {
525 5     5 0 15 my ($self, $instance, $multipleOf, $schema, $instance_path, $schema_path, $data) = @_;
526 5 50       17 return 1 unless $self->check_type($instance, 'number');
527              
528 5         11 my $result = 1;
529              
530 5         12 my $div = $instance / $multipleOf;
531 5 100 66     28 $result = 0 if $div == 'Inf' || int($div) != $div;
532              
533 5 100       15 return 1 if $result;
534              
535 2         4 push @{$data->{errors}}, error(
  2         15  
536             message => "instance is not multiple of $multipleOf",
537             instance_path => $instance_path,
538             schema_path => $schema_path
539             );
540 2         7 return 0;
541             }
542              
543             sub not {
544 62     62 0 123 my ($self, $instance, $not, $schema, $instance_path, $schema_path, $data) = @_;
545              
546 62         95 my $errors = $data->{errors};
547 62         99 $data->{errors} = [];
548              
549             # not is schema
550 62         116 my $result = $self->validator->_validate_schema($instance, $not, $instance_path, $schema_path, $data);
551 62         165 $data->{errors} = $errors;
552 62 100       157 return 1 unless $result;
553              
554 1         3 push @{$data->{errors}}, error(
  1         5  
555             message => 'instance satisfies the schema defined in \"not\" keyword',
556             instance_path => $instance_path,
557             schema_path => $schema_path
558             );
559 1         5 return 0;
560             }
561              
562             sub pattern {
563 15     15 0 57 my ($self, $instance, $pattern, $schema, $instance_path, $schema_path, $data) = @_;
564 15 50       55 return 1 unless $self->check_type($instance, 'string');
565 15 100       219 return 1 if $instance =~ m/$pattern/u;
566              
567 4         12 push @{$data->{errors}}, error(
  4         28  
568             message => "instance does not match $pattern",
569             instance_path => $instance_path,
570             schema_path => $schema_path
571             );
572 4         17 return 0;
573             }
574              
575             sub patternProperties {
576 135     135 0 275 my ($self, $instance, $patternProperties, $schema, $instance_path, $schema_path, $data) = @_;
577 135 50       254 return 1 unless $self->check_type($instance, 'object');
578              
579 135         228 my $result = 1;
580 135         313 for my $pattern (keys %$patternProperties) {
581 147         219 my $subschema = $patternProperties->{$pattern};
582 147         305 my $spath = json_pointer->append($schema_path, $pattern);
583 147         334 for my $k (keys %$instance) {
584 260         404 my $v = $instance->{$k};
585 260 100       1913 if ($k =~ m/$pattern/u) {
586 35         109 my $ipath = json_pointer->append($instance_path, $k);
587 35         83 my $r = $self->validator->_validate_schema($v, $subschema, $ipath, $spath, $data);
588 35 100       135 $result = 0 unless $r;
589             }
590             }
591             }
592 135         313 return $result;
593             }
594              
595             sub properties {
596 413     413 0 1044 my ($self, $instance, $properties, $schema, $instance_path, $schema_path, $data) = @_;
597 413 100       1000 return 1 unless $self->check_type($instance, 'object');
598              
599 412         1154 my $result = 1;
600 412         1835 for my $prop (keys %$properties) {
601 5323 100       9618 next unless exists $instance->{$prop};
602              
603 693         1208 my $subschema = $properties->{$prop};
604 693         1539 my $spath = json_pointer->append($schema_path, $prop);
605 693         1614 my $ipath = json_pointer->append($instance_path, $prop);
606 693         1646 my $r = $self->validator->_validate_schema($instance->{$prop}, $subschema, $ipath, $spath, $data);
607 693 100       1839 $result = 0 unless $r;
608             }
609 412         1173 return $result;
610             }
611              
612             sub required {
613 181     181 0 375 my ($self, $instance, $required, $schema, $instance_path, $schema_path, $data) = @_;
614 181 50       359 return 1 unless $self->check_type($instance, 'object');
615              
616 181         297 my $result = 1;
617 181         255 for my $idx (0 .. $#{$required}) {
  181         411  
618 240         387 my $prop = $required->[$idx];
619 240 100       527 next if exists $instance->{$prop};
620 131         176 push @{$data->{errors}}, error(
  131         379  
621             message => qq{instance does not have required property "$prop"},
622             instance_path => $instance_path,
623             schema_path => json_pointer->append($schema_path, $idx)
624             );
625 131         312 $result = 0;
626             }
627 181         390 return $result;
628             }
629              
630             # doesn't work for string that looks like number with the same number in array
631             sub uniqueItems {
632 24     24 0 74 my ($self, $instance, $uniqueItems, $schema, $instance_path, $schema_path, $data) = @_;
633 24 50       73 return 1 unless $self->check_type($instance, 'array');
634             # uniqueItems is boolean
635 24 50       182 return 1 unless $uniqueItems;
636              
637             my %hash = map {
638 24         235 my $type = detect_type($_, $self->strict);
  45         98  
639              
640 45         80 my $value;
641 45 100 66     313 if ($type eq 'null') {
    100          
    100          
642 1         2 $value = ''
643             } elsif ($type eq 'object' || $type eq 'array') {
644 4         15 $value = serialize($_);
645             } elsif ($type eq 'boolean') {
646 10         27 $value = "$_";
647             } else {
648             # integer/number/string
649 30         64 $value = $_;
650             }
651              
652 45         147 my $key = "${type}#${value}";
653 45         249 $key => 1;
654             } @$instance;
655 24 100       142 return 1 if scalar(keys %hash) == scalar @$instance;
656 2         3 push @{$data->{errors}}, error(
  2         10  
657             message => "instance has non-unique elements",
658             instance_path => $instance_path,
659             schema_path => $schema_path
660             );
661 2         9 return 0;
662             }
663              
664             sub ref {
665 388     388 0 912 my ($self, $instance, $ref, $origin_schema, $instance_path, $schema_path, $data) = @_;
666              
667 388         757 my $scope = $self->validator->scope;
668 388         1235 $ref = URI->new($ref);
669 388 100       16352 $ref = $ref->abs($scope) if $scope;
670              
671 388         74607 my ($current_scope, $schema) = $self->validator->resolver->resolve($ref);
672              
673 388 50       1853 croak "schema not resolved by ref $ref" unless $schema;
674              
675 388         641 push @{$self->validator->scopes}, $current_scope;
  388         735  
676              
677 388         639 my $result = eval {
678 388         721 $self->validator->_validate_schema($instance, $schema, $instance_path, $schema_path, $data, apply_scope => 0);
679             };
680              
681 388 50       829 if ($@) {
682 0         0 $result = 0;
683 0         0 push @{$data->{errors}}, error(
  0         0  
684             message => "exception: $@",
685             instance_path => $instance_path,
686             schema_path => $schema_path
687             );
688             }
689              
690 388         549 pop @{$self->validator->scopes};
  388         763  
691              
692 388         1192 return $result;
693             }
694              
695             1;
696              
697             __END__