site/cgi-bin/modules/DevHelp/Validate.pm

   1 package DevHelp::Validate;
   2 use strict;
   3 require Exporter;
   4 use vars qw(@EXPORT_OK @ISA);
   5 @EXPORT_OK = qw(dh_validate dh_validate_hash dh_fieldnames dh_configure_fields);
   6 @ISA = qw(Exporter);
   7
   8 my %built_ins =
   9   (
  10    email =>
  11    {
  12     match => qr/^[^\@]+\@[\w.-]+\.\w+$/,
  13     error => '$n is not a valid email address',
  14    },
  15    phone =>
  16    {
  17     match => qr/\d(?:\D*\d){3}/,
  18     error => '$n is not a valid phone number',
  19    },
  20    postcode =>
  21    {
  22     match => qr/\d(?:\D*\d){3}/,
  23     error => '$n is not a valid post code',
  24    },
  25    url =>
  26    {
  27     match => qr!^\w+://[\w-]+(?:\.[\w-]+)+(?::\d+)?!,
  28     error => '$n is not a valid URL',
  29    },
  30    weburl =>
  31    {
  32     match => qr!^https?://[\w-]+(?:\.[\w-]+)+(?::\d+)?!,
  33     error => '$n is not a valid URL, it must start with http:// or https://',
  34    },
  35    newbieweburl =>
  36    {
  37     match => qr!^(?:https?://)?[\w-]+(?:\.[\w-]+)+(?::\d+)?!,
  38     error => '$n is not a valid URL',
  39    },
  40    confirm =>
  41    {
  42     confirm=>'password',
  43    },
  44    newconfirm =>
  45    {
  46     newconfirm=>'password',
  47    },
  48    required =>
  49    {
  50     required => 1,
  51    },
  52    abn =>
  53    {
  54     match => qr/\d(?:\D*\d){7}/,
  55     error => '$n is not a valid ABN',
  56    },
  57    creditcardnumber =>
  58    {
  59     match => qr/^\D*\d(?:\D*\d){11,15}\D*$/,
  60     error => '$n is not a valid credit card number',
  61    },
  62    creditcardexpiry =>
  63    {
  64     ccexpiry => 1,
  65    },
  66    creditcardexpirysingle =>
  67    {
  68     ccexpirysingle => 1,
  69    },
  70    creditcardcvv =>
  71    {
  72     match => qr/^(\d){3,4}$/,
  73     error => '$n is the 3 or 4 digit code on the back of your card',
  74    },
  75    miaa =>
  76    {
  77     match => qr/^\s*\d{1,6}\s*$/,
  78     error => 'Not a valid MIAA membership number',
  79    },
  80    decimal =>
  81    {
  82     match => qr/^\s*(?:\d+(?:\.\d*)?|\.\d+)\s*$/,
  83     error => 'Not a valid number',
  84    },
  85    money =>
  86    {
  87     match => qr/^\s*(?:\d+(?:\.\d\d)?|\.\d\d)\s*$/,
  88     error => 'Not a valid money amount',
  89    },
  90    date =>
  91    {
  92     date => 1,
  93    },
  94    birthdate =>
  95    {
  96     date => 1,
  97     maxdate => '+0y',
  98     maxdatemsg => 'Your $n must be in the past',
  99    },
 100    adultbirthdate =>
 101    {
 102     date => 1,
 103     maxdate => '-10y',
 104     maxdatemsg => 'You must be at least 10 years old...',
 105     mindate => '-100y',
 106    },
 107    futuredate =>
 108    {
 109     date => 1,
 110     mindate => '-1d',
 111     mindatemsg => 'The date entered must be in the future',
 112    },
 113    pastdate =>
 114    {
 115     date => 1,
 116     maxdate => '+1d',
 117     maxdatemsg => 'The date entered must be in the past',
 118    },
 119    natural =>
 120    {
 121     integer => '0-', # 0 or higher
 122    },
 123    positiveint =>
 124    {
 125     integer => '1-', # 1 or higher
 126    },
 127    dh_one_line =>
 128    {
 129     nomatch => qr/[\x0D\x0A]/,
 130     error => '$n may only contain a single line',
 131    },
 132    time =>
 133    {
 134     # we accept 24-hour time, or 12 hour with (a|p|am|pm)
 135     match => qr!^(?:                   # first 24 hour time:
 136                    (?:[01]?\d|2[0-3])  # hour 0-23
 137                       [:.]             # separator
 138                       [0-5]\d          # minute
 139                   |                    # or 12 hour time:
 140                     (?:0?[1-9]|1[012]) # hour 1-12
 141                      (?:[:.]           # optionally separator followed
 142                       [0-5]\d)?        # by minutes
 143                     [ap]m?             # followed by afternoon/morning
 144                   )$!ix,
 145     error=>'Invalid time $n',
 146    },
 147   );
 148
 149 sub new {
 150   my ($class, %opts) = @_;
 151
 152   my $self = bless \%opts, $class;
 153
 154   # configure validation
 155   my $fields = $self->{fields};
 156   my $rules = $self->{rules} || {};
 157
 158   my %cfg_rules;
 159   _get_cfg_fields(\%cfg_rules, $self->{cfg}, $self->{section}, $fields)
 160     if $self->{cfg} && $self->{section};
 161
 162   for my $rulename (keys %$rules) {
 163     unless (exists $cfg_rules{rules}{$rulename}) {
 164       $cfg_rules{rules}{$rulename} = $rules->{$rulename};
 165     }
 166   }
 167   for my $rulename (keys %built_ins) {
 168     unless (exists $cfg_rules{rules}{$rulename}) {
 169       $cfg_rules{rules}{$rulename} = $built_ins{$rulename};
 170     }
 171   }
 172
 173   # merge the supplied fields into the config fields
 174   my $cfg_fields = $cfg_rules{fields};
 175   for my $field ( keys %$fields ) {
 176     my $src = $fields->{$field};
 177
 178     my $dest = $cfg_fields->{$field} || {};
 179
 180     # the config overrides the software supplied fields
 181     for my $override (qw(description required required_error)) {
 182       if (defined $src->{$override} && !defined $dest->{$override}) {
 183         $dest->{$override} = $src->{$override};
 184       }
 185     }
 186
 187     # but we add rules and required_if
 188     if ($dest->{rules}) {
 189       my $rules = $src->{rules};
 190
 191       # make a copy of the rules array if it's supplied that way so
 192       # we don't modify someone else's data
 193       $rules = ref $rules ? [ @$rules ] : [ split /;/, $rules ];
 194
 195       push @$rules, split /;/, $dest->{rules};
 196     }
 197     elsif ($src->{rules}) {
 198       $dest->{rules} = $src->{rules};
 199     }
 200     if ($dest->{required_if}) {
 201       $dest->{required_if} .= ";" . $src->{required_if} if $src->{required_if};
 202     }
 203     elsif ($src->{required_if}) {
 204       $dest->{required_if} = $src->{required_if};
 205     }
 206
 207     $cfg_fields->{$field} = $dest if keys %$dest;
 208   }
 209
 210   $self->{cfg_fields} = $cfg_fields;
 211   $self->{cfg_rules} = $cfg_rules{rules};
 212
 213   return $self;
 214 }
 215
 216 sub dh_validate {
 217   my ($cgi, $errors, $validation, $cfg, $section) = @_;
 218
 219   return DevHelp::Validate::CGI->new(cfg=>$cfg, section=>$section, fields=>$validation->{fields}, rules=>$validation->{rules}, optional=>$validation->{optional})
 220     ->validate($cgi, $errors);
 221 }
 222
 223 sub dh_validate_hash {
 224   my ($hash, $errors, $validation, $cfg, $section) = @_;
 225
 226   return DevHelp::Validate::Hash->new(cfg=>$cfg, section=>$section, fields=>$validation->{fields}, rules=>$validation->{rules}, optional=>$validation->{optional})
 227     ->validate($hash, $errors);
 228 }
 229
 230 sub _validate {
 231   my ($self, $errors) = @_;
 232
 233   my $cfg_fields = $self->{cfg_fields};
 234   my $cfg_rules = $self->{cfg_rules};
 235   my $optional = $self->{optional};
 236
 237   for my $field ( keys %$cfg_fields ) {
 238     $self->validate_field($field, $cfg_fields->{$field}, $cfg_rules,
 239                           $optional, $errors);
 240   }
 241
 242   !keys %$errors;
 243 }
 244
 245 sub validate_field {
 246   my ($self, $field, $info, $rules, $optional, $errors) = @_;
 247
 248   my @data = $self->param($field);
 249
 250   my $required = $info->{required};
 251   if (@data && $data[0] !~ /\S/ && $info->{required_if}) {
 252     # field is required if any of the named fields are non-blank
 253     for my $testfield (split /;/, $info->{required_if}) {
 254       my $testvalue = $self->param($testfield);
 255       if (defined $testvalue && $testvalue =~ /\S/) {
 256         ++$required;
 257         last;
 258       }
 259     }
 260   }
 261
 262   my $rule_names = $info->{rules};
 263   defined $rule_names or $rule_names = '';
 264   $rule_names = [ split /;/, $rule_names ] unless ref $rule_names;
 265
 266   push @$rule_names, 'required' if $required;
 267
 268   @$rule_names or return;
 269
 270  RULE: for my $rule_name (@$rule_names) {
 271     my $rule = $rules->{$rule_name};
 272     unless ($rule) {
 273       $rule = $self->_get_cfg_rule($rule_name);
 274       if ($rule) {
 275         $rules->{$rule_name} = $rule;
 276       }
 277       else {
 278         print STDERR "** Unknown validation rule $rule_name for $field\n";
 279       }
 280     }
 281     if (!$optional && $rule->{required} && !@data ) {
 282       $errors->{$field} = _make_error($field, $info, $rule,
 283                                       $info->{required_error} ||
 284                                       $rule->{required_error} ||
 285                                       '$n is a required field');
 286       last RULE;
 287     }
 288     for my $data (@data) {
 289       if ($rule->{required} && $data !~ /\S/) {
 290         $errors->{$field} = _make_error($field, $info, $rule,
 291                                         $info->{required_error} ||
 292                                         $rule->{required_error} ||
 293                                         '$n is a required field');
 294         last RULE;
 295       }
 296       if ($rule->{newconfirm}) {
 297         my $other = $self->param($rule->{newconfirm});
 298         if ($other ne '' || $data ne '') {
 299           if ($other ne $data) {
 300             $errors->{$field} = _make_error($field, $info, $rule,
 301                                             q!$n doesn't match the password!);
 302             last RULE;
 303           }
 304         }
 305       }
 306       if ($data !~ /\S/ && !$rule->{required}) {
 307         next RULE;
 308       }
 309       if ($rule->{match}) {
 310         my $match = $rule->{match};
 311         unless ($data =~ /$match/) {
 312           $errors->{$field} = _make_error($field, $info, $rule);
 313           last RULE;
 314         }
 315       }
 316       if (defined $rule->{nomatch}) {
 317         my $match = $rule->{nomatch};
 318         if ($data =~ /$match/) {
 319           $errors->{$field} = _make_error($field, $info, $rule);
 320           last RULE;
 321         }
 322       }
 323       if ($rule->{integer}) {
 324         unless ($data =~ /^\s*([-+]?\d+)s*$/) {
 325           $errors->{$field} = _make_error($field, $info, $rule,
 326                                           '$n must be a whole number');
 327           last RULE;
 328         }
 329         my $num = $1;
 330         if (my ($from, $to) = $rule->{integer} =~ /^([+-]?\d+)-([+-]?\d+)$/) {
 331           unless ($from <= $num and $num <= $to) {
 332             $errors->{$field} = _make_error($field, $info, $rule,
 333                                             $info->{range_error} ||
 334                                             $rule->{range_error} ||
 335                                             "\$n must be in the range $from to $to");
 336             last RULE;
 337           }
 338         }
 339         elsif (my ($from2) = $rule->{integer} =~ /^([+-]?\d+)-$/) {
 340           unless ($from2 <= $num) {
 341             $errors->{$field} = _make_error($field, $info, $rule,
 342                                             $info->{range_error} ||
 343                                             $rule->{range_error} ||
 344                                             "\$n must be $from2 or higher");
 345             last RULE;
 346           }
 347         }
 348       }
 349       if ($rule->{date}) {
 350         unless ($data =~ m!^\s*(\d+)[-+/](\d+)[-+/](\d+)\s*$!) {
 351           $errors->{$field} = _make_error($field, $info, $rule,
 352                                           '$n must be a valid date');
 353           last RULE;
 354         }
 355         my ($day, $month, $year) = ($1, $2, $3);
 356         if ($day < 1 || $day > 31) {
 357           $errors->{$field} = _make_error($field, $info, $rule,
 358                                           '$n must be a valid date - day out of range');
 359           last RULE;
 360         }
 361         if ($month < 1 || $month > 12) {
 362           $errors->{$field} = _make_error($field, $info, $rule,
 363                                           '$n must be a valid date - month out of range');
 364           last RULE;
 365         }
 366         require DevHelp::Date;
 367         my $msg;
 368         unless (($year, $month, $day) = DevHelp::Date::dh_parse_date($data, \$msg)) {
 369           $errors->{$field} = $msg;
 370           last RULE;
 371         }
 372         if ($rule->{mindate} || $rule->{maxdate}) {
 373           my $workdate = sprintf("%04d-%02d-%02d", $year, $month, $day);
 374           if ($rule->{mindate}) {
 375             my $mindate = DevHelp::Date::dh_parse_date_sql($rule->{mindate});
 376             if ($workdate le $mindate) {
 377               $errors->{$field} =
 378                 _make_error($field, $info, $rule,
 379                             $info->{mindatemsg} || $rule->{mindatemsg} || '$n is too early');
 380             }
 381           }
 382           if (!$errors->{$field} && $rule->{maxdate}) {
 383             my $maxdate = DevHelp::Date::dh_parse_date_sql($rule->{maxdate});
 384             if ($workdate ge $maxdate) {
 385               $errors->{$field} =
 386                 _make_error($field, $info, $rule,
 387                             $info->{mindatemsg} || $rule->{maxdatemsg} || '$n is too late');
 388             }
 389           }
 390         }
 391       }
 392       if ($rule->{confirm}) {
 393         my $other = $self->param($rule->{confirm});
 394         unless ($other eq $data) {
 395           $errors->{$field} = _make_error($field, $info, $rule,
 396                                           q!$n doesn't match the password!);
 397           last RULE;
 398         }
 399       }
 400       if ($rule->{ccexpiry}) {
 401         (my $year_field = $field) =~ s/month/year/;
 402
 403         unless ($data =~ /^\s*\d+\s*$/) {
 404           $errors->{$field} = _make_error($field, $info, $rule,
 405                                           q!$n month isn't a number!);
 406           last RULE;
 407         }
 408         my $year = $self->param($year_field);
 409         unless (defined $year && $year =~ /\s*\d+\s*$/) {
 410           $errors->{$field} = _make_error($field, $info, $rule,
 411                                           q!$n year isn't a number!);
 412           last RULE;
 413         }
 414         my ($now_year, $now_month) = (localtime)[5, 4];
 415         $now_year += 1900;
 416         ++$now_month;
 417         if ($year < $now_year || $year == $now_year && $data < $now_month) {
 418           $errors->{$field} = _make_error($field, $info, $rule,
 419                                           q!$n is in the past, your card has expired!);
 420           last RULE;
 421         }
 422       }
 423       if ($rule->{ccexpirysingle}) {
 424         unless ($data =~ m!^\s*(\d+)\s*/\s*(\d+)+\s*$!) {
 425           $errors->{$field} = _make_error($field, $info, $rule,
 426                                           q!$n must be in MM/YY format!);
 427           last RULE;
 428         }
 429         my ($month, $year) = ($1, $2);
 430         $year += 2000;
 431         if ($month < 1 || $month > 12) {
 432           $errors->{$field} = _make_error($field, $info, $rule,
 433                                           q!$n month must be between 1 and 12!);
 434           last RULE;
 435         }
 436         my ($now_year, $now_month) = (localtime)[5, 4];
 437         $now_year += 1900;
 438         ++$now_month;
 439         if ($year < $now_year || $year == $now_year && $month < $now_month) {
 440           $errors->{$field} = _make_error($field, $info, $rule,
 441                                           q!$n is in the past, your card has expired!);
 442           last RULE;
 443         }
 444       }
 445     }
 446   }
 447 }
 448
 449 sub _make_error {
 450   my ($field, $info, $rule, $message) = @_;
 451
 452   $message ||= $rule->{error} || 'Validation error on field $n';
 453
 454   my $name = $info->{description} || $field;
 455   $message =~ s/\$n/$name/g;
 456
 457   return $message;
 458 }
 459
 460 sub _get_cfg_fields {
 461   my ($rules, $cfg, $section, $field_hash) = @_;
 462
 463   $rules->{rules} = {};
 464   $rules->{fields} = {};
 465
 466   my $cfg_fields = $rules->{fields};
 467
 468   my $fields = $cfg->entry($section, 'fields', '');
 469   my @names = ( split(/,/, $fields), keys %$field_hash );
 470
 471   for my $field (@names) {
 472     for my $cfg_name (qw(required rules description required_error range_error mindatemsg maxdatemsg)) {
 473       my $value = $cfg->entry($section, "${field}_$cfg_name");
 474       if (defined $value) {
 475         $cfg_fields->{$field}{$cfg_name} = $value;
 476       }
 477     }
 478
 479     my $values = $cfg->entry($section, "${field}_values");
 480     if (defined $values) {
 481       my @values;
 482       if ($values =~ /;/) {
 483         for my $entry (split /;/, $values) {
 484           if ($entry =~ /^([^=]*)=(.*)$/) {
 485             push @values, [ $1, $2 ];
 486           }
 487           else {
 488             push @values, [ $entry, $entry ];
 489           }
 490         }
 491       }
 492       else {
 493         my $strip;
 494         if ($values =~ s/:([^:]*)$//) {
 495           $strip = $1;
 496         }
 497         my %entries = $cfg->entriesCS($values);
 498         my @order = $cfg->orderCS($values);
 499
 500         my %seen;
 501         # we only want the last value in the order
 502         @order = reverse grep !$seen{$_}++, reverse @order;
 503         @values = map [ $_, $entries{$_} ], @order;
 504         if ($strip) {
 505           $_->[0] =~ s/^\Q$strip// for @values;
 506         }
 507       }
 508       $cfg_fields->{$field}{values} = \@values;
 509     }
 510   }
 511 }
 512
 513 sub dh_configure_fields {
 514   my ($fields, $cfg, $section) = @_;
 515
 516   my %cfg_rules;
 517   _get_cfg_fields(\%cfg_rules, $cfg, $section, $fields);
 518
 519   # **FIXME** duplicated code
 520   my $cfg_fields = $cfg_rules{fields};
 521   for my $field ( keys %$fields ) {
 522     my $src = $fields->{$field};
 523
 524     my $dest = $cfg_fields->{$field} || {};
 525
 526     # the config overrides the software supplied fields
 527     for my $override (qw(description required required_error range_error mindatemsg maxdatemsg htmltype type width height size maxlength)) {
 528       if (defined $src->{$override} && !defined $dest->{$override}) {
 529         $dest->{$override} = $src->{$override};
 530       }
 531     }
 532
 533     # but we add rules
 534     if ($dest->{rules}) {
 535       my $rules = $src->{rules} || '';
 536
 537       # make a copy of the rules array if it's supplied that way so
 538       # we don't modify someone else's data
 539       $rules = ref $rules ? [ @$rules ] : [ split /;/, $rules ];
 540
 541       push @$rules, split /;/, $dest->{rules};
 542     }
 543     elsif ($src->{rules}) {
 544       $dest->{rules} = $src->{rules};
 545     }
 546
 547     $cfg_fields->{$field} = $dest if keys %$dest;
 548   }
 549
 550   return $cfg_fields;
 551 }
 552
 553 sub _get_cfg_rule {
 554   my ($self, $rulename) = @_;
 555
 556   my %rule = $self->{cfg}->entries("Validation Rule $rulename");
 557
 558   keys %rule or return;
 559
 560   \%rule;
 561 }
 562
 563 sub dh_fieldnames {
 564   my ($cfg, $section, $fields) = @_;
 565
 566   # this needs to be obsoleted now that dh_validate() checks the config
 567
 568   for my $field (keys %$fields) {
 569     my $desc = $cfg->entry($section, $field);
 570     defined $desc and $fields->{$field}{description} = $desc;
 571   }
 572 }
 573
 574 package DevHelp::Validate::CGI;
 575 use vars qw(@ISA);
 576 @ISA = qw(DevHelp::Validate);
 577
 578 sub param {
 579   my ($self, $field) = @_;
 580
 581   $self->{cgi}->param($field);
 582 }
 583
 584 sub validate {
 585   my ($self, $cgi, $errors) = @_;
 586
 587   $self->{cgi} = $cgi;
 588
 589   return $self->_validate($errors);
 590 }
 591
 592 package DevHelp::Validate::Hash;
 593 use vars qw(@ISA);
 594 @ISA = qw(DevHelp::Validate);
 595
 596 sub param {
 597   my ($self, $field) = @_;
 598
 599   my $value = $self->{hash}{$field};
 600
 601   defined $value or return;
 602
 603   if (ref $value eq 'ARRAY') {
 604     return @$value;
 605   }
 606
 607   return $value;
 608 }
 609
 610 sub validate {
 611   my ($self, $hash, $errors) = @_;
 612
 613   $self->{hash} = $hash;
 614
 615   return $self->_validate($errors);
 616 }
 617
 618 1;
 619
 620 __END__
 621
 622 =head1 NAME
 623
 624 DevHelp::Validate - handy configurable validation, I hope
 625
 626 =head1 SYNOPSIS
 627
 628   use DevHelp::Validate qw(dh_validate);
 629
 630   dh_validate($cgi, \%errors, \%rules, $cfg)
 631     or display_errors(..., \%errors);
 632
 633 =head1 DESCRIPTION
 634
 635 =head1 RULES PARAMETER
 636
 637 The rules parameter is a hash with 2 keys:
 638
 639 =over
 640
 641 =item fields
 642
 643 A hash of field names, for each of which the value is a hash.
 644
 645 Each hash can have the following keys:
 646
 647 =over
 648
 649 =item rules
 650
 651 A simple rule name, a ';' separated list of rule names or an array
 652 ref.
 653
 654 =item description
 655
 656 A short description of the field, for use in error messages.
 657
 658 =back
 659
 660 =item rules
 661
 662 A hash of rules.  See the rules description under L<CONFIGURED
 663 VALIDATON>.
 664
 665 =back
 666
 667 =head1 CONFIGURED VALIDATION
 668
 669 Rules can be configured in the database.
 670
 671 For the specified section name, each key is a CGI field name.
 672
 673 The values of those keys gives the name of a validation rule, a string
 674 id for internationlization of the field description and a default
 675 field description, separated by commas.
 676
 677 Each validation rule name has a corresponding section, [Validate Rule
 678 I<rule-name>], which describes the rule.  Rule names can also refer to
 679 built-in rules,
 680
 681 Values in the validation rule section are:
 682
 683 =over
 684
 685 =item required
 686
 687 If this is non-zero the field is required.
 688
 689 =item match
 690
 691 If present, this is used as a regular expression the field must match.
 692
 693 =item nomatch
 694
 695 If present, this is used as a regular expression the field must not
 696 match.
 697
 698 =item error
 699
 700 Message returned as the error if the field fails validation.
 701
 702 =item integer
 703
 704 If set to 1, simply ensures the value is an integer.
 705
 706 If set to a range I<integer>-I<integer> then ensures the value is an
 707 integer in that range.
 708
 709 =item date
 710
 711 If set to 1, simply validates the value as a date.
 712
 713 =back
 714
 715 =head1 BUILT-IN RULES
 716
 717 =over
 718
 719 =item email
 720
 721 =item phone
 722
 723 =item postcode
 724
 725 =item url
 726
 727 Matches any valid url, including mailto:, ftp:, etc.  No checking of
 728 the scheme is done.
 729
 730 =item weburl
 731
 732 Matches any valid http or https url.
 733
 734 =item newbieweburl
 735
 736 Matches web URLs with or without "http://" or "https://".
 737
 738 =item confirm
 739
 740 Treats the given field as a confirmation field for a password field
 741 "password".
 742
 743 =item newconfirm
 744
 745 Treats the given field as a confirmation field for an optional
 746 password field "password".
 747
 748 =item required
 749
 750 The field is required.  This should be used where the logic of the
 751 code requires a field, since it cannot be overridden by the config
 752 file.
 753
 754 =item abn
 755
 756 Valid Australian Business Number
 757
 758 =item creditcardnumber
 759
 760 Valid credit card number (no checksum checks are performed).
 761
 762 =item creditcardexpiry
 763
 764 Treats the field as the month part of a credit card expiry date, with
 765 the year field being the field with the same name, but "month"
 766 replaced with "year".  The date of expiry is required to be in the
 767 future.
 768
 769 =item miaa
 770
 771 Valid MIAA membership number.
 772
 773 =item decimal
 774
 775 Valid simple decimal number
 776
 777 =item money
 778
 779 Valid decimal number with 0 or 2 digits after the decimal point.
 780
 781 =item date
 782
 783 A valid date.  Currently dates are limited to Australian format
 784 dd/mm/yy or dd/mm/yyyy format dates.
 785
 786 =item birthdate
 787
 788 A valid date in the past.
 789
 790 =item adultbirthdate
 791
 792 A valid date at least 10 years in the past, at most 100 years in the
 793 past.
 794
 795 =item futuredate
 796
 797 A valid date in the future.
 798
 799 =item natural
 800
 801 An integer greater or equal to zero.
 802
 803 =item positiveint
 804
 805 A positive integer.
 806
 807 =item dh_one_line
 808
 809 The field may not contain line breaks
 810
 811 =back
 812
 813 =head1 AUTHOR
 814
 815 Tony Cook <tony@develop-help.com>
 816
 817 =cut