package FU::Validate 1.3;

use v5.36;
use experimental 'builtin', 'for_list';
use builtin qw/true false blessed trim/;
use Carp 'confess';
use FU::Util 'to_bool', 'has_control';


# Unavailable as custom validation names
my %builtin = map +($_,1), qw/
    type
    default
    onerror
    trim allow_control
    elems sort unique
    accept_scalar accept_array
    keys values unknown missing
    func
/;

my %type_vals = map +($_,1), qw/scalar hash array any/;
my %unknown_vals = map +($_,1), qw/remove reject pass/;
my %missing_vals = map +($_,1), qw/create reject ignore/;
my %implied_type = qw/
    accept_array scalar
    keys hash values hash unknown hash
    elems array sort array unique array accept_scalar array
/;
my %sort_vals = (
    str => sub($x,$y) { $x cmp $y },
    num => sub($x,$y) { $x <=> $y },
);

sub _length($exp, $min, $max) {
    [ 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
sub _reg($reg) {
    ( type => 'scalar', func => sub { $_[0] =~ $reg ? 1 : { got => $_[0] } } );
}


our $re_num       = qr/^-?(?:0|[1-9][0-9]*)(?:\.[0-9]+)?(?:[eE][+-]?[0-9]+)?$/;
our $re_int       = qr/^-?(?:0|[1-9][0-9]*)$/;
our $re_uint      = qr/^(?:0|[1-9][0-9]*)$/;
our $re_fqdn      = qr/(?:[a-zA-Z0-9][\w-]*\.)+[a-zA-Z][a-zA-Z0-9-]{1,25}\.?/;
our $re_ip4_digit = qr/(?:0|[1-9]|[1-9][0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])/;
our $re_ip4       = qr/($re_ip4_digit\.){3}$re_ip4_digit/;
# This monstrosity is based on http://stackoverflow.com/questions/53497/regular-expression-that-matches-valid-ipv6-addresses
# Doesn't allow IPv4-mapped-IPv6 addresses or other fancy stuff.
our $re_ip6       = qr/(?:[0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|(?:[0-9a-fA-F]{1,4}:){1,7}:|(?:[0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|(?:[0-9a-fA-F]{1,4}:){1,5}(?::[0-9a-fA-F]{1,4}){1,2}|(?:[0-9a-fA-F]{1,4}:){1,4}(?::[0-9a-fA-F]{1,4}){1,3}|(?:[0-9a-fA-F]{1,4}:){1,3}(?::[0-9a-fA-F]{1,4}){1,4}|(?:[0-9a-fA-F]{1,4}:){1,2}(?::[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:(?:(?::[0-9a-fA-F]{1,4}){1,6})|:(?:(?::[0-9a-fA-F]{1,4}){1,7}|:)/;
our $re_ip        = qr/(?:$re_ip4|$re_ip6)/;
our $re_domain    = qr/(?:$re_fqdn|$re_ip4|\[$re_ip6\])/;
our $re_email     = qr/^[-\+\.#\$=\w]+\@$re_fqdn$/;
our $re_weburl    = qr/^https?:\/\/$re_domain(?::[1-9][0-9]{0,5})?(?:\/[^\s<>"]*)$/;
our $re_date      = qr/^(?:19[0-9][0-9]|20[0-9][0-9])-(?:0[1-9]|1[0-2])-(?:0[1-9]|[12][0-9]|3[01])$/;


# There's a special '_scalartype' option used for coerce() and empty(), with the following values:
#   0/undef/missing: string, 1:num, 2:int, 3:bool
# The highest number, i.e. most restrictive type, is chosen when multiple validations exist.

our %default_validations = (
    regex => sub($reg) {
        # Error objects should be plain data structures so that they can easily
        # be converted to JSON for debugging. We have to stringify $reg in the
        # error object to ensure that.
        +{ type => 'scalar', func => sub { $_[0] =~ $reg ? 1 : { regex => "$reg", got => $_[0] } } }
    },
    enum => sub($vals) {
        my @l = ref $vals eq 'HASH' ? sort keys %$vals : ref $vals eq 'ARRAY' ? @$vals : ($vals);
        my %opts = map +($_,1), @l;
        +{ type => 'scalar', func => sub { $opts{ (my $v = $_[0]) } ? 1 : { expected => \@l, got => $_[0] } } }
    },

    minlength => sub($v) { _length $v, $v, undef },
    maxlength => sub($v) { _length $v, undef, $v },
    length    => sub($v) { _length $v, ref $v eq 'ARRAY' ? @$v : ($v, $v) },

    bool      => { _scalartype => 3, type => 'any', func => sub { my $r = to_bool $_[0]; return {} if !defined $r; $_[0] = $r; 1 } },
    anybool   => { _scalartype => 3, type => 'any', default => false, func => sub { $_[0] = $_[0] ? true : false; 1 } },

    num   => [ _scalartype => 1, _reg($re_num), func => sub { $_[0] = $_[0]*1; 1 } ],
    int   => [ _scalartype => 2, _reg($re_int), func => sub { return { message => 'integer out of range' } if $_[0] < -9223372036854775808 || $_[0] > 9223372036854775807; $_[0] = int $_[0]; 1 } ],
    uint  => [ _scalartype => 2, _reg($re_uint), func => sub { return { message => 'integer out of range' } if $_[0] > 18446744073709551615; $_[0] = int $_[0]; 1 } ],
    min   => sub($min) { +{ num => 1, func => sub { $_[0] >= $min ? 1 : { expected => $min, got => $_[0] } } } },
    max   => sub($max) { +{ num => 1, func => sub { $_[0] <= $max ? 1 : { expected => $max, got => $_[0] } } } },
    range => sub { [ min => $_[0][0], max => $_[0][1] ] },

    ascii  => { _reg qr/^[\x20-\x7E]*$/ },
    sl     => { _reg qr/^[^\t\r\n]+$/ },
    ipv4   => { _reg $re_ip4 },
    ipv6   => { _reg $re_ip6 },
    ip     => { _reg $re_ip  },
    email  => { _reg($re_email),  maxlength => 254 },
    weburl => { _reg($re_weburl), maxlength => 65536 }, # the maxlength is a bit arbitrary, but better than unlimited
    date   => { _reg $re_date },
);


sub _new { bless { validations => [], @_ }, __PACKAGE__ }


sub _compile($schema, $custom, $rec, $top, $validations=$top->{validations}) {
    my $iscompiled = $schema isa __PACKAGE__;

    # For hashref schemas, builtins always override other validations
    $schema = [
        map +($_, $schema->{$_}),
            (grep !$builtin{$_}, keys %$schema),
            (grep $builtin{$_}, keys %$schema),
    ] if ref $schema ne 'ARRAY';

    for my($name, $val) (@$schema) {
        if ($name eq 'type') {
            confess "Invalid value for 'type': $val" if $name eq 'type' && !$type_vals{$val};
            confess "Incompatible types, the schema specifies '$val', but another validation requires '$top->{type}'" if $top->{type} && $top->{type} ne $val;;
            $top->{type} = $val;
            next;
        }

        my $type = $implied_type{$name};
        if ($type) {
            confess "Incompatible types, the schema specifies '$top->{type}' but the '$name' validation implies '$type'" if $top->{type} && $top->{type} ne $type;
            $top->{type} = $type;
        }

        if ($name eq 'elems' || $name eq 'values') {
            $top->{$name} ||= _new;
            _compile($val, $custom, $rec-1, $top->{$name});
            next;
        }

        if ($name eq 'keys') {
            $top->{keys} ||= {};
            for my($n,$v) (%$val) {
                $top->{keys}{$n} ||= _new;
                _compile($v, $custom, $rec-1, $top->{keys}{$n});
            }
            next;
        }

        if ($name eq 'func') {
            push @$validations, $val;
            next;
        }

        if ($name eq 'default') {
            $top->{default} = $val;
            delete $top->{default} if ref $val eq 'SCALAR' && $$val eq 'required';
            next;
        }

        if ($name eq '_scalartype') {
            $top->{_scalartype} = $val if ($top->{_scalartype}||0) < $val;
            next;
        }

        if ($builtin{$name}) {
            confess "Invalid value for 'missing': $val" if $name eq 'missing' && !$missing_vals{$val};
            confess "Invalid value for 'unknown': $val" if $name eq 'unknown' && !$unknown_vals{$val};
            confess "Invalid value for 'accept_array': $val" if $name eq 'accept_array' && $val && $val ne 'first' && $val ne 'last';
            $val = $sort_vals{$val} || confess "Unknown value for 'sort': $val" if $name eq 'sort' && ref $val ne 'CODE';
            $top->{$name} = $val;
            next;
        }

        if ($iscompiled && $name eq 'validations') {
            push @$validations, @$val;
            next;
        }

        my $t = $custom->{$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 'CODE' ? $t->($val) : $t;

        my $v = _new name => $name;
        _compile($t, $custom, $rec-1, $top, $v->{validations});
        push @$validations, $v if $v->{validations}->@*;
    }
}


sub compile($pkg, $schema, $custom={}) {
    return $schema if $schema isa __PACKAGE__;
    my $c = _new;
    _compile $schema, $custom, 64, $c;
    $c
}


sub _validate_hash {
    my $c = $_[0];

    if ($c->{keys}) {
        my @err;
        for my ($k, $s) ($c->{keys}->%*) {
            if (!exists $_[1]{$k}) {
                next if $s->{missing} && $s->{missing} eq 'ignore';
                return { validation => 'missing', key => $k } if $s->{missing} && $s->{missing} eq 'reject';
                $_[1]{$k} = ref $s->{default} eq 'CODE' ? $s->{default}->() : $s->{default} // undef;
                next if exists $s->{default};
            }

            my $r = _validate($s, $_[1]{$k});
            if ($r) {
                $r->{key} = $k;
                push @err, $r;
            }
        }
        return { validation => 'keys', errors => [ sort { $a->{key} cmp $b->{key} } @err ] } if @err;
    }

    if ($c->{values}) {
        my @err;
        for my ($k, $v) ($_[1]->%*) {
            my $r = _validate($c->{values}, $v);
            if ($r) {
                $r->{key} = $k;
                push @err, $r;
            }
        }
        return { validation => 'values', errors => [ sort { $a->{key} cmp $b->{key} } @err ] } if @err;
    }
}

sub _validate_elems {
    my @err;
    for my $i (0..$#{$_[1]}) {
        my $r = _validate($_[0]{elems}, $_[1][$i]);
        if ($r) {
            $r->{index} = $i;
            push @err, $r;
        }
    }
    return { validation => 'elems', errors => \@err } if @err;
}


sub _validate_rec {
    my $c = $_[0];
    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;
        }
    }
}


sub _validate_array {
    my $c = $_[0];

    $_[1] = [sort { $c->{sort}->($a, $b) } $_[1]->@* ] if $c->{sort};

    # Key-based uniqueness
    if ($c->{unique} && (!$c->{sort} || ref $c->{unique} eq 'CODE')) {
        my %h;
        for my $i (0..$#{$_[1]}) {
            my $k = ref $c->{unique} eq 'CODE' ? $c->{unique}->($_[1][$i]) : $_[1][$i];
            return { validation => 'unique', index_a => $h{$k}, value_a => $_[1][$h{$k}], index_b => $i, value_b => $_[1][$i], key => $k } if exists $h{$k};
            $h{$k} = $i;
        }

    # Comparison-based uniqueness
    } elsif ($c->{unique}) {
        for my $i (0..$#{$_[1]}-1) {
            return { validation => 'unique', index_a => $i, value_a => $_[1][$i], index_b => $i+1, value_b => $_[1][$i+1] }
                if $c->{sort}->($_[1][$i], $_[1][$i+1]) == 0
        }
    }
}


sub _validate_input {
    my $c = $_[0];

    my $type = $c->{type} // 'scalar';

    # accept_array (needs to be done before 'trim')
    $_[1] = $_[1]->@* == 0 ? undef : $c->{accept_array} eq 'first' ? $_[1][0] : $_[1][ $#{$_[1]} ]
        if $c->{accept_array} && ref $_[1] eq 'ARRAY';

    # early scalar checks
    if (defined $_[1] && !ref $_[1] && $type eq 'scalar') {
        # trim needs to be done before the 'default' test
        $_[1] = trim $_[1] =~ s/\r//rg if !exists $c->{trim} || $c->{trim};

        return { validation => 'allow_control' } if !$c->{allow_control} && has_control $_[1];
    }

    # default
    if (!defined $_[1] || (!ref $_[1] && $_[1] eq '')) {
        if (exists $c->{default}) {
            $_[1] = ref $c->{default} eq 'CODE' ? $c->{default}->($_[1]) : $c->{default};
            return;
        }
        return { validation => 'required' };
    }

    if ($type eq 'scalar') {
        return { validation => 'type', expected => 'scalar', got => lc ref $_[1] } if ref $_[1];

    } elsif ($type eq 'hash') {
        return { validation => 'type', expected => 'hash', got => lc ref $_[1] || 'scalar' } if ref $_[1] ne 'HASH';

        # Each branch below makes a shallow copy of the hash, so that further
        # validations can perform in-place modifications without affecting the
        # input.
        if (!$c->{keys} || ($c->{unknown} && $c->{unknown} eq 'pass')) {
            $_[1] = { $_[1]->%* };
        } elsif (!$c->{unknown} || $c->{unknown} eq 'remove') {
            $_[1] = { map +($_, $_[1]{$_}), grep $c->{keys}{$_}, keys $_[1]->%* };
        } else {
            my @err = grep !$c->{keys}{$_}, keys $_[1]->%*;
            return { validation => 'unknown', keys => \@err, expected => [ sort keys $c->{keys}->%* ] } if @err;
            $_[1] = { $_[1]->%* };
        }

    } elsif ($type eq 'array') {
        $_[1] = [$_[1]] if $c->{accept_scalar} && !ref $_[1];
        return { validation => 'type', expected => $c->{accept_scalar} ? 'array or scalar' : 'array', got => lc ref $_[1] || 'scalar' } if ref $_[1] ne 'ARRAY';
        $_[1] = [$_[1]->@*]; # Create a shallow copy to prevent in-place modification.

    } elsif ($type eq 'any') {
        # No need to do anything here.
    }

    ($type eq 'hash' && &_validate_hash) ||
    ($c->{elems} && &_validate_elems) ||
    &_validate_rec ||
    ($type eq 'array' && &_validate_array)
}


sub _validate {
    my $c = $_[0];
    my $r = &_validate_input;
    ($r, $_[1]) = (undef, ref $c->{onerror} eq 'CODE' ? $c->{onerror}->($_[0], bless $r, 'FU::Validate::err') : $c->{onerror})
        if $r && exists $c->{onerror};
    $r
}


sub validate($c, $input) {
    my $r = _validate($c, $input);
    return $input if !$r;
    $r = bless $r, 'FU::Validate::err';;
    my @e = $r->errors;
    $r->{longmess} = Carp::longmess(@e > 1 ? join("\n",@e)."\n" : $e[0]);
    die $r;
}


sub coerce {
    my $c = $_[0];
    my %opt = @_[2..$#_];
    if (!defined $_[1]) {
        $_[1] = undef;
    } elsif ($c->{_scalartype}) {
        $_[1] = $c->{_scalartype} == 3 ? !!$_[1] : $c->{_scalartype} == 2 ? int $_[1] : $_[1]+0;
    } elsif (!$c->{type} || $c->{type} eq 'scalar') {
        $_[1] = "$_[1]";
    } elsif ($c->{type} eq 'array' && $c->{elems} && ref $_[1] eq 'ARRAY') {
        coerce($c->{elems}, $_, %opt) for $_[1]->@*;
    } elsif ($c->{type} eq 'hash' && $c->{keys} && ref $_[1] eq 'HASH') {
        $opt{unknown} ||= $c->{unknown};
        delete @{$_[1]}{ grep !$c->{keys}{$_}, keys $_[1]->%* }
            if $opt{unknown} && $opt{unknown} ne 'pass';
        $_[1]{$_} = exists $_[1]{$_} ? coerce($c->{keys}{$_}, $_[1]{$_}, %opt) : empty($c->{keys}{$_})
            for keys $c->{keys}->%*;
    }
    return $_[1];
}


sub empty($c) {
    return ref $c->{default} eq 'CODE' ? $c->{default}->(undef) : $c->{default} if exists $c->{default};
    return [] if $c->{type} && $c->{type} eq 'array';
    return $c->{keys} ? +{ map +($_, empty($c->{keys}{$_})), keys $c->{keys}->%* } : {} if $c->{type} && $c->{type} eq 'hash';
    return undef if $c->{type} && $c->{type} eq 'any';
    # Only scalar types remain
    return !$c->{_scalartype} ? '' : $c->{_scalartype} == 3 ? !1 : 0;
}



sub _fmtkey($k) { $k =~ /^[a-zA-Z0-9_-]+$/ ? $k : FU::Util::json_format($k); }
sub _fmtval($v) { eval { $v = FU::Util::json_format($v) }; "$v" }
sub _inval($t,$v) { sprintf 'invalid %s: %s', $t, _fmtval $v }

# validation name => formatting sub
# TODO: document.
our %error_format = (
    required  => sub { 'required value missing' },
    allow_control => sub { 'invalid control character' },
    type      => sub($e) { "invalid type, expected '$e->{expected}' but got '$e->{got}'" },
    unknown   => sub($e) { sprintf 'unknown key%s: %s', $e->{keys}->@* == 1 ? '' : 's', join ', ', map _fmtkey($_), $e->{keys}->@* },
    minlength => sub($e) { sprintf "input too short, expected minimum of %d but got %d", $e->{expected}, $e->{got} },
    maxlength => sub($e) { sprintf "input too long, expected maximum of %d but got %d", $e->{expected}, $e->{got} },
    length    => sub($e) {
        !ref $e->{expected}
        ? sprintf 'invalid input length, expected %d but got %d', $e->{expected}, $e->{got}
        : sprintf 'invalid input length, expected between %d and %d but got %d', $e->{expected}->@*, $e->{got}
    },
    num       => sub($e) { _inval 'number', $e->{got} },
    min       => sub($e) { $e->{error} ? _inval 'number', $e->{error}{got} : sprintf 'expected minimum %s but got %s', $e->{expected}, $e->{got} },
    max       => sub($e) { $e->{error} ? _inval 'number', $e->{error}{got} : sprintf 'expected maximum %s but got %s', $e->{expected}, $e->{got} },
    range     => sub($e) { FU::Validate::err::errors($e->{error}) },
);


package FU::Validate::err;
use v5.36;

use overload '""' => sub { $_[0]{longmess} || join "\n", $_[0]->errors };

# TODO: document.
sub errors($e, $prefix='') {
    my $val = $e->{validation};
    my $p = $prefix ? "$prefix: " : '';
    $FU::Validate::error_format{$val} ? map "$p$_", $FU::Validate::error_format{$val}->($e) :
    $val eq 'keys'     ? map errors($_, $prefix.'.'.FU::Validate::_fmtkey($_->{key})), $e->{errors}->@* :
    $val eq 'values'   ? map errors($_, $prefix.'.'.FU::Validate::_fmtkey($_->{key})), $e->{errors}->@* :
    $val eq 'missing'  ? $prefix.'.'.FU::Validate::_fmtkey($e->{key}).': required key missing' :
    $val eq 'elems'    ? map errors($_, $prefix."[$_->{index}]"), $e->{errors}->@* :
    $val eq 'unique'   ? $prefix."[$e->{index_b}] value '".FU::Validate::_fmtval($e->{value_a})."' duplicated" :
    $e->{error}        ? errors($e->{error}, "${p}validation '$val'") :
    $e->{message}      ? "${p}validation '$val': $e->{message}" :
                         "${p}failed validation '$val'";
}


1;
__END__

=head1 NAME

FU::Validate - Data and form validation and normalization

=head1 DESCRIPTION

This module provides an easy and simple interface for data validation. It can
handle most types of data structures (scalars, hashes, arrays and nested data
structures), and has some conveniences for validating form-like data.

That this module will not solve B<all> your input validation problems. It can
validate the format and the structure of the data, but it does not support
validations that depend on other input values. For example, it is not possible
to specify that the contents of a I<password> field must be equivalent to that
of a I<confirm_password> field, but you can specify that both fields need to be
filled out. Recursive data structures are not supported. There is also no good
support for validating hashes with dynamic keys or arrays where not all
elements conform to the same schema. These could technically still be validated
with custom validations, but it won't be as convenient.

This module is designed to validate any kind of program input after it has been
parsed into a Perl data structure. It should not be used to validate function
parameters within Perl code. In fact, the correct answer to "how do I validate
function parameters?" is "don't, document your assumptions instead".


=head1 Validation API

To validate some input, you first need a schema. A schema can be compiled as
follows:

  my $validator = FU::Validate->compile($schema, $validations);

C<$schema> is the schema that describes the data to be validated (see L</Schema
Definition> below) and C<$validations> is an optional hashref containing
L<custom validations|/Custom validations> that C<$schema> can refer to.  An
error is thrown if the C<$validations> or C<$schema> are invalid.

To validate input, run:

  my $validated_input = $validator->validate($input);

C<validate()> returns a validated and (depending on the schema) normalized copy
of C<$input>. Great care is taken that C<$input> is not being modified
in-place, even if data normalization is being performed.

An error is thrown if the input does not validate. The error object is a
C<FU::Validate::err>-blessed hashref containing at least one key:
I<validation>, which indicates the name of the validation that failed.
Additional keys with more detailed information may be present, depending on the
validation. These are documented in L</Schema Definition> below.

Additional utility methods:

=over

=item $validator->empty

Returns an "empty" value that roughly follows the data structure described by
the schema. The returned value does not necessarily validate but can still be
useful as a template. Works roughly as follows:

=over

=item * If the schema has a I<default>, then that is returned.

=item * If the schema describes a hash, then a hash is returned with each key
in I<keys> initialized to an empty value.

=item * If the schema describes an array, an empty array is returned.

=item * If the schema describes a bool, return C<false>.

=item * If the schema describes a number, return C<0>.

=item * If the schema describes a string, return C<''>.

=item * Otherwise, return C<undef>.

=back

=item $validator->coerce($input, %opt)

Perform in-place coercion of C<$input> to the data types described by the
schema. Also returns the modified C<$input> for convenience. This method assumes
that C<$input> already has the general structure described by the schema and is
mainly useful to ensure that encoding the value as JSON will end up with the
correct data types. i.e. booleans are encoded as booleans, integers as integers
(truncating if necessary), numbers as numbers, etc.

If an input hash is missing keys described in the schema, then those are
created with C<< ->empty >>. If the schema has I<unknown> set to either
I<reject> or I<remove>, unknown keys are removed. This behavior can be
overriden by passing different I<unknown> value in C<%opt>.

This method does NOT perform any sort of validation and will happily pass
through garbage if the given C<$input> does not follow the structure of the
schema. It's basically a faster and lousier normalization-only alternative to
C<< ->validate() >>.

=back


=head1 Schema Definition

A schema is an arrayref or hashref, where each key is the name of a built-in
option or of a validation to be performed and the values are the arguments to
those validations. None of the options or validations are required, but some
built-ins have default values. This means that the empty schema C<{}> is
actually equivalent to:

  { type    => 'scalar',
    trim    => 1,
    default => \'required',
    missing => 'create',
  }

Built-in options are always validated in a fixed order, but the order in which
standard and custom validations are performed is random when the schema is
given as a hashref. This is rarely a problem, but it can in some cases affect
the returned error message or whether a later validation will receive data
normalized by a previous validation. An arrayref can be used to enforce a
validation order:

  [ enum => [1, 2, 'a'], int => 1 ]

Or to use the same validation multiple times:

  [ regex => qr/^a/, regex => qr/z$/ ]

=head1 Built-in options

=over

=item type => $type

Specify the type of the input, this can be I<scalar>, I<array>, I<hash> or
I<any>. If no type is specified or implied by other validations, the default
type is I<scalar>.

Upon failure, the error object will look something like:

  { validation => 'type',
    expected   => 'hash',
    got        => 'scalar'
  }

Beware: setting the type to I<any> causes the I<trim> and I<allow_control>
validations to be skipped.

=item default => $val

If not set, or set to C<\'required'> (note: scalarref), then a value is required
for this field. Specifically, this means that a value must exist and must not
be C<undef> or an empty string, i.e. C<exists($x) && defined($x) && $x ne ''>.

If set to any other value, then the input is considered optional and the given
C<$val> is returned instead. If C<$val> is a CODE reference, the subroutine is
called with the original value (which is either no argument, undef or an empty
string) and the return value of the subroutine is used as value instead.

The empty check is performed after I<trim> and before any other validations. So
a string containing only whitespace is considered an empty string and will be
treated according to this I<default> option. As an additional side effect,
other validations will never get to validate undef or an empty string, as these
values are either rejected or substituted with a default.

=item onerror => $val

Instead of reporting an error, return C<$val> if this input fails validation
for whatever reason. Setting this option in the top-level schema ensures that
the validation will always succeed regardless of the input.

If C<$val> is a CODE reference, the subroutine is called with the (partially
normalized) input as first argument and error object as second argument. The
return value of the subroutine is then returned for this validation.

=item trim => 0/1

By default, any whitespace around scalar-type input is removed before testing
any other validations. Setting I<trim> to a false value will disable this
behavior.

=item allow_control => 0/1

By default, ASCII control characters in the input are not permitted for scalar
values and trigger a validation error. Set this to a positive value to disable
the check.

=item keys => $hashref

Implies C<< type => 'hash' >>, this option specifies which keys are permitted,
and how to validate the values. Each key in C<$hashref> corresponds to a key
with the same name in the input. Each value is a schema definition by which the
value in the input will be validated. The schema definition may be a bare
hashref or a validator returned by C<compile()>. If a key is not present in
the input hash, it will be created in the output with the default value (or
undef), but see the I<missing> option for how to change that behavior.

For example, the following schema specifies that the input must be a hash with
three keys:

  { type => 'hash',
    keys => {
      username => { maxlength => 16 },
      password => { minlength => 8 },
      email    => { default => '', email => 1 }
    }
  }

If validation on one or more keys fail, the error object that is returned looks
like:

  { validation => 'keys',
    errors => [
      # List of error objects, each with an additional 'key' field.
      { key => 'username', validation => 'required' }
      # In this case, the username was required but either absent or empty.
    ]
  }

=item values => $schema

Implies C<< type => 'hash' >>, set a schema that is used to validate every hash
value. Can be used together with I<keys>, in which case values must validate
both this C<$schema> and the schema corresponding to the key.

=item unknown => $option

Implies C<< type => 'hash' >>, this option specifies what to do with keys in
the input data that have not been defined in the I<keys> option. Possible
values are I<remove> to remove unknown keys from the output data (this is the
default), I<reject> to return an error if there are unknown keys in the input,
or I<pass> to pass through any unknown keys to the output data. Values for
passed-through keys are only validated when the I<values> option is set,
otherwise they are passed through as-is. This option has no effect when the
I<keys> option is never set, in that case all values are always passed through.

In the case of I<reject>, the error object will look like:

  { validation => 'unknown',
    # List of unknown keys present in the input
    keys       => ['unknown1', .. ],
    # List of known keys (which may or may not be present
    # in the input - that is checked at a later stage)
    expected   => ['known1', .. ]
  }

=item missing => $option

For values inside a hash I<keys> schema, this option specifies what to do when
the key is not present in the input data. Possible values are I<create> to
insert the key with a default value (if the I<default> option is set, otherwise
undef), I<reject> to return an error if the option is missing or I<ignore> to
leave the key out of the returned data.

The default is I<create>, but if no I<default> option is set for this key then
that is effectively the same as I<reject>. Values created through I<create> are
still validated through I<values> if that has been set.

In the case of I<reject>, the error object will look like:

  { validation => 'missing',
    key        => 'field'
  }

=item elems => $schema

Implies C<< type => 'array' >>, this defines the schema that is applied to
every element in the array.  The schema definition may be a bare hashref or a
validator returned by C<compile()>.

Failure is reported in a similar fashion to I<keys>:

  { validation => 'elems',
    errors => [
      { index => 1, validation => 'required' }
    ]
  }

=item accept_scalar => 0/1

Implies C<< type => 'array' >>, this option will also permit the input to be a
scalar. In that case, the input is interpreted and returned as an array with
only one element. This option exists to make it easy to validate multi-value
form inputs. For example, consider C<query_decode()> in L<FU::Util>: a
parameter in a query string is decoded into an array if it is listed multiple
times, a scalar if it only occcurs once. So we could either end up with:

  { a => 1, b => 1 }
  # OR:
  { a => [1, 3], b => 1 }

With the I<accept_scalar> option, we can accept both forms for C<a> and
normalize into an array. The following schema definition can validate the above
examples:

  { type => 'hash',
    keys => {
      a => { type => 'array', accept_scalar => 1 },
      b => { }
    }
  }

=item accept_array => false/'first'/'last'

Implies C<< type => 'scalar' >>. Similar to I<accept_scalar> but normalizes in
the other direction: when the input is an array, only the first or last item is
extracted and the other elements are ignored. If the input is an empty array,
the value is taken to be C<undef>.

=item sort => $option

Implies C<< type => 'array' >>, sort the array after validating its elements.
C<$option> determines how the array is sorted, possible values are I<str> for
string comparison, I<num> for numeric comparison, or a subroutine reference for
custom comparison function. The subroutine must be similar to the one given to
Perl's C<sort()> function, except it should compare C<$_[0]> and C<$_[1]>
instead of C<$a> and C<$b>.

=item unique => $option

Implies C<< type => 'array' >>, require elements to be unique. That is, don't
allow duplicate elements. There are several ways to specify what uniqueness
means in this context:

If C<$option> is a subroutine reference, then the subroutine is given an
element as first argument, and it should return a string that is used to check
for uniqueness. For example, if array elements are hashes, and you want to
check for uniqueness of a hash key named I<id>, you can specify this as
C<< unique => sub { $_[0]{id} } >>.

Otherwise, if C<$option> is true and the I<sort> option is set, then the
comparison function used for sorting is also used as uniqueness check. Two
elements are the same if the comparison function returns C<0>.

If C<$option> is true and I<sort> is not set, then the elements will be
interpreted as strings, similar to setting C<< unique => sub { $_[0] } >>.

All of that may sound complicated, but it's quite easy to use. Here's a few
examples:

  # This describes an array of hashes with keys 'id' and 'name'.
  { elems => {
      keys => {
        id   => { uint => 1 },
        name => {}
      }
    },
    # Sort the array on 'id'
    sort => sub { $_[0]{id} <=> $_[1]{id} },
    # And require that 'id' fields are unique
    unique => 1
  }

  # Contrived example: An array of strings, and we want
  # each string to start with a different character.
  { elems => { minlength => 1 },
    unique => sub { substr $_[0], 0, 1 }
  }

On failure, this validation returns the following error object. This output
assumes the first schema from the previous example.

  { validation => 'unique',
    # Index and value of element a
    index_a => 1,
    value_a => { id => 3, name => 'whatever' }
    # Index and value of duplicate element b
    index_b => 4,
    value_b => { id => 3, name => 'something else' },
    # If string-based uniqueness was used, this is included as well:
    # key => '..'
  }


=item func => $sub

Run the input through a subroutine to perform additional validation or
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
I<validation> key set to I<func>, and this will be returned as error object.

When I<func> is used inside a custom validation, the returned error object will
have its I<validation> field set to the name of the custom validation. This
makes custom validations to behave as first-class validations in terms of error
reporting.


=back

=head1 Standard validations

Standard validations are provided by the module. It is possible to override,
re-implement and supplement these with custom validations. Internally, these
are, in fact, implemented as custom validations.

=over

=item regex => $re

Implies C<< type => 'scalar' >>. Validate the input against a regular
expression.

=item enum => $options

Implies C<< type => 'scalar' >>. Validate the input against a list of known
values. C<$options> can be either a scalar (in which case that is the only
permitted input), an array (listing all possible inputs) or a hash (where the
hash keys are considered to be the list of permitted inputs).

=item minlength => $num

Minimum length of the input. The I<length> is the string C<length()> if the
input is a scalar, the number of elements if the input is an array, or the
number of keys if the input is a hash.

=item maxlength => $num

Maximum length of the input.

=item length => $option

If C<$option> is a number, then this specifies the exact length of the input.
If C<$option> is an array, then this is a shorthand for
C<[$minlength,$maxlength]>.

=item anybool => 1

Accept any value of any type as input, and normalize it to either C<true> or
C<false> according to Perl's idea of truth.

=item bool => 1

Require the input to be a boolean type as per C<to_bool()> in L<FU::Util>.

=item num => 1

Implies C<< type => 'scalar' >>. Require the input to be a number formatted
using the format permitted by JSON. Note that this is slightly more restrictive
from Perl's number formatting, in that 'NaN', 'Inf' and thousand separators are
not permitted. The value is normalized to a Perl integer or floating point
value, which means precision for large numbers may be lost.

=item int => 1

Implies C<< type => 'scalar' >>. Require the input to be an (at most) 64-bit
integer.

=item uint => 1

Implies C<< type => 'scalar' >>. Require the input to be an (at most) 64-bit
unsigned integer.

=item min => $num

Implies C<< num => 1 >>. Require the input to be larger than or equal to
C<$num>.

=item max => $num

Implies C<< num => 1 >>. Require the input to be smaller than or equal to
C<$num>.

=item range => [$min,$max]

Equivalent to C<< min => $min, max => $max >>.

=item ascii => 1

Implies C<< type => 'scalar' >>. Require the input to wholly consist of
printable ASCII characters.

=item sl => 1

Implies C<< type => 'scalar' >>. Require the input to be a single line of text.
Useful for validating C<< <input type="text"> >> form elements, which really
should not result in multi-line input.

=item ipv4 => 1

Implies C<< type => 'scalar' >>. Require the input to be an IPv4 address.

=item ipv6 => 1

Implies C<< type => 'scalar' >>. Require the input to be an IPv6 address. Note
that the IP address is not normalized, and fancy features such as
IPv4-manned-IPv6 addresses are not permitted.

=item ip => 1

Require either C<< ipv4 => 1 >> or C<< ipv6 => 1 >>.

=item email => 1

Implies C<< type => 'scalar' >>. Validate the email address against a
monstrosity of a regular expression. This email validation is designed to catch
obviously invalid addresses and addresses that, while compliant with some RFCs,
will not be accepted by most actual SMTP implementations.

Email validation is quite a minefield, see L<Data::Validate::Email> for an
alternative solution.

=item weburl => 1

Implies C<< type => 'scalar' >>. Requires the input to be a C<http://> or
C<https://> url.

=item date => 1

Implies C<< type => 'scalar' >>. Requires the input to be a date string in the
form of C<YYYY-MM-DD>. Does not validate that the day number is valid for the
given the year and month.

=back


=head1 Custom validations

Custom validations can be passed to C<compile()> as the C<$validations> hashref
argument.  A custom validation is, in simple terms, either a schema or a
subroutine that returns a schema.  The custom validation can then be referenced
from other schemas.

Here's a simple example that defines and uses a custom validation named
I<stringbool>, which accepts either the string I<true> or I<false>.

  my $validations = {
      stringbool => { enum => ['true', 'false'] }
  };
  my $schema = { stringbool => 1 };
  my $result = FU::Validate->compile($schema, $validations)->validate('true');
  # $result eq 'true'

A custom validation can also be defined as a subroutine, in which case it can
accept options. Here is an example of a I<prefix> custom validation, which
requires that the string starts with the given prefix. The subroutine returns a
schema that contains the I<func> built-in option to do the actual validation.

  my $validations = {
      prefix => sub($prefix) {
          return { func => sub { $_[0] =~ /^\Q$prefix/ } }
      }
  };
  my $schema = { prefix => 'Hello, ' };
  my $result = FU::Validate->compile($schema, $validations)->validate('Hello, World!');

=head2 Custom validations and built-in options

Custom validations can also set built-in options, but the semantics differ a
little depending on the option. First, be aware that many of the built-in
options apply to the whole schema and not just to the custom validation.  For
example, if the top-level schema sets C<< trim => 0 >>, then all validations
used in that schema may get input with whitespace around it.

All validations used in a schema need to agree upon a single I<type> option.
If a custom validation does not specify a I<type> option (and no type is
implied by another validation such as I<keys> or I<elems>), then the
validation should work with every type. It is an error to define a schema that
mixes validations of different types. For example, the following throws an
error:

  FU::Validate->compile({
      # top-level schema says we expect a hash
      type => 'hash',
      # but the 'int' validation implies that the type is a scalar
      int => 1
  });

The I<func> option is validated separately for each custom validation.

Multiple I<keys>, I<values> and I<elems> validations are merged into a single
validation.  So if you have multiple custom validations that set the I<elems>
option, a single combined schema is created that validates all array elements.
The same applies to I<keys>: if the same key is listed in multiple custom
validations, then the key must conform to all schemas. With respect to the
I<unknown> option, a key that is mentioned in any of the I<keys> options is
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, the final one will be
inherited. The top-level schema can always override options set by custom
validations.


=head2 Global custom validations

Instead of passing a C<$validations> argument every time you call C<compile()>,
you can also add custom validations to the global list of built-in validations:

  $FU::Validate::default_validations{stringbool} = { enum => ['true', 'false'] };


=head1 SEE ALSO

L<FU>.

This module is a fork of L<TUWF::Validate>.

=head1 COPYRIGHT

MIT.

=head1 AUTHOR

Yorhel <projects@yorhel.nl>
