File Coverage

blib/lib/JSV/Keyword/Draft4/Properties.pm
Criterion Covered Total %
statement 47 47 100.0
branch 10 10 100.0
condition 9 10 90.0
subroutine 7 7 100.0
pod 0 2 0.0
total 73 76 96.0


line stmt bran cond sub pod time code
1             package JSV::Keyword::Draft4::Properties;
2              
3 47     47   22232 use strict;
  47         57  
  47         1049  
4 47     47   139 use warnings;
  47         48  
  47         1004  
5 47     47   132 use parent qw(JSV::Keyword);
  47         48  
  47         217  
6              
7 47     47   1968 use JSV::Keyword qw(:constants);
  47         51  
  47         4243  
8 47     47   175 use JSV::Util::Type qw(detect_instance_type escape_json_pointer);
  47         53  
  47         18701  
9              
10             sub instance_type() { INSTANCE_TYPE_OBJECT(); }
11             sub keyword() { 'properties' }
12 328     328 0 618 sub additional_keywords() { [qw/additionalProperties patternProperties/]; }
13             sub keyword_priority() { 10; }
14              
15             sub validate {
16 226     226 0 229 my ($class, $context, $schema, $instance) = @_;
17              
18 226   100     399 my $properties = $class->keyword_value($schema) || {};
19 226   100     367 my $pattern_properties = $class->keyword_value($schema, "patternProperties") || {};
20              
21 226         237 my @patterns = ();
22 226         185 my @pattern_schemas = ();
23 226         168 my @original_patterns = ();
24 226         416 for my $pattern (keys %$pattern_properties) {
25 49         319 push(@patterns, qr/$pattern/);
26 49         62 push(@pattern_schemas, $pattern_properties->{$pattern});
27 49         62 push(@original_patterns, $pattern);
28             }
29              
30 226         345 my $additional_properties = $class->keyword_value($schema, "additionalProperties");
31 226         580 my $additional_properties_type = detect_instance_type($schema->{additionalProperties});
32 226         472 my %s = map { $_ => undef } keys %$instance;
  403         679  
33              
34 226         370 for my $property (keys %$instance) {
35 403         800 local $context->{current_pointer} = $context->{current_pointer} . "/" . escape_json_pointer( $property );
36              
37 403 100       640 if (exists $properties->{$property}) {
38             local $context->{current_schema_pointer} =
39 283         459 $context->{current_schema_pointer} . "/properties/" . escape_json_pointer( $property );
40 283         639 $context->validate($properties->{$property}, $instance->{$property});
41 283         428 delete $s{$property};
42             }
43              
44 403         790 for (my $i = 0, my $l = scalar(@patterns); $i < $l; $i++) {
45 49 100       218 next unless ($property =~ m/$patterns[$i]/);
46             local $context->{current_schema_pointer} =
47 19         47 $context->{current_schema_pointer} . "/patternProperties/" . escape_json_pointer( $original_patterns[$i] );
48 19         45 $context->validate($pattern_schemas[$i], $instance->{$property});
49 19         45 delete $s{$property};
50             }
51              
52 403 100 100     1066 if (exists $s{$property} && $additional_properties_type eq "object") {
53             local $context->{current_schema_pointer} =
54 13         25 $context->{current_schema_pointer} . "/additionalProperties";
55 13         27 $context->validate($additional_properties, $instance->{$property});
56             }
57             }
58              
59 226 100 66     780 if ($additional_properties_type eq "boolean" && !$additional_properties) {
60 16 100       101 if (keys %s > 0) {
61             # TODO: provide pointer for each extra property
62             # (to avoid parsing error message and don't depend on its format)
63 6         33 $context->log_error(sprintf("Not allowed properties exist (properties: %s)", join(", ", keys %s)));
64             }
65             }
66             }
67              
68             1;