Validate: remove a level of indirection

This commit is contained in:
Yorhel 2025-03-14 06:50:49 +01:00
parent 9685287523
commit 64a105e013
3 changed files with 56 additions and 56 deletions

View file

@ -123,7 +123,9 @@ module makes an attempt to avoid any further copies of data values.
=head2 Parsing =head2 Parsing
=over FU::MultipartFormData->parse($header, $body) =over
=item FU::MultipartFormData->parse($header, $body)
Returns an array of field objects from the given C<$header>, which must be a Returns an array of field objects from the given C<$header>, which must be a
valid value for the C<Content-Type> request header, and the given C<$body>, valid value for the C<Content-Type> request header, and the given C<$body>,

View file

@ -806,7 +806,7 @@ error if something went wrong.
It is possible to close a read-copy operation before all data has been It is possible to close a read-copy operation before all data has been
consumed, but that causes all data to still be read and discarded during consumed, but that causes all data to still be read and discarded during
C<close()>. If you really want to interrupt a large read operation, a more C<close()>. If you really want to interrupt a large read operation, a more
efficient approach is to call C<< $conn->close >> and discard the entire efficient approach is to call C<< $conn->disconnect >> and discard the entire
connection. connection.
It is not I<necessary> to call this method, simply letting the C<$copy> object It is not I<necessary> to call this method, simply letting the C<$copy> object

View file

