diff options
author | Yorhel <git@yorhel.nl> | 2018-04-15 10:11:09 +0200 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2018-04-15 10:11:11 +0200 |
commit | 1b0025f3140f5ef97a4222784cf2a38aa471d941 (patch) | |
tree | 3d4fa173d8ac1fd1d0bbce2415edf95ad4819bf9 /lib/TUWF | |
parent | fe5943688e9339e46cbec20a93f3ceb80d5d8f01 (diff) |
Integrate TUWF::Validate with the rest of TUWF
- Add a 'custom_validations' setting
- Add tuwf->compile() to compile with that setting
- Add tuwf->validate() as alternative to formValidate()
The new tuwf->validate() uses internal state of TUWF::Request, which had
to be changed a bit to allow for more efficient validation.
Nested schemas in TUWF::Validate now also accept compiled schemas.
This stuff totally needs more documentation.
Diffstat (limited to 'lib/TUWF')
-rw-r--r-- | lib/TUWF/Misc.pm | 43 | ||||
-rw-r--r-- | lib/TUWF/Misc.pod | 95 | ||||
-rw-r--r-- | lib/TUWF/Request.pm | 33 | ||||
-rw-r--r-- | lib/TUWF/Validate.pm | 3 |
4 files changed, 158 insertions, 16 deletions
diff --git a/lib/TUWF/Misc.pm b/lib/TUWF/Misc.pm index 91b3ae2..edea8de 100644 --- a/lib/TUWF/Misc.pm +++ b/lib/TUWF/Misc.pm @@ -13,7 +13,6 @@ use TUWF::Validate; our $VERSION = '1.2'; -our @EXPORT = ('formValidate', 'mail'); our @EXPORT_OK = ('uri_escape', 'kv_validate'); @@ -148,7 +147,7 @@ sub _validate { # value, \%templates, \%rules -sub formValidate { +sub TUWF::Object::formValidate { my($self, @fields) = @_; return kv_validate( { post => sub { $self->reqPosts(shift) }, @@ -164,7 +163,7 @@ sub formValidate { # A simple mail function, body and headers as arguments. Usage: # $self->mail('body', header1 => 'value of header 1', ..); -sub mail { +sub TUWF::Object::mail { my $self = shift; my $body = shift; my %hs = @_; @@ -192,4 +191,42 @@ sub mail { } +sub TUWF::Object::compile { + TUWF::Validate::compile($_[0]{_TUWF}{custom_validations}, $_[1]); +} + + +sub _compile { + ref $_[0] eq 'TUWF::Validate' ? $_[0] : $TUWF::OBJ->compile($_[0]); +} + + +sub TUWF::Object::validate { + my $self = shift; + my $what = shift; + + return _compile($_[0])->validate($self->reqJSON) if $what eq 'json'; + + # 'param' is special, and not really encouraged. Create a new hash based on + # reqParam() and cache the result. + $self->{_TUWF}{Req}{PARAM} ||= { + map { my @v = $self->reqParams($_); +($_, @v > 1 ? \@v : $v[0]) } $self->reqParams() + } if $what eq 'param'; + + my $source = + $what eq 'get' ? $self->{_TUWF}{Req}{GET} : + $what eq 'post' ? $self->{_TUWF}{Req}{POST} : + $what eq 'param' ? $self->{_TUWF}{Req}{PARAM} + : croak "Invalid source type '$what'"; + + # Multi-value, schema hash or object + return _compile($_[0])->validate($source) if @_ == 1; + + # Single value + return _compile($_[1])->validate($source->{$_[0]}) if @_ == 2; + + # Multi-value, separate params + _comile({ @_ })->validate($source); +} + 1; diff --git a/lib/TUWF/Misc.pod b/lib/TUWF/Misc.pod index 6e2b6ca..f2fd61d 100644 --- a/lib/TUWF/Misc.pod +++ b/lib/TUWF/Misc.pod @@ -28,6 +28,101 @@ Shorthand for calling C<kv_validate()> with the following sources: The L<validate_templates|TUWF/validate_templates> configuration setting is passed as the I<templates> option. +=head2 compile($schema) + +I<Experimental.> Short-hand for calling +L<TUWF::Validate::compile|TUWF::Validate/compile> with the +L<custom_validations|TUWF/custom_validations> option. For example: + + TUWF::set('custom_validations')->{username} = { length => [ 3, 32 ] }; + + my $val = tuwf->compile({ username => 1 })->validate('this is a username')->data; + +=head2 validate(what, @args) + +I<Experimental replacement for formValidate().> Validate and return request +data using L<TUWF::Validate>. The first argument must be the source of the data +to validate, the following sources are supported: + + Argument Source + post reqPosts() + get reqGets() + param reqParams() + json reqJSON() + +This method takes several different forms for the further arguments (the +examples below will perhaps make this more clear): + +=over + +=item Single value (C<< tuwf->validate($source, $param_name, $schema)> >>) + +In this form, only a single value is validated and returned. + +=item Hash value (C<< tuwf->validate($source, $schema) >>) + +In this form, the source is converted into a hash table and then validated. The +C<$schema> then validates the entire hash. + +=item Multiple values (C<< tuwf->validate($source, $param1, $schema1, $param2, $schema2, ..) >>) + +This form uses the syntax of the I<Single value> form to validate multiple +values. It is a convenient short-hand for the I<Hash value> form. + +=back + +The C<$schema> argument in the above description can be either a bare or +compiled schema. A bare schema will be compiled with the +L<custom_validations|TUWF/custom_validations> setting. + +The C<json> source only supports the I<Hash value> form. Using the C<param> +source is discouraged, as it is slower than using the C<get> or C<post> source +directly. And in almost all cases you only need to accept the data from either +the query string or the POST data, not both. + +If a get/post/param parameter has multiple values, it is represented in the +source data as an array. To handle parameters that may occur any number of +times, use a C<< {type => 'array', scalar => 1} >> schema. + +Some examples: + + # JSON, with custom error handling + my $validation_result = tuwf->validate(json => { + type => 'hash', + keys => { + username => { length => [ 3, 32 ] }, + password => { }, + } + }); + if($validation_result) { + my $data = $validation_result->data; + check_login($data->{username}, $data->{password}); + } else { + show_error(); + } + + # Single value + my $page_number = tuwf->validate(get => page => { uint => 1, max => 1000 })->data; + + # Same, with a pre-compiled scheme (this is faster) + state $c = tuwf->compile({ uint => 1, max => 1000 }); + my $page_number = tuwf->validate(get => page => $c)->data; + + # Multiple values + my $data = tuwf->validate(post => + username => { length => [ 3, 32 ] }, + password => { }, + )->data; + + # Same, using the "Hash value" form + my $data = tuwf->validate(post => { + type => 'hash', + keys => { + username => { length => [ 3, 32 ] }, + password => { }, + } + })->data; + =head2 mail(body, header => value, ..) Very simple email sending function. The C<Content-Type> header defaults to diff --git a/lib/TUWF/Request.pm b/lib/TUWF/Request.pm index 5d7647f..7ca545f 100644 --- a/lib/TUWF/Request.pm +++ b/lib/TUWF/Request.pm @@ -68,6 +68,12 @@ sub _check_control { } +sub _store { + return push @{$_[0]}, $_[1] if ref $_[0]; + $_[0] = $_[0] ? [$_[0], $_[1]] : $_[1]; +} + + sub _parse_urlencoded { my %dat; my $d = shift; @@ -84,7 +90,7 @@ sub _parse_urlencoded { s/%u([0-9a-fA-F]{4})/chr hex($1)/eg; _check_control($_); } - push @{$dat{$key}}, $val; + _store $dat{$key}, $val; } return \%dat; } @@ -142,11 +148,11 @@ sub _parse_multipart { # regular form element. The standards do not require the filename to be # present, but I am not aware of any browser that does not send it. if($filename) { - push @{$nfo->{POST}{$name}}, _check_control decode_utf8 $filename, 1; - push @{$nfo->{MIMES}{$name}}, _check_control decode_utf8 $mime, 1; - push @{$nfo->{FILES}{$name}}, $value; # not decoded, can be binary + _store $nfo->{POST}{$name}, _check_control decode_utf8 $filename, 1; + _store $nfo->{MIMES}{$name}, _check_control decode_utf8 $mime, 1; + _store $nfo->{FILES}{$name}, $value; # not decoded, can be binary } else { - push @{$nfo->{POST}{$name}}, _check_control decode_utf8 $value, 1; + _store $nfo->{POST}{$name}, _check_control decode_utf8 $value, 1; } } } @@ -179,14 +185,15 @@ sub _tablegets { my($k, $s, $n) = @_; my $lst = $s->{_TUWF}{Req}{$k}; return keys %$lst if @_ == 2; - return $lst->{$n} ? @{$lst->{$n}} : (); + my $v = $lst->{$n}; + ref $v ? @$v : $v ? ($v) : (); } sub _tableget { my($k, $s, $n) = @_; my $v = $s->{_TUWF}{Req}{$k}{$n}; - return $v ? $v->[0] : undef; + ref $v ? $v->[0] : $v; } @@ -209,9 +216,11 @@ sub reqParams { my %keys = map +($_,1), keys(%{$nfo->{GET}}), keys(%{$nfo->{POST}}); return keys %keys; } + my $p = $nfo->{POST}{$n}; + my $g = $nfo->{GET}{$n}; return ( - $nfo->{POST}{$n} ? @{$nfo->{POST}{$n}} : (), - $nfo->{GET}{$n} ? @{$nfo->{GET}{$n}} : (), + ref $p ? @$p : $p ? ($p) : (), + ref $g ? @$g : $g ? ($g) : (), ); } @@ -220,10 +229,8 @@ sub reqParams { sub reqParam { my($s, $n) = @_; my $nfo = $s->{_TUWF}{Req}; - return [ - $nfo->{POST}{$n} ? @{$nfo->{POST}{$n}} : (), - $nfo->{GET}{$n} ? @{$nfo->{GET}{$n}} : (), - ]->[0]; + my $v = $nfo->{POST}{$n} || $nfo->{GET}{$n}; + ref $v ? $v->[0] : $v; } diff --git a/lib/TUWF/Validate.pm b/lib/TUWF/Validate.pm index 4c661a3..adeb1d6 100644 --- a/lib/TUWF/Validate.pm +++ b/lib/TUWF/Validate.pm @@ -167,6 +167,9 @@ sub _compile { sub compile { my($validations, $schema) = @_; + + return $schema if ref $schema eq __PACKAGE__; + my $c = _compile $validations, $schema, 64; $c->{schema}{type} //= 'scalar'; |