our $VERSION = '0.609';
use 5.020;
no autovivification warn => qw(fetch store exists delete);
use if "$]" >= 5.022, experimental => 're_strict';
no if "$]" >= 5.031009, feature => 'indirect';
no if "$]" >= 5.033001, feature => 'multidimensional';
no if "$]" >= 5.033006, feature => 'bareword_filehandles';
sub vocabulary ($class) {
}
sub evaluation_order ($class) { 7 }
sub keywords ($class, $spec_version) {
die 'Unevaluated not implemented in '.$spec_version if $spec_version =~ /^draft(?:[467]|2019-09)$/;
qw(unevaluatedItems unevaluatedProperties);
}
sub _traverse_keyword_unevaluatedItems ($class, $schema, $state) {
$class->traverse_subschema($schema, $state);
}
sub _eval_keyword_unevaluatedItems ($class, $data, $schema, $state) {
die '"unevaluatedItems" keyword present, but annotation collection is disabled'
if not $state->{collect_annotations};
die '"unevaluatedItems" keyword present, but short_circuit is enabled: results unreliable'
if $state->{short_circuit};
return 1 if not is_type('array', $data);
my @annotations = local_annotations($state);
my @boolean_annotation_keywords =
$state->{spec_version} eq 'draft2019-09' ? qw(items additionalItems unevaluatedItems)
: qw(prefixItems items contains unevaluatedItems);
my %bools; @bools{@boolean_annotation_keywords} = (1)x@boolean_annotation_keywords;
return 1
if any { $bools{$_->{keyword}} && is_type('boolean', $_->{annotation}) && $_->{annotation} }
@annotations;
my $max_index_annotation_keyword = $state->{spec_version} eq 'draft2019-09' ? 'items' : 'prefixItems';
my $last_index = max(-1, grep is_type('integer', $_),
map +($_->{keyword} eq $max_index_annotation_keyword ? $_->{annotation} : ()), @annotations);
return 1 if $last_index == $data->$
my @contains_annotation_indexes = $state->{spec_version} eq 'draft2019-09' ? ()
: map +($_->{keyword} eq 'contains' ? $_->{annotation}->@* : ()), @annotations;
my $valid = 1;
foreach my $idx ($last_index+1 .. $data->$
next if any { $idx == $_ } @contains_annotation_indexes;
if (is_type('boolean', $schema->{unevaluatedItems})) {
next if $schema->{unevaluatedItems};
$valid = E({ %$state, data_path => $state->{data_path}.'/'.$idx },
'additional item not permitted')
}
else {
if ($class->eval($data->[$idx], $schema->{unevaluatedItems},
+{ %$state, data_path => $state->{data_path}.'/'.$idx,
schema_path => $state->{schema_path}.'/unevaluatedItems',
collect_annotations => $state->{collect_annotations} & ~1 })) {
next;
}
$valid = 0;
}
last if $state->{short_circuit};
}
A($state, true);
return E($state, 'subschema is not valid against all additional items') if not $valid;
return 1;
}
sub _traverse_keyword_unevaluatedProperties ($class, $schema, $state) {
$class->traverse_subschema($schema, $state);
}
sub _eval_keyword_unevaluatedProperties ($class, $data, $schema, $state) {
die '"unevaluatedProperties" keyword present, but annotation collection is disabled'
if not $state->{collect_annotations};
die '"unevaluatedProperties" keyword present, but short_circuit is enabled: results unreliable'
if $state->{short_circuit};
return 1 if not is_type('object', $data);
my @evaluated_properties = map {
my $keyword = $_->{keyword};
(grep $keyword eq $_, qw(properties additionalProperties patternProperties unevaluatedProperties))
? $_->{annotation}->@* : ();
} local_annotations($state);
my $valid = 1;
my @properties;
foreach my $property (sort keys %$data) {
next if any { $_ eq $property } @evaluated_properties;
push @properties, $property;
if (is_type('boolean', $schema->{unevaluatedProperties})) {
next if $schema->{unevaluatedProperties};
$valid = E({ %$state, data_path => jsonp($state->{data_path}, $property) },
'additional property not permitted');
}
else {
if ($class->eval($data->{$property}, $schema->{unevaluatedProperties},
+{ %$state, data_path => jsonp($state->{data_path}, $property),
schema_path => $state->{schema_path}.'/unevaluatedProperties',
collect_annotations => $state->{collect_annotations} & ~1 })) {
next;
}
$valid = 0;
}
last if $state->{short_circuit};
}
A($state, \@properties);
return E($state, 'not all additional properties are valid') if not $valid;
return 1;
}
1;