@ -94,8 +94,8 @@ our %default_validations = (
# #
# name => $name_or_undef, # name => $name_or_undef,
# validations => [ $recursive_compiled_object, .. ], # validations => [ $recursive_compiled_object, .. ],
# schema => $builtin_validations,
# known_keys => { $key => 1, .. } # Extracted from 'keys', Used for the 'unknown' validation # known_keys => { $key => 1, .. } # Extracted from 'keys', Used for the 'unknown' validation
# %builtin_validations
# #
sub _compile($schema, $validations, $rec) { sub _compile($schema, $validations, $rec) {
my(%top, @val); my(%top, @val);
@ -125,26 +125,24 @@ sub _compile($schema, $validations, $rec) {
# Inherit some builtin options from validations # Inherit some builtin options from validations
for my $t (@val) { for my $t (@val) {
if ($top{type} && $t->{schema}{type} && $top{type} ne $t->{schema}{type}) { if ($top{type} && $t->{type} && $top{type} ne $t->{type}) {
confess "Incompatible types, the schema specifies '$top{type}' but validation '$t->{name}' requires '$t->{schema}{type}'" if $schema->{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->{schema}{type}', but another validation requires '$top{type}'"; confess "Incompatible types, '$t->[0]' requires '$t->{type}', but another validation requires '$top{type}'";
} }
exists $t->{schema}{$_} and !exists $top{$_} and $top{$_} = delete $t->{schema}{$_} exists $t->{$_} and !exists $top{$_} and $top{$_} = delete $t->{$_}
for qw/default onerror trim type scalar unknown missing sort unique/; for qw/default onerror trim type scalar unknown missing sort unique/;
push @keys, keys %{ delete $t->{known_keys} }; push @keys, keys %{ delete $t->{known_keys} };
push @keys, keys %{ $t->{schema}{keys} } if $t->{schema}{keys}; push @keys, keys %{ $t->{keys} } if $t->{keys};
} }
# Compile sub-schemas # Compile sub-schemas
$top{keys} = { map +($_, __PACKAGE__->compile($top{keys}{$_}, $validations)), keys $top{keys}->%* } if $top{keys}; $top{keys} = { map +($_, __PACKAGE__->compile($top{keys}{$_}, $validations)), keys $top{keys}->%* } if $top{keys};
$top{values} = __PACKAGE__->compile($top{values}, $validations) if $top{values}; $top{values} = __PACKAGE__->compile($top{values}, $validations) if $top{values};
return { $top{validations} = \@val;
validations => \@val, $top{known_keys} = { map +($_,1), @keys };
schema => \%top, \%top;
known_keys => { map +($_,1), @keys },
};
} }
@ -153,26 +151,26 @@ sub compile($pkg, $schema, $validations={}) {
my $c = _compile $schema, $validations, 64; my $c = _compile $schema, $validations, 64;
$c->{schema}{type} //= 'scalar'; $c->{type} //= 'scalar';
$c->{schema}{missing} //= 'create'; $c->{missing} //= 'create';
$c->{schema}{trim} //= 1 if $c->{schema}{type} eq 'scalar'; $c->{trim} //= 1 if $c->{type} eq 'scalar';
$c->{schema}{unknown} //= 'remove' if $c->{schema}{type} eq 'hash'; $c->{unknown} //= 'remove' if $c->{type} eq 'hash';
confess "Invalid value for 'type': $c->{schema}{type}" if !$type_vals{$c->{schema}{type}}; confess "Invalid value for 'type': $c->{type}" if !$type_vals{$c->{type}};
confess "Invalid value for 'missing': $c->{schema}{missing}" if !$missing_vals{$c->{schema}{missing}}; confess "Invalid value for 'missing': $c->{missing}" if !$missing_vals{$c->{missing}};
confess "Invalid value for 'unknown': $c->{schema}{unknown}" if exists $c->{schema}{unknown} && !$unknown_vals{$c->{schema}{unknown}}; confess "Invalid value for 'unknown': $c->{unknown}" if exists $c->{unknown} && !$unknown_vals{$c->{unknown}};
delete $c->{schema}{default} if ref $c->{schema}{default} eq 'SCALAR' && ${$c->{schema}{default}} eq 'required'; delete $c->{default} if ref $c->{default} eq 'SCALAR' && ${$c->{default}} eq 'required';
if (exists $c->{schema}{sort}) { if (exists $c->{sort}) {
my $s = $c->{schema}{sort}; my $s = $c->{sort};
$c->{schema}{sort} = $c->{sort} =
ref $s eq 'CODE' ? $s ref $s eq 'CODE' ? $s
: $s eq 'str' ? sub($x,$y) { $x cmp $y } : $s eq 'str' ? sub($x,$y) { $x cmp $y }
: $s eq 'num' ? sub($x,$y) { $x <=> $y } : $s eq 'num' ? sub($x,$y) { $x <=> $y }
: confess "Unknown value for 'sort': $c->{schema}{sort}"; : confess "Unknown value for 'sort': $c->{sort}";
} }
$c->{schema}{unique} = sub { $_[0] } if $c->{schema}{unique} && !ref $c->{schema}{unique} && !$c->{schema}{sort}; $c->{unique} = sub { $_[0] } if $c->{unique} && !ref $c->{unique} && !$c->{sort};
bless $c, $pkg; bless $c, $pkg;
} }
@ -182,14 +180,14 @@ sub _validate_rec {
my $c = $_[0]; my $c = $_[0];
# hash keys # hash keys
if ($c->{schema}{keys}) { if ($c->{keys}) {
my @err; my @err;
for my ($k, $s) ($c->{schema}{keys}->%*) { for my ($k, $s) ($c->{keys}->%*) {
if (!exists $_[1]{$k}) { if (!exists $_[1]{$k}) {
next if $s->{schema}{missing} eq 'ignore'; next if $s->{missing} eq 'ignore';
return { validation => 'missing', key => $k } if $s->{schema}{missing} eq 'reject'; return { validation => 'missing', key => $k } if $s->{missing} eq 'reject';
$_[1]{$k} = ref $s->{schema}{default} eq 'CODE' ? $s->{schema}{default}->() : $s->{schema}{default} // undef; $_[1]{$k} = ref $s->{default} eq 'CODE' ? $s->{default}->() : $s->{default} // undef;
next if exists $s->{schema}{default}; next if exists $s->{default};
} }
my $r = _validate($s, $_[1]{$k}); my $r = _validate($s, $_[1]{$k});
@ -202,10 +200,10 @@ sub _validate_rec {
} }
# array values # array values
if ($c->{schema}{values}) { if ($c->{values}) {
my @err; my @err;
for my $i (0..$#{$_[1]}) { for my $i (0..$#{$_[1]}) {
my $r = _validate($c->{schema}{values}, $_[1][$i]); my $r = _validate($c->{values}, $_[1][$i]);
if ($r) { if ($r) {
$r->{index} = $i; $r->{index} = $i;
push @err, $r; push @err, $r;
@ -226,8 +224,8 @@ sub _validate_rec {
} }
# func # func
if ($c->{schema}{func}) { if ($c->{func}) {
my $r = $c->{schema}{func}->($_[1]); my $r = $c->{func}->($_[1]);
return { %$r, validation => 'func' } if ref $r eq 'HASH'; return { %$r, validation => 'func' } if ref $r eq 'HASH';
return { validation => 'func', result => $r } if !$r; return { validation => 'func', result => $r } if !$r;
} }
@ -236,24 +234,24 @@ sub _validate_rec {
sub _validate_array { sub _validate_array {
my $c = $_[0]; my $c = $_[0];
return if $c->{schema}{type} ne 'array'; return if $c->{type} ne 'array';
$_[1] = [sort { $c->{schema}{sort}->($a, $b) } $_[1]->@* ] if $c->{schema}{sort}; $_[1] = [sort { $c->{sort}->($a, $b) } $_[1]->@* ] if $c->{sort};
# Key-based uniqueness # Key-based uniqueness
if ($c->{schema}{unique} && ref $c->{schema}{unique} eq 'CODE') { if ($c->{unique} && ref $c->{unique} eq 'CODE') {
my %h; my %h;
for my $i (0..$#{$_[1]}) { for my $i (0..$#{$_[1]}) {
my $k = $c->{schema}{unique}->($_[1][$i]); my $k = $c->{unique}->($_[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}; 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; $h{$k} = $i;
} }
# Comparison-based uniqueness # Comparison-based uniqueness
} elsif ($c->{schema}{unique}) { } elsif ($c->{unique}) {
for my $i (0..$#{$_[1]}-1) { 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] } return { validation => 'unique', index_a => $i, value_a => $_[1][$i], index_b => $i+1, value_b => $_[1][$i+1] }
if $c->{schema}{sort}->($_[1][$i], $_[1][$i+1]) == 0 if $c->{sort}->($_[1][$i], $_[1][$i+1]) == 0
} }
} }
} }
@ -263,29 +261,29 @@ sub _validate_input {
my $c = $_[0]; my $c = $_[0];
# trim (needs to be done before the 'default' test) # trim (needs to be done before the 'default' test)
$_[1] = trim $_[1] =~ s/\r//rg if defined $_[1] && !ref $_[1] && $c->{schema}{type} eq 'scalar' && $c->{schema}{trim}; $_[1] = trim $_[1] =~ s/\r//rg if defined $_[1] && !ref $_[1] && $c->{type} eq 'scalar' && $c->{trim};
# default # default
if (!defined $_[1] || (!ref $_[1] && $_[1] eq '')) { if (!defined $_[1] || (!ref $_[1] && $_[1] eq '')) {
if (exists $c->{schema}{default}) { if (exists $c->{default}) {
$_[1] = ref $c->{schema}{default} eq 'CODE' ? $c->{schema}{default}->($_[1]) : $c->{schema}{default}; $_[1] = ref $c->{default} eq 'CODE' ? $c->{default}->($_[1]) : $c->{default};
return; return;
} }
return { validation => 'required' }; return { validation => 'required' };
} }
if ($c->{schema}{type} eq 'scalar') { if ($c->{type} eq 'scalar') {
return { validation => 'type', expected => 'scalar', got => lc ref $_[1] } if ref $_[1]; return { validation => 'type', expected => 'scalar', got => lc ref $_[1] } if ref $_[1];
} elsif ($c->{schema}{type} eq 'hash') { } elsif ($c->{type} eq 'hash') {
return { validation => 'type', expected => 'hash', got => lc ref $_[1] || 'scalar' } if ref $_[1] ne '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 # Each branch below makes a shallow copy of the hash, so that further
# validations can perform in-place modifications without affecting the # validations can perform in-place modifications without affecting the
# input. # input.
if ($c->{schema}{unknown} eq 'remove') { if ($c->{unknown} eq 'remove') {
$_[1] = { map +($_, $_[1]{$_}), grep $c->{known_keys}{$_}, keys $_[1]->%* }; $_[1] = { map +($_, $_[1]{$_}), grep $c->{known_keys}{$_}, keys $_[1]->%* };
} elsif ($c->{schema}{unknown} eq 'reject') { } elsif ($c->{unknown} eq 'reject') {
my @err = grep !$c->{known_keys}{$_}, keys $_[1]->%*; my @err = grep !$c->{known_keys}{$_}, keys $_[1]->%*;
return { validation => 'unknown', keys => \@err, expected => [ sort keys %{$c->{known_keys}} ] } if @err; return { validation => 'unknown', keys => \@err, expected => [ sort keys %{$c->{known_keys}} ] } if @err;
$_[1] = { $_[1]->%* }; $_[1] = { $_[1]->%* };
@ -293,16 +291,16 @@ sub _validate_input {
$_[1] = { $_[1]->%* }; $_[1] = { $_[1]->%* };
} }
} elsif ($c->{schema}{type} eq 'array') { } elsif ($c->{type} eq 'array') {
$_[1] = [$_[1]] if $c->{schema}{scalar} && !ref $_[1]; $_[1] = [$_[1]] if $c->{scalar} && !ref $_[1];
return { validation => 'type', expected => $c->{schema}{scalar} ? 'array or scalar' : 'array', got => lc ref $_[1] || 'scalar' } if ref $_[1] ne 'ARRAY'; return { validation => 'type', expected => $c->{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. $_[1] = [$_[1]->@*]; # Create a shallow copy to prevent in-place modification.
} elsif ($c->{schema}{type} eq 'any') { } elsif ($c->{type} eq 'any') {
# No need to do anything here. # No need to do anything here.
} else { } else {
confess "Unknown type '$c->{schema}{type}'"; # Already checked in compile(), but be extra safe confess "Unknown type '$c->{type}'"; # Already checked in compile(), but be extra safe
} }
&_validate_rec || &_validate_array; &_validate_rec || &_validate_array;
@ -312,8 +310,8 @@ sub _validate_input {
sub _validate { sub _validate {
my $c = $_[0]; my $c = $_[0];
my $r = &_validate_input; my $r = &_validate_input;
($r, $_[1]) = (undef, ref $c->{schema}{onerror} eq 'CODE' ? $c->{schema}{onerror}->($_[0], bless $r, 'FU::Validate::err') : $c->{schema}{onerror}) ($r, $_[1]) = (undef, ref $c->{onerror} eq 'CODE' ? $c->{onerror}->($_[0], bless $r, 'FU::Validate::err') : $c->{onerror})
if $r && exists $c->{schema}{onerror}; if $r && exists $c->{onerror};
$r $r
} }