From 1b0025f3140f5ef97a4222784cf2a38aa471d941 Mon Sep 17 00:00:00 2001
From: Yorhel <git@yorhel.nl>
Date: Sun, 15 Apr 2018 10:11:09 +0200
Subject: 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.
---
 lib/TUWF/Request.pm | 33 ++++++++++++++++++++-------------
 1 file changed, 20 insertions(+), 13 deletions(-)

(limited to 'lib/TUWF/Request.pm')

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;
 }
 
 
-- 
cgit v1.2.3