Validate: Allow multiple func validations in arrayref schema

This commit is contained in:
Yorhel 2025-03-14 09:25:56 +01:00
parent 1363e11269
commit f248a33c1c
2 changed files with 41 additions and 28 deletions

View file

@ -23,10 +23,10 @@ my %unknown_vals = map +($_,1), qw/remove reject pass/;
my %missing_vals = map +($_,1), qw/create reject ignore/;
sub _length($exp, $min, $max) {
+{ func => sub($v) {
[ func => sub($v) {
my $got = ref $v eq 'HASH' ? keys %$v : ref $v eq 'ARRAY' ? @$v : length $v;
(!defined $min || $got >= $min) && (!defined $max || $got <= $max) ? 1 : { expected => $exp, got => $got };
}}
}]
}
# Basically the same as ( regex => $arg ), but hides the regex error
@ -100,7 +100,15 @@ our %default_validations = (
sub _compile($schema, $validations, $rec) {
my(%top, @val);
for my($name, $val) (ref $schema eq 'ARRAY' ? @$schema : %$schema) {
# 'func' is always evaluated last in hashref schemas.
my $func = ref $schema eq 'HASH' && $schema->{func};
for my($name, $val) (ref $schema eq 'HASH' ? %$schema : @$schema) {
if ($name eq 'func') {
push @val, $val if !$func;
next;
}
if ($builtin{$name}) {
confess "Invalid value for 'type': $val" if $name eq 'type' && !$type_vals{$val};
confess "Invalid value for 'missing': $val" if $name eq 'missing' && !$missing_vals{$val};
@ -112,13 +120,15 @@ sub _compile($schema, $validations, $rec) {
my $t = $validations->{$name} || $default_validations{$name};
confess "Unknown validation: $name" if !$t;
confess "Recursion limit exceeded while resolving validation '$name'" if $rec < 1;
$t = ref $t eq 'HASH' ? $t : $t->($val);
$t = ref $t eq 'CODE' ? $t->($val) : $t;
my $v = _compile($t, $validations, $rec-1);
$v->{name} = $name;
push @val, $v;
}
push @val, $func if $func;
my @keys = keys $top{keys}->%* if $top{keys};
for my ($n,$t) (qw/keys hash unknown hash values array sort array unique array/) {
@ -128,7 +138,7 @@ sub _compile($schema, $validations, $rec) {
}
# Inherit some builtin options from validations
for my $t (@val) {
for my $t (grep ref $_ eq 'HASH', @val) {
if ($top{type} && $t->{type} && $top{type} ne $t->{type}) {
confess "Incompatible types, the schema specifies '$top{type}' but validation '$t->{name}' requires '$t->{type}'" if $schema->{type};
confess "Incompatible types, '$t->[0]' requires '$t->{type}', but another validation requires '$top{type}'";
@ -213,21 +223,20 @@ sub _validate_rec {
}
# validations
for ($c->{validations}->@*) {
my $r = _validate_rec($_, $_[1]);
return {
# If the error was a custom 'func' object, then make that the primary cause.
# This makes it possible for validations to provide their own error objects.
$r->{validation} eq 'func' && (!exists $r->{result} || keys $r->%* > 2) ? $r->%* : (error => $r),
validation => $_->{name},
} if $r;
}
# func
if ($c->{func}) {
my $r = $c->{func}->($_[1]);
return { %$r, validation => 'func' } if ref $r eq 'HASH';
return { validation => 'func', result => $r } if !$r;
for my $v ($c->{validations}->@*) {
if (ref $v eq 'CODE') {
my $r = $v->($_[1]);
return { %$r, validation => 'func' } if ref $r eq 'HASH';
return { validation => 'func', result => $r } if !$r;
} else {
my $r = _validate_rec($v, $_[1]);
return {
# If the error was a custom 'func' object, then make that the primary cause.
# This makes it possible for validations to provide their own error objects.
$r->{validation} eq 'func' && (!exists $r->{result} || keys $r->%* > 2) ? $r->%* : (error => $r),
validation => $v->{name},
} if $r;
}
}
}
@ -669,10 +678,10 @@ assumes the first schema from the previous example.
=item func => $sub
Run the input through a subroutine to perform additional validation or
normalization. The subroutine is only called after all other validations have
succeeded. The subroutine is called with the input as its only argument.
Normalization of the input can be done by assigning to the first argument or
modifying its value in-place.
normalization. When the schema is a hashref, the subroutine is only called
after all other validations have succeeded. The subroutine is called with the
input as its only argument. Normalization of the input can be done by
assigning to the first argument or modifying its value in-place.
On success, the subroutine should return a true value. On failure, it should
return either a false value or a hashref. The hashref will have the
@ -873,9 +882,9 @@ considered "known".
All other built-in options follow inheritance semantics: These options can be
set in a custom validation, and they are inherited by the top-level schema. If
the same option is set in multiple validations a random one will be inherited,
so that's not a good idea. The top-level schema can always override options set
by custom validations.
the same option is set in multiple validations, the final one will be
inherited. The top-level schema can always override options set by custom
validations.
=head3 Global custom validations

View file

@ -17,6 +17,7 @@ my %validations = (
onerrorsub => { onerror => sub { ref $_[1] } },
collapsews => { trim => 0, func => sub { $_[0] =~ s/\s+/ /g; 1 } },
neverfails => { onerror => 'err' },
doublefunc => [ func => sub { $_[0] == 0 }, func => sub { $_[0] = 2; 1; } ],
revnum => { type => 'array', sort => sub($x,$y) { $y <=> $x } },
uniquelength => { type => 'array', values => { type => 'array' }, unique => sub { scalar @{$_[0]} } },
person => {
@ -38,7 +39,7 @@ sub t($schema, $input, $output) {
my $input_copy = dclone([$input])->[0];
my $res = FU::Validate->compile($schema, \%validations)->validate($input);
#diag explain FU::Validate->compile($schema, \%validations) if $line == 139;
#diag explain FU::Validate->compile($schema, \%validations) if $line == 98;
is_deeply $schema, $schema_copy, "schema modification $line";
is_deeply $input, $input_copy, "input modification $line";
is_deeply $res, $output, "data ok $line";
@ -51,6 +52,7 @@ sub f($schema, $input, $error, @msg) {
my $input_copy = dclone([$input])->[0];
ok !eval { FU::Validate->compile($schema, \%validations)->validate($input); 1 }, "eval $line";
#diag explain FU::Validate->compile($schema, \%validations) if $line == 162;
is_deeply $schema, $schema_copy, "schema modification $line";
is_deeply $input, $input_copy, "input modification $line";
delete $@->{longmess};
@ -179,6 +181,8 @@ t { person => 1, unknown => 'remove' }, {name => 'x', sex => 'y', extra => 1}, {
t { neverfails => 1, int => 1 }, undef, 'err';
t { neverfails => 1, int => 1 }, 'x', 'err';
t { neverfails => 1, int => 1, onerror => undef }, 'x', undef; # XXX: no way to 'unset' an inherited onerror clause, hmm.
t { doublefunc => 1 }, 0, 2;
f { doublefunc => 1 }, 1, { validation => 'doublefunc', error => { validation => 'func', result => '' } }, "validation 'doublefunc': failed validation 'func'";
# numbers
sub nerr { ({ validation => 'num', got => $_[0] }, "failed validation 'num'") }