Validate: remove a level of indirection
This commit is contained in:
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
|
=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>,
|
||||||
|
|
|
||||||
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
|
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
|
||||||
|
|
|
||||||
106
FU/Validate.pm
106
FU/Validate.pm
|
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue