Validate: remove a level of indirection
This commit is contained in:
Yorhel
parent
9685287523
commit
64a105e013
3 changed files with 56 additions and 56 deletions
|
|
@ -123,7 +123,9 @@ module makes an attempt to avoid any further copies of data values.
|
|||
|
||||
=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
|
||||
valid value for the C<Content-Type> request header, and the given C<$body>,
|
||||
|
|
|
|||
2
FU/Pg.pm
2
FU/Pg.pm
|
|
@ -806,7 +806,7 @@ error if something went wrong.
|
|||
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
|
||||
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.
|
||||
|
||||
It is not I<necessary> to call this method, simply letting the C<$copy> object
|
||||
|
|
|
|||
106
FU/Validate.pm
106
FU/Validate.pm
|
|
@ -94,8 +94,8 @@ our %default_validations = (
|
|||
#
|
||||
# name => $name_or_undef,
|
||||
# validations => [ $recursive_compiled_object, .. ],
|
||||
# schema => $builtin_validations,
|
||||
# known_keys => { $key => 1, .. } # Extracted from 'keys', Used for the 'unknown' validation
|
||||
# %builtin_validations
|
||||
#
|
||||
sub _compile($schema, $validations, $rec) {
|
||||
my(%top, @val);
|
||||
|
|
@ -125,26 +125,24 @@ sub _compile($schema, $validations, $rec) {
|
|||
|
||||
# Inherit some builtin options from validations
|
||||
for my $t (@val) {
|
||||
if ($top{type} && $t->{schema}{type} && $top{type} ne $t->{schema}{type}) {
|
||||
confess "Incompatible types, the schema specifies '$top{type}' but validation '$t->{name}' requires '$t->{schema}{type}'" if $schema->{type};
|
||||
confess "Incompatible types, '$t->[0]' requires '$t->{schema}{type}', but another validation requires '$top{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->{type}'" if $schema->{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/;
|
||||
|
||||
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
|
||||
$top{keys} = { map +($_, __PACKAGE__->compile($top{keys}{$_}, $validations)), keys $top{keys}->%* } if $top{keys};
|
||||
$top{values} = __PACKAGE__->compile($top{values}, $validations) if $top{values};
|
||||
|
||||
return {
|
||||
validations => \@val,
|
||||
schema => \%top,
|
||||
known_keys => { map +($_,1), @keys },
|
||||
};
|
||||
$top{validations} = \@val;
|
||||
$top{known_keys} = { map +($_,1), @keys };
|
||||
\%top;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -153,26 +151,26 @@ sub compile($pkg, $schema, $validations={}) {
|
|||
|
||||
my $c = _compile $schema, $validations, 64;
|
||||
|
||||
$c->{schema}{type} //= 'scalar';
|
||||
$c->{schema}{missing} //= 'create';
|
||||
$c->{schema}{trim} //= 1 if $c->{schema}{type} eq 'scalar';
|
||||
$c->{schema}{unknown} //= 'remove' if $c->{schema}{type} eq 'hash';
|
||||
$c->{type} //= 'scalar';
|
||||
$c->{missing} //= 'create';
|
||||
$c->{trim} //= 1 if $c->{type} eq 'scalar';
|
||||
$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 'missing': $c->{schema}{missing}" if !$missing_vals{$c->{schema}{missing}};
|
||||
confess "Invalid value for 'unknown': $c->{schema}{unknown}" if exists $c->{schema}{unknown} && !$unknown_vals{$c->{schema}{unknown}};
|
||||
confess "Invalid value for 'type': $c->{type}" if !$type_vals{$c->{type}};
|
||||
confess "Invalid value for 'missing': $c->{missing}" if !$missing_vals{$c->{missing}};
|
||||
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}) {
|
||||
my $s = $c->{schema}{sort};
|
||||
$c->{schema}{sort} =
|
||||
if (exists $c->{sort}) {
|
||||
my $s = $c->{sort};
|
||||
$c->{sort} =
|
||||
ref $s eq 'CODE' ? $s
|
||||
: $s eq 'str' ? sub($x,$y) { $x cmp $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;
|
||||
}
|
||||
|
|
@ -182,14 +180,14 @@ sub _validate_rec {
|
|||
my $c = $_[0];
|
||||
|
||||
# hash keys
|
||||
if ($c->{schema}{keys}) {
|
||||
if ($c->{keys}) {
|
||||
my @err;
|
||||
for my ($k, $s) ($c->{schema}{keys}->%*) {
|
||||
for my ($k, $s) ($c->{keys}->%*) {
|
||||
if (!exists $_[1]{$k}) {
|
||||
next if $s->{schema}{missing} eq 'ignore';
|
||||
return { validation => 'missing', key => $k } if $s->{schema}{missing} eq 'reject';
|
||||
$_[1]{$k} = ref $s->{schema}{default} eq 'CODE' ? $s->{schema}{default}->() : $s->{schema}{default} // undef;
|
||||
next if exists $s->{schema}{default};
|
||||
next if $s->{missing} eq 'ignore';
|
||||
return { validation => 'missing', key => $k } if $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});
|
||||
|
|
@ -202,10 +200,10 @@ sub _validate_rec {
|
|||
}
|
||||
|
||||
# array values
|
||||
if ($c->{schema}{values}) {
|
||||
if ($c->{values}) {
|
||||
my @err;
|
||||
for my $i (0..$#{$_[1]}) {
|
||||
my $r = _validate($c->{schema}{values}, $_[1][$i]);
|
||||
my $r = _validate($c->{values}, $_[1][$i]);
|
||||
if ($r) {
|
||||
$r->{index} = $i;
|
||||
push @err, $r;
|
||||
|
|
@ -226,8 +224,8 @@ sub _validate_rec {
|
|||
}
|
||||
|
||||
# func
|
||||
if ($c->{schema}{func}) {
|
||||
my $r = $c->{schema}{func}->($_[1]);
|
||||
if ($c->{func}) {
|
||||
my $r = $c->{func}->($_[1]);
|
||||
return { %$r, validation => 'func' } if ref $r eq 'HASH';
|
||||
return { validation => 'func', result => $r } if !$r;
|
||||
}
|
||||
|
|
@ -236,24 +234,24 @@ sub _validate_rec {
|
|||
|
||||
sub _validate_array {
|
||||
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
|
||||
if ($c->{schema}{unique} && ref $c->{schema}{unique} eq 'CODE') {
|
||||
if ($c->{unique} && ref $c->{unique} eq 'CODE') {
|
||||
my %h;
|
||||
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};
|
||||
$h{$k} = $i;
|
||||
}
|
||||
|
||||
# Comparison-based uniqueness
|
||||
} elsif ($c->{schema}{unique}) {
|
||||
} 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->{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];
|
||||
|
||||
# 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
|
||||
if (!defined $_[1] || (!ref $_[1] && $_[1] eq '')) {
|
||||
if (exists $c->{schema}{default}) {
|
||||
$_[1] = ref $c->{schema}{default} eq 'CODE' ? $c->{schema}{default}->($_[1]) : $c->{schema}{default};
|
||||
if (exists $c->{default}) {
|
||||
$_[1] = ref $c->{default} eq 'CODE' ? $c->{default}->($_[1]) : $c->{default};
|
||||
return;
|
||||
}
|
||||
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];
|
||||
|
||||
} 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';
|
||||
|
||||
# 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->{schema}{unknown} eq 'remove') {
|
||||
if ($c->{unknown} eq 'remove') {
|
||||
$_[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]->%*;
|
||||
return { validation => 'unknown', keys => \@err, expected => [ sort keys %{$c->{known_keys}} ] } if @err;
|
||||
$_[1] = { $_[1]->%* };
|
||||
|
|
@ -293,16 +291,16 @@ sub _validate_input {
|
|||
$_[1] = { $_[1]->%* };
|
||||
}
|
||||
|
||||
} elsif ($c->{schema}{type} eq 'array') {
|
||||
$_[1] = [$_[1]] if $c->{schema}{scalar} && !ref $_[1];
|
||||
return { validation => 'type', expected => $c->{schema}{scalar} ? 'array or scalar' : 'array', got => lc ref $_[1] || 'scalar' } if ref $_[1] ne 'ARRAY';
|
||||
} elsif ($c->{type} eq 'array') {
|
||||
$_[1] = [$_[1]] if $c->{scalar} && !ref $_[1];
|
||||
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.
|
||||
|
||||
} elsif ($c->{schema}{type} eq 'any') {
|
||||
} elsif ($c->{type} eq 'any') {
|
||||
# No need to do anything here.
|
||||
|
||||
} 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;
|
||||
|
|
@ -312,8 +310,8 @@ sub _validate_input {
|
|||
sub _validate {
|
||||
my $c = $_[0];
|
||||
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})
|
||||
if $r && exists $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->{onerror};
|
||||
$r
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue