diff --git a/FU/Validate.pm b/FU/Validate.pm index 7352053..dd767c7 100644 --- a/FU/Validate.pm +++ b/FU/Validate.pm @@ -61,6 +61,10 @@ 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 @@ -78,12 +82,12 @@ our %default_validations = ( maxlength => sub($v) { _length $v, undef, $v }, length => sub($v) { _length $v, ref $v eq 'ARRAY' ? @$v : ($v, $v) }, - bool => { type => 'any', func => sub { my $r = to_bool $_[0]; return {} if !defined $r; $_[0] = $r; 1 } }, - anybool => { type => 'any', default => false, func => sub { $_[0] = $_[0] ? true : false; 1 } }, + 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 => [ _reg($re_num), func => sub { $_[0] = $_[0]*1; 1 } ], - int => [ _reg($re_int), func => sub { return { message => 'integer out of range' } if $_[0] < -9223372036854775808 || $_[0] > 9223372036854775807; $_[0] = int $_[0]; 1 } ], - uint => [ _reg($re_uint), func => sub { return { message => 'integer out of range' } if $_[0] > 18446744073709551615; $_[0] = int $_[0]; 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] ] }, @@ -152,6 +156,11 @@ sub _compile($schema, $custom, $rec, $top, $validations=$top->{validations}) { 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}; @@ -353,6 +362,37 @@ sub validate($c, $input) { } +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; +} + package FU::Validate::err; @@ -445,6 +485,56 @@ I, 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 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, then that is returned. + +=item * If the schema describes a hash, then a hash is returned with each key +in I 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. + +=item * If the schema describes a number, return C<0>. + +=item * If the schema describes a string, return C<''>. + +=item * Otherwise, return C. + +=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 set to either +I or I, unknown keys are removed. This behavior can be +overriden by passing different I 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 diff --git a/t/validate-util.t b/t/validate-util.t new file mode 100644 index 0000000..a0ad106 --- /dev/null +++ b/t/validate-util.t @@ -0,0 +1,36 @@ +use v5.36; +use Test::More; +use FU::Validate; +use FU::Util 'json_format'; + +my $schema = FU::Validate->compile({ keys => { + bool => { anybool => 1 }, + num => { num => 1 }, + int => { int => 1 }, + str => { default => 'x' }, + intarray => { elems => { int => 1 } }, + any => { type => 'any' }, +}}); + + +is json_format($schema->coerce(undef)), 'null'; +is json_format($schema->coerce("str")), '"str"'; + +is json_format($schema->coerce({ + bool => 'abc', + num => " 1.5 ", + int => 9.7, + str => !1, + intarray => [ 1.5, -10, undef, ' 0E0 ' ], + any => {}, + whatsthis => undef, + }, unknown => 'remove'), canonical => 1), + '{"any":{},"bool":true,"int":9,"intarray":[1,-10,null,0],"num":1.5,"str":""}'; + +is json_format($schema->coerce({uhm => 1}), canonical => 1), + '{"any":null,"bool":false,"int":0,"intarray":[],"num":0,"str":"x","uhm":1}'; + +is json_format($schema->empty, canonical => 1), + '{"any":null,"bool":false,"int":0,"intarray":[],"num":0,"str":"x"}'; + +done_testing;