File Coverage

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