From f248a33c1c4cfe0edadf4146681ee2e1b13c0f01 Mon Sep 17 00:00:00 2001 From: Yorhel Date: Fri, 14 Mar 2025 09:25:56 +0100 Subject: [PATCH] Validate: Allow multiple func validations in arrayref schema --- FU/Validate.pm | 63 ++++++++++++++++++++++++++++---------------------- t/validate.t | 6 ++++- 2 files changed, 41 insertions(+), 28 deletions(-) diff --git a/FU/Validate.pm b/FU/Validate.pm index 54b3c77..5ea79d6 100644 --- a/FU/Validate.pm +++ b/FU/Validate.pm @@ -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 diff --git a/t/validate.t b/t/validate.t index 2f8d8d9..c04288a 100644 --- a/t/validate.t +++ b/t/validate.t @@ -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'") }