]> git.imager.perl.org - bse.git/blobdiff - site/cgi-bin/modules/DevHelp/Validate.pm
more metadata generalization and modification
[bse.git] / site / cgi-bin / modules / DevHelp / Validate.pm
index 4a55ee126890e48295fc0fa0812b12a3412dfc44..467b51e4980da3bda101a435d2c75272778648d1 100644 (file)
@@ -6,13 +6,26 @@ use vars qw(@EXPORT_OK @ISA);
 @ISA = qw(Exporter);
 use Carp qw(confess);
 
-our $VERSION = "1.003";
+our $VERSION = "1.008";
+
+my $re_real =
+  qr/
+      (
+       [-+]?   # optional sign
+       (?:
+         [0-9]+(?:\.[0-9]*)?   # either 9 with optional decimal digits
+         |
+         \.[0-9]+         # or . with required digits
+       )
+       (?:[eE][-+]?[0-9]+)?  # optional exponent
+      )
+    /x;
 
 my %built_ins =
   (
    email => 
    {
-    match => qr/^[^\@]+\@[\w.-]+\.\w+$/,
+    match => qr/^[^\s\@][^\@]*\@[\w.-]+\.\w+$/,
     error => '$n is not a valid email address',
    },
    phone => 
@@ -125,6 +138,10 @@ my %built_ins =
     maxdate => '+1d',
     maxdatemsg => 'The date entered must be in the past',
    },
+   time =>
+   {
+    time => 1,
+   },
    integer =>
    {
     integer => 1,
@@ -142,6 +159,10 @@ my %built_ins =
     nomatch => qr/[\x0D\x0A]/,
     error => '$n may only contain a single line',
    },
