add rule mechanisms for real number validation

diff --git a/site/cgi-bin/modules/DevHelp/Validate.pm b/site/cgi-bin/modules/DevHelp/Validate.pm
index bc0b023c266baa3c064d622aa97754b1ac6f3f09..dbdc071f1cb7ae8214b061fd023d961fea2e4e9a 100644 (file)
--- a/site/cgi-bin/modules/DevHelp/Validate.pm
+++ b/site/cgi-bin/modules/DevHelp/Validate.pm
@@ -6,7 +6,20 @@ use vars qw(@EXPORT_OK @ISA);
 @ISA = qw(Exporter);
 use Carp qw(confess);
 
-our $VERSION = "1.005";
+our $VERSION = "1.006";
+
+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 =
   (
@@ -377,7 +390,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;
@@ -550,6 +563,32 @@ 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";
@@ -927,6 +966,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.

diff --git a/t/010-modules/020-validate.t b/t/010-modules/020-validate.t
index d4da57e3afecd300a51c764b15d32ed8d02a03d6..28ccab6d65b392764a1d6a7b804da31ead70d5c8 100644 (file)
--- a/t/010-modules/020-validate.t
+++ b/t/010-modules/020-validate.t
@@ -1,6 +1,6 @@
 #!perl -w
 use strict;
-use Test::More tests => 38;
+use Test::More tests => 82;
 
 BEGIN { use_ok('DevHelp::Validate'); }
 
@@ -228,3 +228,87 @@ BEGIN { use_ok('DevHelp::Validate'); }
   ok($val->validate({time => "12pm" }, \%errors), "simple 12pm");
   ok(!$val->validate({time => "13pm" }, \%errors), "simple 13pm");
 }
+
+# reals
+{
+  my @rules =
+    (
+     {
+      name => "simple",
+      rule =>
+      {
+       real => 1,
+      },
+      tests =>
+      [
+       [ "1", 1, undef ],
+       [ "2.", 1, undef ],
+       [ "100", 1, undef ],
+       [ " 100", 1, undef ],
+       [ " 100 ", 1, undef ],
+       [ "1e10", 1, undef ],
+       [ "1E10", 1, undef ],
+       [ "-10", 1, undef ],
+       [ "+10", 1, undef ],
+       [ "0.1", 1, undef ],
+       [ ".1", 1, undef ],
+       [ "1.1e10", 1, undef ],
+       [ "1.1e+10", 1, undef ],
+       [ "1.1e-10", 1, undef ],
+       [ "1.1e-2", 1, undef ],
+       [ "abc", '', "Value must be a number" ],
+      ],
+     },
+     {
+      name => "0 or more",
+      rule =>
+      {
+       real => "0 -",
+      },
+      tests =>
+      [
+       [ "0", 1, undef ],
+       [ "-1", '', "Value must be 0 or higher" ],
+      ],
+     },
+     {
+      name => "0 to 100",
+      rule =>
+      {
+       real => "0 - 100",
+      },
+      tests =>
+      [
+       [ "0", 1, undef ],
+       [ "1", 1, undef ],
+       [ "-1", "", "Value must be in the range 0 to 100" ],
+       [ "101", "", "Value must be in the range 0 to 100" ],
+      ],
+     },
+    );
+
+  for my $rule (@rules) {
+    for my $test (@{$rule->{tests}}) {
+      my $val = DevHelp::Validate::Hash->new
+       (
+        fields =>
+        {
+         value =>
+         {
+          rules => "test",
+          description => "Value",
+         },
+        },
+        rules =>
+        {
+         test => $rule->{rule},
+        },
+       );
+      my %errors;
+      my $name = "rule '$rule->{name}' value '$test->[0]'";
+      is($val->validate({ value => $test->[0] }, \%errors), $test->[1],
+        "$name: validate");
+      is($errors{value}, $test->[2], "$name: message");
+    }
+  }
+}