Validate: Allow multiple func validations in arrayref schema

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}->@*) {
+    for my $v ($c->{validations}->@*) {
-        my $r = _validate_rec($_, $_[1]);
+        if (ref $v eq 'CODE') {
-        return {
+            my $r = $v->($_[1]);
-            # If the error was a custom 'func' object, then make that the primary cause.
+            return { %$r, validation => 'func' } if ref $r eq 'HASH';
-            # This makes it possible for validations to provide their own error objects.
+            return { validation => 'func', result => $r } if !$r;
-            $r->{validation} eq 'func' && (!exists $r->{result} || keys $r->%* > 2) ? $r->%* : (error => $r),
+        } else {
-            validation => $_->{name},
+            my $r = _validate_rec($v, $_[1]);
-        } if $r;
+            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.
-    # func
+                $r->{validation} eq 'func' && (!exists $r->{result} || keys $r->%* > 2) ? $r->%* : (error => $r),
-    if ($c->{func}) {
+                validation => $v->{name},
-        my $r = $c->{func}->($_[1]);
+            } if $r;
-        return { %$r, validation => 'func' } if ref $r eq 'HASH';
+        }
-        return { validation => 'func', result => $r } 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
+normalization. When the schema is a hashref, the subroutine is only called
-succeeded. The subroutine is called with the input as its only argument.
+after all other validations have succeeded. The subroutine is called with the
-Normalization of the input can be done by assigning to the first argument or
+input as its only argument.  Normalization of the input can be done by
-modifying its value in-place.
+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,
+the same option is set in multiple validations, the final one will be
-so that's not a good idea. The top-level schema can always override options set
+inherited. The top-level schema can always override options set by custom
-by custom validations.
+validations.
 
 
 =head3 Global custom validations

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'") }