+   real =>
+   {
+    real => 1,
+   },
    time =>
    {
     # we accept 24-hour time, or 12 hour with (a|p|am|pm)
@@ -276,6 +297,11 @@ sub _validate {
   !keys %$errors;
 }
 
+my @dow_tokens = qw(sun mon tue wed thu fri sat);
+my @dow_names = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
+my %dow_trans;
+@dow_trans{@dow_tokens} = @dow_names;
+
 sub validate_field {
   my ($self, $field, $info, $rules, $optional, $errors) = @_;
 
@@ -368,7 +394,7 @@ sub validate_field {
        }
       }
       if ($rule->{integer}) {
-       unless ($data =~ /^\s*([-+]?\d+)s*$/) {
+       unless ($data =~ /^\s*([-+]?\d+)\s*$/) {
          $errors->{$field} = _make_error($field, $info, $rule,
                                          '$n must be a whole number');
          last RULE;
@@ -440,6 +466,37 @@ sub validate_field {
            }
          }
        }
+       if (defined $rule->{dow}) { # could be "0" for Sunday
+         my $dow = DevHelp::Date::dh_date_dow($year, $month, $day);
+         my ($dow_name) = $dow_tokens[$dow];
+         unless ($rule->{dow} =~ /\b($dow|$dow_name)\b/i) {
+           my @valid_dow = map {
+             ;$_ =~ /[0-7]/ ? $dow_names[$_] : $dow_trans{$_}
+           } split /,/, $rule->{dow};
+           my $valid_dow = @valid_dow > 1
+             ? "any of " . join(", ", @valid_dow)
+               : "a @valid_dow";
+           $errors->{$field} =
+             _make_error($field, $info, $rule,
+                         $info->{dowmsg} || $rule->{dowmsg}
+                         || ('$n must fall on ' . $valid_dow));
+           last RULE;
+         }
+       }
+      }
+      if ($rule->{time}) {
+       require DevHelp::Date;
+       my $msg;
+       if (my ($hour, $min, $sec)
+           = DevHelp::Date::dh_parse_time($data, \$msg)) {
+         # nothing to do here yet, later it will allow limits
+       }
+       else {
+         $errors->{$field} =
+           _make_error($field, $info, $rule,
+                       '$n is not a valid time of day');
+         last RULE;
+       }
       }
       if ($rule->{confirm}) {
        my $other = $self->param($rule->{confirm});
@@ -510,10 +567,40 @@ sub validate_field {
          last RULE;
        }
       }
+      if ($rule->{real}) {
+       unless ($data =~ /^\s*$re_real\s*$/) {
+         $errors->{$field} = _make_error($field, $info, $rule,
+                                         '$n must be a number');
+         last RULE;
+       }
+       my $num = $1;
+       if (my ($from, $to) = $rule->{real} =~ /^$re_real\s*-\s*$re_real$/) {
+         unless ($from <= $num and $num <= $to) {
+           $errors->{$field} = _make_error($field, $info, $rule,
+                                           $info->{range_error} ||
+                                           $rule->{range_error} ||
+                                           "\$n must be in the range $from to $to");
+           last RULE;
+         }
+       }
+       elsif (my ($from2) = $rule->{real} =~ /^\s*$re_real\s*-$/) {
+         unless ($from2 <= $num) {
+           $errors->{$field} = _make_error($field, $info, $rule,
+                                           $info->{range_error} ||
+                                           $rule->{range_error} ||
+                                           "\$n must be $from2 or higher");
+           last RULE;
+         }
+       }
+      }
       if ($rule->{ref}) {
        my $method = $rule->{method}
          or confess "Missing method in ref rule $rule_name";
-       unless ($rule->{ref}->$method($data)) {
+       my $before = $rule->{before};
+       my @before = defined $before ? ( ref $before ? @$before : split /,/, $before ) : ();
+       my $after = $rule->{after};
+       my @after = defined $after ? ( ref $after ? @$after : split /,/, $after ) : ();
+       unless ($rule->{ref}->$method(@before, $data, @after)) {
          $errors->{$field} = _make_error($field, $info, $rule, 'No such $n');
          last RULE;
        }
@@ -807,6 +894,8 @@ DevHelp::Validate - handy configurable validation, I hope
 
 =head1 DESCRIPTION
 
+Performs simple validation of CGI or hash data.
+
 =head1 RULES PARAMETER
 
 The rules parameter is a hash with 2 keys:
@@ -835,7 +924,7 @@ A short description of the field, for use in error messages.
 =item rules
 
 A hash of rules.  See the rules description under L<CONFIGURED
-VALIDATON>.
+VALIDATION>.
 
 =back
 
@@ -849,9 +938,9 @@ The values of those keys gives the name of a validation rule, a string
 id for internationlization of the field description and a default
 field description, separated by commas.
 
-Each validation rule name has a corresponding section, [Validate Rule
-I<rule-name>], which describes the rule.  Rule names can also refer to
-built-in rules,
+Each validation rule name has a corresponding section,C<< [Validation
+Rule I<rule-name>] >>, which describes the rule.  Rule names can also
+refer to built-in rules,
 
 Values in the validation rule section are:
 
@@ -881,6 +970,13 @@ If set to 1, simply ensures the value is an integer.
 If set to a range I<integer>-I<integer> then ensures the value is an
 integer in that range.
 
+=item real
+
+If set to 1, simply ensures the value is an real number.
+
+If set to a range C<< I<real> - I<real> >> then ensures the value is
+a real number in that range.
+
 =item date
 
 If set to 1, simply validates the value as a date.
@@ -891,6 +987,16 @@ mindatemsg from the field or rule for the error message.
 Set maxdate to specify a maximum date for range validation.  Uses
 maxdatemsg from the field or rule for the error message.
 
+Set C<dow> to a comma-separated list of number from 0 to 6, or 3
+letter day of week abbreviations to require the date be only on those
+days of week.  Uses C<dowmsg> from the field or rule for the error
+message.
+
+=item time
+
+If true, validates that the value can be parsed by
+L<DevHelp::Date/dh_parse_time()>.
+
 =item confirm
 
 Specify another field that the field must be equal to, intended for
@@ -913,6 +1019,12 @@ with the value to check as a parameter.  The value is considered value
 if the result is true.  This is intended for checking the existence of
 objects in a collection.
 
+Optionally C<before> can be an array ref or comma-separated list of
+parameters to supply before the value.
+
+Optionally C<after> can be an array ref or comma-separated list of
+parameters to supply after the value.
+
 =back
 
 =head1 BUILT-IN RULES
@@ -999,6 +1111,10 @@ past.
 
 A valid date in the future.
 
+=item time
+
+Parses as a time as per dh_parse_time().
+
 =item integer
 
 Any integer.