Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Validate.pm

   1 package CGI::Ex::Validate;
   2
   3 =head1 NAME
   4
   5 CGI::Ex::Validate - The "Just Right" form validator with javascript in parallel
   6
   7 =cut
   8
   9 ###----------------------------------------------------------------###
  10 #  Copyright 2007 - Paul Seamons                                     #
  11 #  Distributed under the Perl Artistic License without warranty      #
  12 ###----------------------------------------------------------------###
  13
  14 use strict;
  15 use vars qw($VERSION
  16             $DEFAULT_EXT
  17             %DEFAULT_OPTIONS
  18             $JS_URI_PATH
  19             $JS_URI_PATH_YAML
  20             $JS_URI_PATH_VALIDATE
  21             $QR_EXTRA
  22             @UNSUPPORTED_BROWSERS
  23             );
  24
  25 $VERSION = '2.23';
  26
  27 $DEFAULT_EXT   = 'val';
  28 $QR_EXTRA      = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/;
  29 @UNSUPPORTED_BROWSERS = (qr/MSIE\s+5.0\d/i);
  30
  31 ###----------------------------------------------------------------###
  32
  33 sub new {
  34   my $class = shift;
  35   my $self  = ref($_[0]) ? shift : {@_};
  36
  37   $self = {%DEFAULT_OPTIONS, %$self} if scalar keys %DEFAULT_OPTIONS;
  38
  39   return bless $self, $class;
  40 }
  41
  42 ###----------------------------------------------------------------###
  43
  44 sub cgix {
  45     my $self = shift;
  46     return $self->{'cgix'} ||= do {
  47         require CGI::Ex;
  48         CGI::Ex->new;
  49     };
  50 }
  51
  52 ### the main validation routine
  53 sub validate {
  54     my $self = (! ref($_[0])) ? shift->new                    # $class->validate
  55                 : UNIVERSAL::isa($_[0], __PACKAGE__) ? shift  # $self->validate
  56                 : __PACKAGE__->new;                           # &validate
  57     my $form     = shift || die "Missing form hash";
  58     my $val_hash = shift || die "Missing validation hash";
  59     my $what_was_validated = shift; # allow for extra arrayref that stores what was validated
  60
  61     ### turn the form into a form hash if doesn't look like one already
  62     die "Invalid form hash or cgi object" if ! ref $form;
  63     if (ref $form ne 'HASH') {
  64         local $self->{cgi_object} = $form;
  65         $form = $self->cgix->get_form($form);
  66     }
  67
  68     ### make sure the validation is a hashref
  69     ### get_validation handle odd types
  70     if (ref $val_hash ne 'HASH') {
  71         $val_hash = $self->get_validation($val_hash) if ref $val_hash ne 'SCALAR' || ! ref $val_hash;
  72         die "Validation groups must be a hashref"    if ref $val_hash ne 'HASH';
  73     }
  74
  75     ### parse keys that are group arguments - and those that are keys to validate
  76     my %ARGS;
  77     my @field_keys = grep { /^(?:group|general)\s+(\w+)/
  78                               ? do {$ARGS{$1} = $val_hash->{$_} ; 0}
  79                               : 1 }
  80                      sort keys %$val_hash;
  81
  82     ### only validate this group if it is supposed to be checked
  83     return if $ARGS{'validate_if'} && ! $self->check_conditional($form, $ARGS{'validate_if'});
  84
  85     ### Look first for items in 'group fields' or 'group order'
  86     my $fields;
  87     if ($fields = $ARGS{'fields'} || $ARGS{'order'}) {
  88         my $type = $ARGS{'fields'} ? 'group fields' : 'group order';
  89         die "Validation '$type' must be an arrayref when passed"
  90             if ! UNIVERSAL::isa($fields, 'ARRAY');
  91         my @temp;
  92         foreach my $field (@$fields) {
  93             die "Non-defined value in '$type'" if ! defined $field;
  94             if (ref $field) {
  95                 die "Found nonhashref value in '$type'" if ref($field) ne 'HASH';
  96                 die "Element missing \"field\" key/value in '$type'" if ! defined $field->{'field'};
  97                 push @temp, $field;
  98             } elsif ($field eq 'OR') {
  99                 push @temp, 'OR';
 100             } else {
 101                 die "No element found in '$type' for $field" if ! exists $val_hash->{$field};
 102                 die "Found nonhashref value in '$type'" if ref($val_hash->{$field}) ne 'HASH';
 103                 push @temp, { %{ $val_hash->{$field} }, field => $field }; # copy the values to add the key
 104             }
 105         }
 106         $fields = \@temp;
 107
 108         ### limit the keys that need to be searched to those not in fields or order
 109         my %found = map { $_->{'field'} => 1 } @temp;
 110         @field_keys = grep { ! $found{$_} } @field_keys;
 111     }
 112
 113     ### add any remaining field_vals from our original hash
 114     ### this is necessary for items that weren't in group fields or group order
 115     foreach my $field (@field_keys) {
 116         die "Found nonhashref value for field $field" if ref($val_hash->{$field}) ne 'HASH';
 117         if (defined $val_hash->{$field}->{'field'}) {
 118             push @$fields, $val_hash->{$field};
 119         } else {
 120             push @$fields, { %{$val_hash->{$field}}, field => $field };
 121         }
 122     }
 123     return if ! $fields;
 124
 125     ### Finally we have our arrayref of hashrefs that each have their 'field' key
 126     ### now lets do the validation
 127     $self->{'was_checked'} = {};
 128     $self->{'was_valid'} = {};
 129     $self->{'had_error'} = {};
 130     my $found  = 1;
 131     my @errors;
 132     my $hold_error; # hold the error for a moment - to allow for an "OR" operation
 133     my %checked;
 134     foreach (my $i = 0; $i < @$fields; $i++) {
 135         my $ref = $fields->[$i];
 136         if (! ref($ref) && $ref eq 'OR') {
 137             $i++ if $found; # if found skip the OR altogether
 138             $found = 1; # reset
 139             next;
 140         }
 141         $found = 1;
 142         my $field = $ref->{'field'} || die "Missing field key during normal validation";
 143         if (! $checked{$field}++) {
 144             $self->{'was_checked'}->{$field} = 1;
 145             $self->{'was_valid'}->{$field} = 1;
 146             $self->{'had_error'}->{$field} = 0;
 147         }
 148         local $ref->{'was_validated'} = 1;
 149         my $err = $self->validate_buddy($form, $field, $ref);
 150         if ($ref->{'was_validated'} && $what_was_validated) {
 151             push @$what_was_validated, $ref;
 152         } else {
 153             $self->{'was_valid'}->{$field} = 0;
 154         }
 155
 156         ### test the error - if errors occur allow for OR - if OR fails use errors from first fail
 157         if ($err) {
 158             $self->{'was_valid'}->{$field} = 0;
 159             $self->{'had_error'}->{$field} = 0;
 160             if ($i < $#$fields && ! ref($fields->[$i + 1]) && $fields->[$i + 1] eq 'OR') {
 161                 $hold_error = $err;
 162             } else {
 163                 push @errors, $hold_error ? @$hold_error : @$err;
 164                 $hold_error = undef;
 165             }
 166         } else {
 167             $hold_error = undef;
 168         }
 169     }
 170     push(@errors, @$hold_error) if $hold_error; # allow for final OR to work
 171
 172
 173     ### optionally check for unused keys in the form
 174     if ($ARGS{no_extra_fields} || $self->{no_extra_fields}) {
 175         my %keys = map { ($_->{'field'} => 1) } @$fields; # %{ $self->get_validation_keys($val_hash) };
 176         foreach my $key (sort keys %$form) {
 177             next if $keys{$key};
 178             push @errors, [$key, 'no_extra_fields', {}, undef];
 179         }
 180     }
 181
 182     ### return what they want
 183     if (@errors) {
 184         my @copy = grep {/$QR_EXTRA/o} keys %$self;
 185         @ARGS{@copy} = @{ $self }{@copy};
 186         unshift @errors, $ARGS{'title'} if $ARGS{'title'};
 187         my $err_obj = $self->new_error(\@errors, \%ARGS);
 188         die    $err_obj if $ARGS{'raise_error'};
 189         return $err_obj;
 190     } else {
 191         return;
 192     }
 193 }
 194
 195 sub new_error {
 196     my $self = shift;
 197     return CGI::Ex::Validate::Error->new(@_);
 198 }
 199
 200 ### allow for optional validation on groups and on individual items
 201 sub check_conditional {
 202   my ($self, $form, $ifs, $ifs_match) = @_;
 203
 204   ### can pass a single hash - or an array ref of hashes
 205   if (! $ifs) {
 206     die "Need reference passed to check_conditional";
 207   } elsif (! ref($ifs)) {
 208     $ifs = [$ifs];
 209   } elsif (UNIVERSAL::isa($ifs,'HASH')) {
 210     $ifs = [$ifs];
 211   }
 212
 213   local $self->{'_check_conditional'} = 1;
 214
 215   ### run the if options here
 216   ### multiple items can be passed - all are required unless OR is used to separate
 217   my $found = 1;
 218   foreach (my $i = 0; $i <= $#$ifs; $i ++) {
 219     my $ref = $ifs->[$i];
 220     if (! ref $ref) {
 221       if ($ref eq 'OR') {
 222         $i ++ if $found; # if found skip the OR altogether
 223         $found = 1; # reset
 224         next;
 225       } else {
 226         if ($ref =~ /^function\s*\(/) {
 227           next;
 228         } elsif ($ref =~ /^(.*?)\s+(was_valid|had_error|was_checked)$/) {
 229           $ref = {field => $1, $2 => 1};
 230         } elsif ($ref =~ s/^\s*!\s*//) {
 231           $ref = {field => $ref, max_in_set => "0 of $ref"};
 232         } else {
 233           $ref = {field => $ref, required => 1};
 234         }
 235       }
 236     }
 237     last if ! $found;
 238
 239     ### get the field - allow for custom variables based upon a match
 240     my $field = $ref->{'field'} || die "Missing field key during validate_if (possibly used a reference to a main hash *foo -> &foo)";
 241     $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
 242
 243     my $errs = $self->validate_buddy($form, $field, $ref);
 244     $found = 0 if $errs;
 245   }
 246   return $found;
 247 }
 248
 249
 250 ### this is where the main checking goes on
 251 sub validate_buddy {
 252   my $self = shift;
 253   my ($form, $field, $field_val, $ifs_match) = @_;
 254
 255   local $self->{'_recurse'} = ($self->{'_recurse'} || 0) + 1;
 256   die "Max dependency level reached 10" if $self->{'_recurse'} > 10;
 257
 258   my @errors = ();
 259   my $types  = [sort keys %$field_val];
 260
 261   ### allow for not running some tests in the cgi
 262   if ($field_val->{'exclude_cgi'}) {
 263     delete $field_val->{'was_validated'};
 264     return 0;
 265   }
 266
 267   ### allow for field names that contain regular expressions
 268   if ($field =~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) {
 269     my ($not,$pat,$opt) = ($1,$3,$4);
 270     $opt =~ tr/g//d;
 271     die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/;
 272     foreach my $_field (sort keys %$form) {
 273       next if ($not && $_field =~ m/(?$opt:$pat)/) || (! $not && $_field !~ m/(?$opt:$pat)/);
 274       my @match = (undef, $1, $2, $3, $4, $5); # limit to the matches
 275       my $errs = $self->validate_buddy($form, $_field, $field_val, \@match);
 276       push @errors, @$errs if $errs;
 277     }
 278     return @errors ? \@errors : 0;
 279   }
 280
 281   if ($field_val->{was_valid}   && ! $self->{'_was_valid'}->{$field})   { return [[$field, 'was_valid',   $field_val, $ifs_match]]; }
 282   if ($field_val->{had_error}   && ! $self->{'_had_error'}->{$field})   { return [[$field, 'had_error',   $field_val, $ifs_match]]; }
 283   if ($field_val->{was_checked} && ! $self->{'_was_checked'}->{$field}) { return [[$field, 'was_checked', $field_val, $ifs_match]]; }
 284
 285   my $values   = UNIVERSAL::isa($form->{$field},'ARRAY') ? $form->{$field} : [$form->{$field}];
 286   my $n_values = $#$values + 1;
 287
 288   ### allow for default value
 289   if (exists $field_val->{'default'}) {
 290     if ($n_values == 0 || ($n_values == 1 && (! defined($values->[0]) || ! length($values->[0])))) {
 291       $form->{$field} = $values->[0] = $field_val->{'default'};
 292     }
 293   }
 294
 295   ### allow for a few form modifiers
 296   my $modified = 0;
 297   foreach my $value (@$values) {
 298     next if ! defined $value;
 299     if (! $field_val->{'do_not_trim'}) { # whitespace
 300       $value =~ s/^\s+//;
 301       $value =~ s/\s+$//;
 302       $modified = 1;
 303     }
 304     if ($field_val->{'trim_control_chars'}) {
 305       $value =~ y/\t/ /;
 306       $value =~ y/\x00-\x1F//d;
 307       $modified = 1;
 308     }
 309     if ($field_val->{'to_upper_case'}) { # uppercase
 310       $value = uc($value);
 311       $modified = 1;
 312     } elsif ($field_val->{'to_lower_case'}) { # lowercase
 313       $value = lc($value);
 314       $modified = 1;
 315     }
 316   }
 317   # allow for inline specified modifications (ie s/foo/bar/)
 318   foreach my $type (grep {/^replace_?\d*$/} @$types) {
 319     my $ref = UNIVERSAL::isa($field_val->{$type},'ARRAY') ? $field_val->{$type}
 320       : [split(/\s*\|\|\s*/,$field_val->{$type})];
 321     foreach my $rx (@$ref) {
 322       if ($rx !~ m/^\s*s([^\s\w])(.+)\1(.*)\1([eigsmx]*)$/s) {
 323         die "Not sure how to parse that replace ($rx)";
 324       }
 325       my ($pat, $swap, $opt) = ($2, $3, $4);
 326       die "The e option cannot be used in swap on field $field" if $opt =~ /e/;
 327       my $global = $opt =~ s/g//g;
 328       $swap =~ s/\\n/\n/g;
 329       if ($global) {
 330         foreach my $value (@$values) {
 331           $value =~ s{(?$opt:$pat)}{
 332             my @match = (undef, $1, $2, $3, $4, $5, $6); # limit on the number of matches
 333             my $copy = $swap;
 334             $copy =~ s/\$(\d+)/defined($match[$1]) ? $match[$1] : ""/ge;
 335             $modified = 1;
 336             $copy; # return of the swap
 337           }eg;
 338         }
 339       }else{
 340         foreach my $value (@$values) {
 341           next if ! defined $value;
 342           $value =~ s{(?$opt:$pat)}{
 343             my @match = (undef, $1, $2, $3, $4, $5, $6); # limit on the number of matches
 344             my $copy = $swap;
 345             $copy =~ s/\$(\d+)/defined($match[$1]) ? $match[$1] : ""/ge;
 346             $modified = 1;
 347             $copy; # return of the swap
 348           }e;
 349         }
 350       }
 351     }
 352   }
 353   ### put them back into the form if we have modified it
 354   if ($modified) {
 355     if ($n_values == 1) {
 356       $form->{$field} = $values->[0];
 357       $self->{cgi_object}->param(-name => $field, -value => $values->[0])
 358         if $self->{cgi_object};
 359     } else {
 360       ### values in @{ $form->{$field} } were modified directly
 361       $self->{cgi_object}->param(-name => $field, -value => $values)
 362         if $self->{cgi_object};
 363     }
 364   }
 365
 366   ### only continue if a validate_if is not present or passes test
 367   my $needs_val = 0;
 368   my $n_vif = 0;
 369   foreach my $type (grep {/^validate_if_?\d*$/} @$types) {
 370     $n_vif ++;
 371     my $ifs = $field_val->{$type};
 372     my $ret = $self->check_conditional($form, $ifs, $ifs_match);
 373     $needs_val ++ if $ret;
 374   }
 375   if (! $needs_val && $n_vif) {
 376     delete $field_val->{'was_validated'};
 377     return 0;
 378   }
 379
 380   ### check for simple existence
 381   ### optionally check only if another condition is met
 382   my $is_required = $field_val->{'required'} ? 'required' : '';
 383   if (! $is_required) {
 384     foreach my $type (grep {/^required_if_?\d*$/} @$types) {
 385       my $ifs = $field_val->{$type};
 386       next if ! $self->check_conditional($form, $ifs, $ifs_match);
 387       $is_required = $type;
 388       last;
 389     }
 390   }
 391   if ($is_required
 392       && ($n_values == 0 || ($n_values == 1 && (! defined($values->[0]) || ! length $values->[0])))) {
 393     return [] if $self->{'_check_conditional'};
 394     return [[$field, $is_required, $field_val, $ifs_match]];
 395   }
 396
 397   ### min values check
 398   my $n = exists($field_val->{'min_values'}) ? $field_val->{'min_values'} || 0 : 0;
 399   if ($n_values < $n) {
 400     return [] if $self->{'_check_conditional'};
 401     return [[$field, 'min_values', $field_val, $ifs_match]];
 402   }
 403
 404   ### max values check
 405   $field_val->{'max_values'} = 1 if ! exists $field_val->{'max_values'};
 406   $n = $field_val->{'max_values'} || 0;
 407   if ($n_values > $n) {
 408     return [] if $self->{'_check_conditional'};
 409     return [[$field, 'max_values', $field_val, $ifs_match]];
 410   }
 411
 412   ### max_in_set and min_in_set checks
 413   my @min = grep {/^min_in_set_?\d*$/} @$types;
 414   my @max = grep {/^max_in_set_?\d*$/} @$types;
 415   foreach ([min => \@min],
 416            [max => \@max]) {
 417     my ($minmax, $keys) = @$_;
 418     foreach my $type (@$keys) {
 419       $field_val->{$type} =~ m/^\s*(\d+)(?i:\s*of)?\s+(.+)\s*$/
 420         || die "Invalid in_set check $field_val->{$type}";
 421       my $n = $1;
 422       foreach my $_field (split /[\s,]+/, $2) {
 423         my $ref = UNIVERSAL::isa($form->{$_field},'ARRAY') ? $form->{$_field} : [$form->{$_field}];
 424         foreach my $_value (@$ref) {
 425           $n -- if defined($_value) && length($_value);
 426         }
 427       }
 428       if (   ($minmax eq 'min' && $n > 0)
 429           || ($minmax eq 'max' && $n < 0)) {
 430         return [] if $self->{'_check_conditional'};
 431         return [[$field, $type, $field_val, $ifs_match]];
 432       }
 433     }
 434   }
 435
 436   ### at this point @errors should still be empty
 437   my $content_checked; # allow later for possible untainting (only happens if content was checked)
 438
 439   ### loop on values of field
 440   foreach my $value (@$values) {
 441
 442     ### allow for enum types
 443     if (exists $field_val->{'enum'}) {
 444       my $ref = ref($field_val->{'enum'}) ? $field_val->{'enum'} : [split(/\s*\|\|\s*/,$field_val->{'enum'})];
 445       my $found = 0;
 446       foreach (@$ref) {
 447         $found = 1 if defined($value) && $_ eq $value;
 448       }
 449       if (! $found) {
 450         return [] if $self->{'_check_conditional'};
 451         push @errors, [$field, 'enum', $field_val, $ifs_match];
 452       }
 453       $content_checked = 1;
 454     }
 455
 456     ### field equality test
 457     foreach my $type (grep {/^equals_?\d*$/} @$types) {
 458       my $field2  = $field_val->{$type};
 459       my $not     = ($field2 =~ s/^!\s*//) ? 1 : 0;
 460       my $success = 0;
 461       if ($field2 =~ m/^([\"\'])(.*)\1$/) {
 462         my $test = $2;
 463         $success = (defined($value) && $value eq $test);
 464       } elsif (exists($form->{$field2}) && defined($form->{$field2})) {
 465         $success = (defined($value) && $value eq $form->{$field2});
 466       } elsif (! defined($value)) {
 467         $success = 1; # occurs if they are both undefined
 468       }
 469       if ($not ? $success : ! $success) {
 470         return [] if $self->{'_check_conditional'};
 471         push @errors, [$field, $type, $field_val, $ifs_match];
 472       }
 473       $content_checked = 1;
 474     }
 475
 476     ### length min check
 477     if (exists $field_val->{'min_len'}) {
 478       my $n = $field_val->{'min_len'};
 479       if (! defined($value) || length($value) < $n) {
 480         return [] if $self->{'_check_conditional'};
 481         push @errors, [$field, 'min_len', $field_val, $ifs_match];
 482       }
 483     }
 484
 485     ### length max check
 486     if (exists $field_val->{'max_len'}) {
 487       my $n = $field_val->{'max_len'};
 488       if (defined($value) && length($value) > $n) {
 489         return [] if $self->{'_check_conditional'};
 490         push @errors, [$field, 'max_len', $field_val, $ifs_match];
 491       }
 492     }
 493
 494     ### now do match types
 495     foreach my $type (grep {/^match_?\d*$/} @$types) {
 496       my $ref = UNIVERSAL::isa($field_val->{$type},'ARRAY') ? $field_val->{$type}
 497          : UNIVERSAL::isa($field_val->{$type}, 'Regexp') ? [$field_val->{$type}]
 498          : [split(/\s*\|\|\s*/,$field_val->{$type})];
 499       foreach my $rx (@$ref) {
 500         if (UNIVERSAL::isa($rx,'Regexp')) {
 501           if (! defined($value) || $value !~ $rx) {
 502               push @errors, [$field, $type, $field_val, $ifs_match];
 503           }
 504         } else {
 505           if ($rx !~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) {
 506             die "Not sure how to parse that match ($rx)";
 507           }
 508           my ($not,$pat,$opt) = ($1,$3,$4);
 509           $opt =~ tr/g//d;
 510           die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/;
 511           if ( (     $not && (  defined($value) && $value =~ m/(?$opt:$pat)/))
 512                || (! $not && (! defined($value) || $value !~ m/(?$opt:$pat)/))
 513                ) {
 514             return [] if $self->{'_check_conditional'};
 515             push @errors, [$field, $type, $field_val, $ifs_match];
 516           }
 517         }
 518       }
 519       $content_checked = 1;
 520     }
 521
 522     ### allow for comparison checks
 523     foreach my $type (grep {/^compare_?\d*$/} @$types) {
 524       my $ref = UNIVERSAL::isa($field_val->{$type},'ARRAY') ? $field_val->{$type}
 525         : [split(/\s*\|\|\s*/,$field_val->{$type})];
 526       foreach my $comp (@$ref) {
 527         next if ! $comp;
 528         my $test  = 0;
 529         if ($comp =~ /^\s*(>|<|[><!=]=)\s*([\d\.\-]+)\s*$/) {
 530           my $val = $value || 0;
 531           $val *= 1;
 532           if    ($1 eq '>' ) { $test = ($val >  $2) }
 533           elsif ($1 eq '<' ) { $test = ($val <  $2) }
 534           elsif ($1 eq '>=') { $test = ($val >= $2) }
 535           elsif ($1 eq '<=') { $test = ($val <= $2) }
 536           elsif ($1 eq '!=') { $test = ($val != $2) }
 537           elsif ($1 eq '==') { $test = ($val == $2) }
 538
 539         } elsif ($comp =~ /^\s*(eq|ne|gt|ge|lt|le)\s+(.+?)\s*$/) {
 540           my $val = defined($value) ? $value : '';
 541           my ($op, $value2) = ($1, $2);
 542           $value2 =~ s/^([\"\'])(.*)\1$/$2/;
 543           if    ($op eq 'gt') { $test = ($val gt $value2) }
 544           elsif ($op eq 'lt') { $test = ($val lt $value2) }
 545           elsif ($op eq 'ge') { $test = ($val ge $value2) }
 546           elsif ($op eq 'le') { $test = ($val le $value2) }
 547           elsif ($op eq 'ne') { $test = ($val ne $value2) }
 548           elsif ($op eq 'eq') { $test = ($val eq $value2) }
 549
 550         } else {
 551           die "Not sure how to compare \"$comp\"";
 552         }
 553         if (! $test) {
 554           return [] if $self->{'_check_conditional'};
 555           push @errors, [$field, $type, $field_val, $ifs_match];
 556         }
 557       }
 558       $content_checked = 1;
 559     }
 560
 561     ### server side sql type
 562     foreach my $type (grep {/^sql_?\d*$/} @$types) {
 563       my $db_type = $field_val->{"${type}_db_type"};
 564       my $dbh = ($db_type) ? $self->{dbhs}->{$db_type} : $self->{dbh};
 565       if (! $dbh) {
 566         die "Missing dbh for $type type on field $field" . ($db_type ? " and db_type $db_type" : "");
 567       } elsif (UNIVERSAL::isa($dbh,'CODE')) {
 568         $dbh = &$dbh($field, $self) || die "SQL Coderef did not return a dbh";
 569       }
 570       my $sql  = $field_val->{$type};
 571       my @args = ($value) x $sql =~ tr/?//;
 572       my $return = $dbh->selectrow_array($sql, {}, @args); # is this right - copied from O::FORMS
 573       $field_val->{"${type}_error_if"} = 1 if ! defined $field_val->{"${type}_error_if"};
 574       if ( (! $return && $field_val->{"${type}_error_if"})
 575            || ($return && ! $field_val->{"${type}_error_if"}) ) {
 576         return [] if $self->{'_check_conditional'};
 577         push @errors, [$field, $type, $field_val, $ifs_match];
 578       }
 579       $content_checked = 1;
 580     }
 581
 582     ### server side custom type
 583     foreach my $type (grep {/^custom_?\d*$/} @$types) {
 584       my $check = $field_val->{$type};
 585       next if UNIVERSAL::isa($check, 'CODE') ? &$check($field, $value, $field_val, $type) : $check;
 586       return [] if $self->{'_check_conditional'};
 587       push @errors, [$field, $type, $field_val, $ifs_match];
 588       $content_checked = 1;
 589     }
 590
 591     ### do specific type checks
 592     foreach my $type (grep {/^type_?\d*$/} @$types) {
 593       if (! $self->check_type($value,$field_val->{'type'},$field,$form)){
 594         return [] if $self->{'_check_conditional'};
 595         push @errors, [$field, $type, $field_val, $ifs_match];
 596       }
 597       $content_checked = 1;
 598     }
 599   }
 600
 601   ### allow for the data to be "untainted"
 602   ### this is only allowable if the user ran some other check for the datatype
 603   if ($field_val->{'untaint'} && $#errors == -1) {
 604     if (! $content_checked) {
 605         push @errors, [$field, 'untaint', $field_val, $ifs_match];
 606     } else {
 607       ### generic untainter - assuming the other required content_checks did good validation
 608       $_ = /(.*)/ ? $1 : die "Couldn't match?" foreach @$values;
 609       if ($n_values == 1) {
 610         $form->{$field} = $values->[0];
 611         $self->{cgi_object}->param(-name => $field, -value => $values->[0])
 612           if $self->{cgi_object};
 613       } else {
 614         ### values in @{ $form->{$field} } were modified directly
 615         $self->{cgi_object}->param(-name => $field, -value => $values)
 616           if $self->{cgi_object};
 617       }
 618     }
 619   }
 620
 621   ### all done - time to return
 622   return @errors ? \@errors : 0;
 623 }
 624
 625 ###----------------------------------------------------------------###
 626
 627 ### used to validate specific types
 628 sub check_type {
 629   my $self  = shift;
 630   my $value = shift;
 631   my $type  = uc(shift);
 632
 633   ### do valid email address for our system
 634   if ($type eq 'EMAIL') {
 635     return 0 if ! $value;
 636     my($local_p,$dom) = ($value =~ /^(.+)\@(.+?)$/) ? ($1,$2) : return 0;
 637
 638     return 0 if length($local_p) > 60;
 639     return 0 if length($dom) > 100;
 640     return 0 if ! $self->check_type($dom,'DOMAIN') && ! $self->check_type($dom,'IP');
 641     return 0 if ! $self->check_type($local_p,'LOCAL_PART');
 642
 643   ### the "username" portion of an email address
 644   } elsif ($type eq 'LOCAL_PART') {
 645     return 0 if ! defined($value) || ! length($value);
 646     return 0 if $value =~ m/[^a-z0-9.\-!&+]/;
 647     return 0 if $value =~ m/^[\.\-]/;
 648     return 0 if $value =~ m/[\.\-\&]$/;
 649     return 0 if $value =~ m/(\.\-|\-\.|\.\.)/;
 650
 651   ### standard IP address
 652   } elsif ($type eq 'IP') {
 653     return 0 if ! $value;
 654     return (4 == grep {!/\D/ && $_ < 256} split /\./, $value, 4);
 655
 656   ### domain name - including tld and subdomains (which are all domains)
 657   } elsif ($type eq 'DOMAIN') {
 658     return 0 if ! $value;
 659     return 0 if $value =~ m/[^a-z0-9.\-]/;
 660     return 0 if $value =~ m/^[\.\-]/;
 661     return 0 if $value =~ m/(\.\-|\-\.|\.\.)/;
 662     return 0 if length($value) > 255;
 663     return 0 if $value !~ s/\.([a-z]+)$//;
 664
 665     my $ext = $1;
 666     if ($ext eq 'name') { # .name domains
 667       return 0 if $value !~ /^[a-z0-9][a-z0-9\-]{0,62} \. [a-z0-9][a-z0-9\-]{0,62}$/x;
 668     } else {              # any other domains
 669       return 0 if $value !~ /^([a-z0-9][a-z0-9\-]{0,62} \.)* [a-z0-9][a-z0-9\-]{0,62}$/x;
 670     }
 671
 672   ### validate a url
 673   } elsif ($type eq 'URL') {
 674     return 0 if ! $value;
 675     $value =~ s|^https?://([^/]+)||i || return 0;
 676     my $dom = $1;
 677     return 0 if ! $self->check_type($dom,'DOMAIN') && ! $self->check_type($dom,'IP');
 678     return 0 if $value && ! $self->check_type($value,'URI');
 679
 680   ### validate a uri - the path portion of a request
 681   } elsif ($type eq 'URI') {
 682     return 0 if ! $value;
 683     return 0 if $value =~ m/\s+/;
 684
 685   } elsif ($type eq 'CC') {
 686     return 0 if ! $value;
 687     ### validate the number
 688     return 0 if $value =~ /[^\d\-\ ]/
 689       || length($value) > 16
 690       || length($value) < 13;
 691
 692     ### simple mod10 check
 693     $value =~ s/\D//g;
 694     my $sum    = 0;
 695     my $switch = 0;
 696     foreach my $digit ( reverse split //, $value ){
 697       $switch = 1 if ++ $switch > 2;
 698       my $y = $digit * $switch;
 699       $y -= 9 if $y > 9;
 700       $sum += $y;
 701     }
 702     return 0 if $sum % 10;
 703
 704   }
 705
 706   return 1;
 707 }
 708
 709 ###----------------------------------------------------------------###
 710
 711 sub get_validation {
 712     my $self = shift;
 713     my $val  = shift;
 714     require CGI::Ex::Conf;
 715     return CGI::Ex::Conf::conf_read($val, {html_key => 'validation', default_ext => $DEFAULT_EXT});
 716 }
 717
 718 ### returns all keys from all groups - even if group has validate_if
 719 sub get_validation_keys {
 720   my $self     = shift;
 721   my $val_hash = shift;
 722   my $form     = shift; # with optional form - will only return keys in validated groups
 723
 724   ### turn the form into a form hash if doesn't look like one already
 725   if ($form) {
 726       die "Invalid form hash or cgi object" if ! ref $form;
 727       if (ref $form ne 'HASH') {
 728           local $self->{cgi_object} = $form;
 729           $form = $self->cgix->get_form($form);
 730       }
 731   }
 732
 733   ### make sure the validation is a hashref
 734   ### get_validation handle odd types
 735   if (ref $val_hash ne 'HASH') {
 736     $val_hash = $self->get_validation($val_hash) if ref $val_hash ne 'SCALAR' || ! ref $val_hash;
 737     die "Validation groups must be a hashref"    if ref $val_hash ne 'HASH';
 738   }
 739
 740   ### parse keys that are group arguments - and those that are keys to validate
 741   my %ARGS;
 742   my @field_keys = grep { /^(?:group|general)\s+(\w+)/
 743                             ? do {$ARGS{$1} = $val_hash->{$_} ; 0}
 744                             : 1 }
 745                    sort keys %$val_hash;
 746
 747   ### only validate this group if it is supposed to be checked
 748   return if $form && $ARGS{'validate_if'} && ! $self->check_conditional($form, $ARGS{'validate_if'});
 749
 750   ### Look first for items in 'group fields' or 'group order'
 751   my %keys;
 752   if (my $fields = $ARGS{'fields'} || $ARGS{'order'}) {
 753     my $type = $ARGS{'fields'} ? 'group fields' : 'group order';
 754     die "Validation '$type' must be an arrayref when passed"
 755       if ! UNIVERSAL::isa($fields, 'ARRAY');
 756     foreach my $field (@$fields) {
 757         die "Non-defined value in '$type'" if ! defined $field;
 758         if (ref $field) {
 759             die "Found nonhashref value in '$type'" if ref($field) ne 'HASH';
 760             die "Element missing \"field\" key/value in '$type'" if ! defined $field->{'field'};
 761             $keys{$field->{'field'}} = $field->{'name'} || 1;
 762         } elsif ($field eq 'OR') {
 763         } else {
 764             die "No element found in '$type' for $field" if ! exists $val_hash->{$field};
 765             die "Found nonhashref value in '$type'" if ref($val_hash->{$field}) ne 'HASH';
 766             $keys{$field} = $val_hash->{$field}->{'name'} || 1;
 767         }
 768     }
 769   }
 770
 771   ### add any remaining field_vals from our original hash
 772   ### this is necessary for items that weren't in group fields or group order
 773   foreach my $field (@field_keys) {
 774       next if $keys{$field};
 775       die "Found nonhashref value for field $field" if ref($val_hash->{$field}) ne 'HASH';
 776       if (defined $val_hash->{$field}->{'field'}) {
 777           $keys{$val_hash->{$field}->{'field'}} = $val_hash->{$field}->{'name'} || 1;
 778       } else {
 779           $keys{$field} = $val_hash->{$field}->{'name'} || 1;
 780       }
 781   }
 782
 783   return \%keys;
 784 }
 785
 786 ###----------------------------------------------------------------###
 787
 788 ### spit out a chunk that will do the validation
 789 sub generate_js {
 790     ### allow for some browsers to not receive the validation js
 791     return "<!-- JS validation not supported in this browser $_ -->"
 792         if $ENV{'HTTP_USER_AGENT'} && grep {$ENV{'HTTP_USER_AGENT'} =~ $_} @UNSUPPORTED_BROWSERS;
 793
 794     my $self        = shift;
 795     my $val_hash    = shift || die "Missing validation";
 796     my $form_name   = shift || die "Missing form name";
 797     my $js_uri_path = shift || $JS_URI_PATH;
 798     $val_hash = $self->get_validation($val_hash);
 799
 800     ### store any extra items from self
 801     my %EXTRA = ();
 802     $EXTRA{"general $_"} = $self->{$_} for grep {/$QR_EXTRA/o} keys %$self; # add 'general' to be used in javascript
 803
 804     my $js_uri_path_validate = $JS_URI_PATH_VALIDATE || do {
 805         die "Missing \$js_uri_path" if ! $js_uri_path;
 806         "$js_uri_path/CGI/Ex/validate.js";
 807     };
 808
 809     if (! $self->{'no_jsondump'} && eval { require CGI::Ex::JSONDump }) {
 810         my $json = CGI::Ex::JSONDump->new({pretty => 1})->dump($val_hash);
 811         return qq{<script src="$js_uri_path_validate"></script>
 812 <script>
 813 document.validation = $json;
 814 if (document.check_form) document.check_form("$form_name");
 815 </script>
 816 };
 817
 818     } elsif (! $self->{'no_json'} && eval { require JSON }) {
 819         my $json = JSON->new(pretty => 1)->objToJson($val_hash);
 820
 821         return qq{<script src="$js_uri_path_validate"></script>
 822 <script>
 823 document.validation = $json;
 824 if (document.check_form) document.check_form("$form_name");
 825 </script>
 826 };
 827
 828     } elsif (eval { require YAML }) {
 829
 830         my $str = YAML::Dump((scalar keys %EXTRA) ? (\%EXTRA) : () , $val_hash);
 831         $str =~ s/(?<!\\)\\(?=[sSdDwWbB0-9?.*+|\-\^\${}()\[\]])/\\\\/g; # fix some issues with YAML
 832         $str =~ s/\n/\\n\\\n/g; # allow for one big string that flows on multiple lines
 833         $str =~ s/\"/\\\"/g; # quotify it
 834
 835         ### get the paths
 836         my $js_uri_path_yaml = $JS_URI_PATH_YAML || do {
 837             die "Missing \$js_uri_path" if ! $js_uri_path;
 838             "$js_uri_path/CGI/Ex/yaml_load.js";
 839         };
 840
 841         ### return the string
 842         return qq{<script src="$js_uri_path_yaml"></script>
 843 <script src="$js_uri_path_validate"></script>
 844 <script>
 845 document.validation = "$str";
 846 if (document.check_form) document.check_form("$form_name");
 847 </script>
 848 };
 849     } else {
 850         return '<!-- no JSON or YAML support found for JS validation -->';
 851     }
 852 }
 853
 854 ###----------------------------------------------------------------###
 855 ### How to handle errors
 856
 857 package CGI::Ex::Validate::Error;
 858
 859 use strict;
 860 use overload '""' => \&as_string;
 861
 862 sub new {
 863     my ($class, $errors, $extra) = @_;
 864     die "Missing or invalid errors arrayref" if ref $errors ne 'ARRAY';
 865     die "Missing or invalid extra  hashref"  if ref $extra  ne 'HASH';
 866     return bless {errors => $errors, extra => $extra}, $class;
 867 }
 868
 869 sub as_string {
 870   my $self = shift;
 871   my $extra  = $self->{extra} || {};
 872   my $extra2 = shift || {};
 873
 874   ### allow for formatting
 875   my $join = defined($extra2->{as_string_join}) ? $extra2->{as_string_join}
 876     : defined($extra->{as_string_join}) ? $extra->{as_string_join}
 877     : "\n";
 878   my $header = defined($extra2->{as_string_header}) ? $extra2->{as_string_header}
 879     : defined($extra->{as_string_header}) ? $extra->{as_string_header} : "";
 880   my $footer = defined($extra2->{as_string_footer}) ? $extra2->{as_string_footer}
 881     : defined($extra->{as_string_footer}) ? $extra->{as_string_footer} : "";
 882
 883   return $header . join($join, @{ $self->as_array($extra2) }) . $footer;
 884 }
 885
 886 ### return an array of applicable errors
 887 sub as_array {
 888   my $self = shift;
 889   my $errors = $self->{errors} || die "Missing errors";
 890   my $extra  = $self->{extra}  || {};
 891   my $extra2 = shift || {};
 892
 893   my $title = defined($extra2->{as_array_title}) ? $extra2->{as_array_title}
 894     : defined($extra->{as_array_title}) ? $extra->{as_array_title}
 895     : "Please correct the following items:";
 896
 897   ### if there are heading items then we may end up needing a prefix
 898   my $has_headings;
 899   if ($title) {
 900     $has_headings = 1;
 901   } else {
 902     foreach (@$errors) {
 903       next if ref;
 904       $has_headings = 1;
 905       last;
 906     }
 907   }
 908
 909   my $prefix = defined($extra2->{as_array_prefix}) ? $extra2->{as_array_prefix}
 910     : defined($extra->{as_array_prefix}) ? $extra->{as_array_prefix}
 911     : $has_headings ? '  ' : '';
 912
 913   ### get the array ready
 914   my @array = ();
 915   push @array, $title if length $title;
 916
 917   ### add the errors
 918   my %found = ();
 919   foreach my $err (@$errors) {
 920     if (! ref $err) {
 921       push @array, $err;
 922       %found = ();
 923     } else {
 924       my $text = $self->get_error_text($err);
 925       next if $found{$text};
 926       $found{$text} = 1;
 927       push @array, "$prefix$text";
 928     }
 929   }
 930
 931   return \@array;
 932 }
 933
 934 ### return a hash of applicable errors
 935 sub as_hash {
 936   my $self = shift;
 937   my $errors = $self->{errors} || die "Missing errors";
 938   my $extra  = $self->{extra}  || {};
 939   my $extra2 = shift || {};
 940
 941   my $suffix = defined($extra2->{as_hash_suffix}) ? $extra2->{as_hash_suffix}
 942     : defined($extra->{as_hash_suffix}) ? $extra->{as_hash_suffix} : '_error';
 943   my $join   = defined($extra2->{as_hash_join}) ? $extra2->{as_hash_join}
 944     : defined($extra->{as_hash_join}) ? $extra->{as_hash_join} : '<br />';
 945
 946   ### now add to the hash
 947   my %found  = ();
 948   my %return = ();
 949   foreach my $err (@$errors) {
 950     next if ! ref $err;
 951
 952     my ($field, $type, $field_val, $ifs_match) = @$err;
 953     die "Missing field name" if ! $field;
 954     if ($field_val->{delegate_error}) {
 955       $field = $field_val->{delegate_error};
 956       $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
 957     }
 958
 959     my $text = $self->get_error_text($err);
 960     next if $found{$field}->{$text};
 961     $found{$field}->{$text} = 1;
 962
 963     $field .= $suffix;
 964     $return{$field} ||= [];
 965     $return{$field} = [$return{$field}] if ! ref($return{$field});
 966     push @{ $return{$field} }, $text;
 967   }
 968
 969   ### allow for elements returned as
 970   if ($join) {
 971     my $header = defined($extra2->{as_hash_header}) ? $extra2->{as_hash_header}
 972       : defined($extra->{as_hash_header}) ? $extra->{as_hash_header} : "";
 973     my $footer = defined($extra2->{as_hash_footer}) ? $extra2->{as_hash_footer}
 974       : defined($extra->{as_hash_footer}) ? $extra->{as_hash_footer} : "";
 975     foreach my $key (keys %return) {
 976       $return{$key} = $header . join($join,@{ $return{$key} }) . $footer;
 977     }
 978   }
 979
 980   return \%return;
 981 }
 982
 983 ### return a user friendly error message
 984 sub get_error_text {
 985   my $self  = shift;
 986   my $err   = shift;
 987   my $extra = $self->{extra} || {};
 988   my ($field, $type, $field_val, $ifs_match) = @$err;
 989   my $dig     = ($type =~ s/(_?\d+)$//) ? $1 : '';
 990   my $type_lc = lc($type);
 991
 992   ### allow for delegated field names - only used for defaults
 993   if ($field_val->{delegate_error}) {
 994     $field = $field_val->{delegate_error};
 995     $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
 996   }
 997
 998   ### the the name of this thing
 999   my $name = $field_val->{'name'} || "The field $field";
1000   $name =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
1001
1002   ### type can look like "required" or "required2" or "required100023"
1003   ### allow for fallback from required100023_error through required_error
1004   my @possible_error_keys = ("${type}_error");
1005   unshift @possible_error_keys, "${type}${dig}_error" if length($dig);
1006
1007   ### look in the passed hash or self first
1008   my $return;
1009   foreach my $key (@possible_error_keys){
1010     $return = $field_val->{$key} || $extra->{$key} || next;
1011     $return =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
1012     $return =~ s/\$field/$field/g;
1013     $return =~ s/\$name/$name/g;
1014     if (my $value = $field_val->{"$type$dig"}) {
1015       $return =~ s/\$value/$value/g if ! ref $value;
1016     }
1017     last;
1018   }
1019
1020   ### set default messages
1021   if (! $return) {
1022     if ($type eq 'required' || $type eq 'required_if') {
1023       $return = "$name is required.";
1024
1025     } elsif ($type eq 'min_values') {
1026       my $n = $field_val->{"min_values${dig}"};
1027       my $values = ($n == 1) ? 'value' : 'values';
1028       $return = "$name had less than $n $values.";
1029
1030     } elsif ($type eq 'max_values') {
1031       my $n = $field_val->{"max_values${dig}"};
1032       my $values = ($n == 1) ? 'value' : 'values';
1033       $return = "$name had more than $n $values.";
1034
1035     } elsif ($type eq 'enum') {
1036       $return = "$name is not in the given list.";
1037
1038     } elsif ($type eq 'equals') {
1039       my $field2 = $field_val->{"equals${dig}"};
1040       my $name2  = $field_val->{"equals${dig}_name"} || "the field $field2";
1041       $name2 =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
1042       $return = "$name did not equal $name2.";
1043
1044     } elsif ($type eq 'min_len') {
1045       my $n = $field_val->{"min_len${dig}"};
1046       my $char = ($n == 1) ? 'character' : 'characters';
1047       $return = "$name was less than $n $char.";
1048
1049     } elsif ($type eq 'max_len') {
1050       my $n = $field_val->{"max_len${dig}"};
1051       my $char = ($n == 1) ? 'character' : 'characters';
1052       $return = "$name was more than $n $char.";
1053
1054     } elsif ($type eq 'max_in_set') {
1055       my $set = $field_val->{"max_in_set${dig}"};
1056       $return = "Too many fields were chosen from the set ($set)";
1057
1058     } elsif ($type eq 'min_in_set') {
1059       my $set = $field_val->{"min_in_set${dig}"};
1060       $return = "Not enough fields were chosen from the set ($set)";
1061
1062     } elsif ($type eq 'match') {
1063       $return = "$name contains invalid characters.";
1064
1065     } elsif ($type eq 'compare') {
1066       $return = "$name did not fit comparison.";
1067
1068     } elsif ($type eq 'sql') {
1069       $return = "$name did not match sql test.";
1070
1071     } elsif ($type eq 'custom') {
1072       $return = "$name did not match custom test.";
1073
1074     } elsif ($type eq 'type') {
1075       my $_type = $field_val->{"type${dig}"};
1076       $return = "$name did not match type $_type.";
1077
1078     } elsif ($type eq 'untaint') {
1079       $return = "$name cannot be untainted without one of the following checks: enum, equals, match, compare, sql, type, custom";
1080
1081     } elsif ($type eq 'no_extra_fields') {
1082       $return = "$name should not be passed to validate.";
1083     }
1084   }
1085
1086   die "Missing error on field $field for type $type$dig" if ! $return;
1087   return $return;
1088
1089 }
1090
1091 ###----------------------------------------------------------------###
1092
1093 1;
1094
1095
1096 __END__
1097
1098 =head1 SYNOPSIS
1099
1100     use CGI::Ex::Validate;
1101
1102     ### THE SHORT
1103
1104     my $errobj = CGI::Ex::Validate->new->validate($form, $val_hash);
1105
1106     ### THE LONG
1107
1108     my $form = CGI->new;
1109      # OR #
1110     my $form = CGI::Ex->new; # OR CGI::Ex->get_form;
1111      # OR #
1112     my $form = {key1 => 'val1', key2 => 'val2'};
1113
1114
1115     ### simplest
1116     my $val_hash = {
1117         username => {
1118             required => 1,
1119             max_len  => 30,
1120             field    => 'username',
1121             # field is optional in this case - will use key name
1122         },
1123         email    => {
1124             required => 1,
1125             max_len  => 100,
1126             type     => 'email',
1127         },
1128         email2   => {
1129             equals   => 'email',
1130         },
1131     };
1132
1133     ### ordered (only onevent submit needs order)
1134     my $val_hash = {
1135         'group order' => [qw(username email email2)],
1136         username => {required => 1, max_len => 30},
1137         email    => ...,
1138         email2   => ...,
1139     };
1140
1141     ### ordered again
1142     my $val_hash = {
1143         'group fields' => [{
1144             field    => 'username', # field is not optional in this case
1145             required => 1,
1146             max_len  => 30,
1147         }, {
1148             field    => 'email',
1149             required => 1,
1150             max_len  => 100,
1151         }, {
1152             field    => 'email2',
1153             equals   => 'email',
1154         }],
1155     };
1156
1157
1158     my $vob    = CGI::Ex::Validate->new;
1159     my $errobj = $vob->validate($form, $val_hash);
1160
1161     # OR #
1162     # import config using any type CGI::Ex::Conf supports
1163     my $errobj = $vob->validate($form, "/somefile/somewhere.val");
1164
1165     if ($errobj) {
1166         my $error_heading = $errobj->as_string; # OR "$errobj";
1167         my $error_list    = $errobj->as_array;  # ordered list of what when wrong
1168         my $error_hash    = $errobj->as_hash;   # hash of arrayrefs of errors
1169     } else {
1170         # the form passed validation
1171     }
1172
1173     ### will add an error for any form key not found in $val_hash
1174     my $vob = CGI::Ex::Validate->new({no_extra_keys => 1});
1175     my $errobj = $vob->validate($form, $val_hash);
1176
1177
1178     my $js_uri_path = '/js/';     # static or dynamic URI path to find CGI/Ex/validate.js
1179     my $form_name   = "the_form"; # name of the form to attach javascript to
1180     my $javascript  = $vob->generate_js($val_hash, $form_name, $js_uri_path);
1181
1182
1183 =head1 DESCRIPTION
1184
1185 CGI::Ex::Validate is one of many validation modules.  It aims to have
1186 all of the basic data validation functions, avoid adding all of the
1187 millions of possible types, while still giving the capability for the
1188 developer to add their own types for the rare cases that the basic
1189 ones don't suffice.  Generally anything more than basic validation
1190 probably needs programmatic or data based validation.
1191
1192 CGI::Ex::Validate also has full support for providing the same
1193 validation in javascript.  It provides methods for attaching the
1194 javascript to existing forms.  This ability is tightly integrated into
1195 CGI::Ex::App, but it should be easy to add validation just about
1196 anywhere using any type of controller.
1197
1198 As opposed to other kitchen sync validation modules, CGI::Ex::Validate
1199 offers the simple types of validation, and makes it easy to add your
1200 own custom types.  Asside from custom and custom_js, all validation
1201 markup is declarative.
1202
1203 =head1 METHODS
1204
1205 =over 4
1206
1207 =item C<new>
1208
1209 Used to instantiate the object.  Arguments are either a hash, or hashref,
1210 or nothing at all.  Keys of the hash become the keys of the object.
1211
1212 =item C<get_validation>
1213
1214 Given a filename or YAML string will return perl hash.  If more than one
1215 group is contained in the file, it will return an arrayref of hashrefs.
1216
1217     my $ref = $self->get_validation($file);
1218
1219 =item C<get_validation_keys>
1220
1221 Given a filename or YAML string or a validation hashref, will return all
1222 of the possible keys found in the validation hash.  This can be used to
1223 check to see if extra items have been passed to validate.  If a second
1224 argument contains a form hash is passed, get_validation_keys will only
1225 return the keys of groups that were validated.
1226
1227     my $key_hashref = $self->get_validation_keys($val_hash);
1228
1229 The values of the hash are the names of the fields.
1230
1231 =item C<validate>
1232
1233 Arguments are a form hashref or cgi object, a validation hashref or
1234 filename, and an optional what_was_validated arrayref (discussed
1235 further later on).  If a CGI object is passed, CGI::Ex::get_form will
1236 be called on that object to turn it into a hashref.  If a filename is
1237 given for the validation, get_validation will be called on that
1238 filename.  If the what_was_validated_arrayref is passed - it will be
1239 populated (pushed) with the field hashes that were actually validated
1240 (anything that was skipped because of validate_if will not be in the
1241 array).
1242
1243 If the form passes validation, validate will return undef.  If it
1244 fails validation, it will return a CGI::Ex::Validate::Error object.
1245 If the 'raise_error' option has been set, validate will die
1246 with a CGI::Ex::validate::Error object as the value.
1247
1248     my $err_obj = $self->validate($form, $val_hash);
1249
1250     # OR #
1251
1252     $self->{raise_error} = 1; # can also be listed in the val_hash
1253     eval { $self->validate($form, $val_hash) };
1254     if ($@) { my $err_obj = $@; }
1255
1256 =item C<generate_js>
1257
1258 Works with CGI::Ex::JSONDump, but can also work with  JSON or YAML
1259 if desired (see L<JSON> or L<YAML>).
1260
1261 Takes a validation hash, a form name, and an optional javascript uri
1262 path and returns Javascript that can be embedded on a page and will
1263 perform identical validations as the server side.  The form name must be
1264 the name of the form that the validation will act upon - the name is
1265 used to register an onsubmit function.  The javascript uri path is
1266 used to embed the locations of javascript source files included
1267 with the CGI::Ex distribution.
1268
1269 The javascript uri path is highly dependent upon the server
1270 configuration and therefore must be configured manually.  It may be
1271 passed to generate_js, or it may be specified in $JS_URI_PATH.  There
1272 are two files included with this module that are needed -
1273 CGI/Ex/yaml_load.js and CGI/Ex/validate.js.  When generating the js
1274 code, generate_js will look in $JS_URI_PATH_YAML and
1275 $JS_URI_PATH_VALIDATE.  If either of these are not set, generate_js
1276 will default to "$JS_URI_PATH/CGI/Ex/yaml_load.js" and
1277 "$JS_URI_PATH/CGI/Ex/validate.js" (Note: yaml_load is only needed
1278 if the flags no_jsondump and no_json have been set).
1279
1280     $self->generate_js($val_hash, 'my_form', "/cgi-bin/js")
1281
1282     # would generate something like the following...
1283
1284     <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
1285     ... more js follows ...
1286
1287     $CGI::Ex::Validate::JS_URI_PATH = "/stock/js";
1288     $self->generate_js($val_hash, 'my_form')
1289
1290     # would generate something like the following...
1291
1292     <script src="/stock/js/CGI/Ex/validate.js"></script>
1293     ... more js follows ...
1294
1295 Referencing yaml_load.js and validate.js can be done in any of
1296 several ways.  They can be copied to or symlinked to a fixed location
1297 in the server's html directory.  They can also be printed out by a cgi.
1298 The method C<-E<gt>print_js> has been provided in CGI::Ex for printing
1299 js files found in the perl hierarchy.  See L<CGI::Ex> for more details.
1300 The $JS_URI_PATH of "/cgi-bin/js" could contain the following:
1301
1302     #!/usr/bin/perl -w
1303
1304     use strict;
1305     use CGI::Ex;
1306
1307     ### path_info should contain something like /CGI/Ex/validate.js
1308     my $info = $ENV{PATH_INFO} || '';
1309     die "Invalid path" if $info !~ m|^(/\w+)+.js$|;
1310     $info =~ s|^/+||;
1311
1312     CGI::Ex->new->print_js($info);
1313     exit;
1314
1315 The print_js method in CGI::Ex is designed to cache the javascript in
1316 the browser.
1317
1318 =item C<-E<gt>cgix>
1319
1320 Returns a CGI::Ex object.  Used internally if a CGI object is
1321 passed to validate rather than a straight form hash.
1322
1323 =back
1324
1325 =head1 VALIDATION HASH
1326
1327 The validation hash may be passed as a hashref or as a filename, or as
1328 a YAML document string.  Experience has shown it to be better
1329 programming to pass in a hashref.  If the validation "hash" is a
1330 filename or a YAML string, it will be translated into a hash using
1331 CGI::Ex::Conf.
1332
1333 Keys matching the regex m/^(general|group)\s+(\w+)$/ such as "group
1334 onevent" are reserved and are counted as GROUP OPTIONS.  Other keys
1335 (if any, should be field names that need validation).
1336
1337 If the GROUP OPTION 'group validate_if' is set, the validation will
1338 only be validated if the conditions of the validate_if are met.  If
1339 'group validate_if' is not specified, then the validation will
1340 proceed.  See the validate_if VALIDATION type for more information.
1341
1342 Each of the items listed in the validation will be validated.  The
1343 validation order is determined in one of three ways:
1344
1345 =over 4
1346
1347 =item Specify 'group fields' arrayref.
1348
1349     # order will be (username, password, 'm/\w+_foo/', somethingelse)
1350     {
1351       'group title' => "User Information",
1352       'group fields' => [
1353         {field => 'username',   required => 1},
1354         {field => 'password',   required => 1},
1355         {field => 'm/\w+_foo/', required => 1},
1356       ],
1357       somethingelse => {required => 1},
1358     }
1359
1360 =item Specify 'group order' arrayref.
1361
1362     # order will be (username, password, 'm/\w+_foo/', somethingelse)
1363     {
1364       'group title' => "User Information",
1365       'group order' => [qw(username password), 'm/\w+_foo/'],
1366       username      => {required => 1},
1367       password      => {required => 1},
1368       'm/\w+_foo/'  => {required => 1},
1369       somethingelse => {required => 1},
1370     }
1371
1372 =item Do nothing - use sorted order.
1373
1374     # order will be ('m/\w+_foo/', password, somethingelse, username)
1375     {
1376       'group title' => "User Information",
1377       username      => {required => 1},
1378       password      => {required => 1},
1379       'm/\w+_foo/'  => {required => 1},
1380       somethingelse => {required => 1},
1381     }
1382
1383 =back
1384
1385 Optionally the 'group fields' or the 'group order' may contain the
1386 word 'OR' as a special keyword.  If the item preceding 'OR' fails
1387 validation the item after 'OR' will be tested instead.  If the item
1388 preceding 'OR' passes validation the item after 'OR' will not be
1389 tested.
1390
1391     'group order' => [qw(zip OR postalcode state OR region)],
1392
1393 At this time, only "group onevent" submit works with this option.  Using
1394 OR is deprecated.  Instead you should use min_in_set or max_in_set.
1395
1396     'zip' => {
1397          max_in_set: '1 of zip, postalcode',
1398     },
1399     'state' => {
1400          max_in_set: '1 of state, region',
1401     },
1402
1403 Each individual field validation hashref will operate on the field contained
1404 in the 'field' key.  This key may also be a regular expression in the
1405 form of 'm/somepattern/'.  If a regular expression is used, all keys
1406 matching that pattern will be validated.  If the field key is
1407 not specified, the key from the top level hash will be used.
1408
1409     foobar => {   # "foobar" is not used as key because field is specified
1410        field    => 'real_key_name',
1411        required => 1,
1412     },
1413     real_key_name2 => {
1414        required => 1,
1415     },
1416
1417 Each of the individual field validation hashrefs should contain the
1418 types listed in VALIDATION TYPES.
1419
1420 =head1 VALIDATION TYPES
1421
1422 This section lists the available validation types.  Multiple instances
1423 of the same type may be used for some validation types by adding a
1424 number to the type (ie match, match2, match232).  Multiple instances
1425 are validated in sorted order.  Types that allow multiple values are:
1426 compare, custom, custom_js, equals, enum, match, required_if, sql,
1427 type, validate_if, and replace (replace is a MODIFICATION TYPE).
1428
1429 =over 4
1430
1431 =item C<compare>
1432
1433 Allows for custom comparisons.  Available types are
1434 >, <, >=, <=, !=, ==, gt, lt, ge, le, ne, and eq.  Comparisons
1435 also work in the JS.
1436
1437     {
1438       field    => 'my_number',
1439       match    => 'm/^\d+$/',
1440       compare1 => '> 100',
1441       compare2 => '< 255',
1442       compare3 => '!= 150',
1443     }
1444
1445 =item C<custom>
1446
1447 Custom value - not available in JS.  Allows for extra programming types.
1448 May be either a boolean value predetermined before calling validate, or may be
1449 a coderef that will be called during validation.  If coderef is called, it will
1450 be passed the field name, the form value for that name, and a reference to the
1451 field validation hash.  If the custom type returns false the element fails
1452 validation and an error is added.
1453
1454     {
1455       field => 'username',
1456       custom => sub {
1457         my ($key, $val, $type, $field_val_hash) = @_;
1458         # do something here
1459         return 0;
1460       },
1461     }
1462
1463 =item C<custom_js>
1464
1465 Custom value - only available in JS.  Allows for extra programming types.
1466 May be a javascript function (if fully declared in javascript), a string containing
1467 a javascript function (that will be eval'ed into a real function),
1468 a boolean value pre-determined before calling validate, or may be
1469 section of javascript that will be eval'ed (the last value of
1470 the eval'ed javascript will determine if validation passed).  A false response indicates
1471 the value did not pass validation.  A true response indicates that it did.  See
1472 the samples/validate_js_0_tests.html page for a sample of usages.
1473
1474     {
1475       field => 'date',
1476       required => 1,
1477       match    => 'm|^\d\d\d\d/\d\d/\d\d$|',
1478       match_error => 'Please enter date in YYYY/MM/DD format',
1479       custom_js => "function (args) {
1480         var t=new Date();
1481         var y=t.getYear()+1900;
1482         var m=t.getMonth() + 1;
1483         var d=t.getDate();
1484         if (m<10) m = '0'+m;
1485         if (d<10) d = '0'+d;
1486         (args.value > ''+y+'/'+m+'/'+d) ? 1 : 0;
1487       }",
1488       custom_js_error => 'The date was not greater than today.',
1489     }
1490
1491 =item C<enum>
1492
1493 Allows for checking whether an item matches a set of options.  In perl
1494 the value may be passed as an arrayref.  In the conf or in perl the
1495 value may be passed of the options joined with ||.
1496
1497     {
1498       field => 'password_type',
1499       enum  => 'plaintext||crypt||md5', # OR enum => [qw(plaintext crypt md5)],
1500     }
1501
1502 =item C<equals>
1503
1504 Allows for comparison of two form elements.  Can have an optional !.
1505
1506     {
1507       field  => 'password',
1508       equals => 'password_verify',
1509     },
1510     {
1511       field  => 'domain1',
1512       equals => '!domain2', # make sure the fields are not the same
1513     }
1514
1515 =item C<had_error>
1516
1517 Typically used by a validate_if.  Allows for checking if this item has had
1518 an error.
1519
1520     {
1521        field => 'alt_password',
1522        validate_if => {field => 'password', had_error => 1},
1523     }
1524
1525 This is basically the opposite of was_valid.
1526
1527 =item C<match>
1528
1529 Allows for regular expression comparison.  Multiple matches may
1530 be concatenated with ||.  Available in JS.
1531
1532     {
1533       field   => 'my_ip',
1534       match   => 'm/^\d{1,3}(\.\d{1,3})3$/',
1535       match_2 => '!/^0\./ || !/^192\./',
1536     }
1537
1538 =item C<max_in_set> and C<min_in_set>
1539
1540 Somewhat like min_values and max_values except that you specify the
1541 fields that participate in the count.  Also - entries that are not
1542 defined or do not have length are not counted.  An optional "of" can
1543 be placed after the number for human readability.
1544
1545     min_in_set => "2 of foo bar baz",
1546       # two of the fields foo, bar or baz must be set
1547       # same as
1548     min_in_set => "2 foo bar baz",
1549       # same as
1550     min_in_set => "2 OF foo bar baz",
1551
1552     validate_if => {field => 'whatever', max_in_set => '0 of whatever'},
1553       # only run validation if there were zero occurrences of whatever
1554
1555 =item C<max_len and min_len>
1556
1557 Allows for check on the length of fields
1558
1559     {
1560       field   => 'site',
1561       min_len => 4,
1562       max_len => 100,
1563     }
1564
1565 =item C<max_values> and C<min_values>
1566
1567 Allows for specifying the maximum number of form elements passed.
1568 max_values defaults to 1 (You must explicitly set it higher
1569 to allow more than one item by any given name).
1570
1571 =item C<required>
1572
1573 Requires the form field to have some value.  If the field is not present,
1574 no other checks will be run.
1575
1576 =item C<required_if>
1577
1578 Requires the form field if the condition is satisfied.  The conditions
1579 available are the same as for validate_if.  This is somewhat the same
1580 as saying:
1581
1582     validate_if => 'some_condition',
1583     required    => 1
1584
1585     required_if => 'some_condition',
1586
1587 If a regex is used for the field name, the required_if
1588 field will have any match patterns swapped in.
1589
1590     {
1591       field       => 'm/^(\w+)_pass/',
1592       required_if => '$1_user',
1593     }
1594
1595 This example would require the "foobar_pass" field to be set
1596 if the "foobar_user" field was passed.
1597
1598 =item C<sql>
1599
1600 SQL query based - not available in JS.  The database handle will be looked
1601 for in the value $self->{dbhs}->{foo} if sql_db_type is set to 'foo',
1602 otherwise it will default to $self->{dbh}.  If $self->{dbhs}->{foo} or
1603 $self->{dbh} is a coderef - they will be called and should return a dbh.
1604
1605     {
1606       field => 'username',
1607       sql   => 'SELECT COUNT(*) FROM users WHERE username = ?',
1608       sql_error_if => 1, # default is 1 - set to 0 to negate result
1609       # sql_db_type  => 'foo', # will look for a dbh under $self->{dbhs}->{foo}
1610     }
1611
1612 =item C<type>
1613
1614 Allows for more strict type checking.  Currently supported types
1615 include CC (credit card), EMAIL, DOMAIN, IP, URL.  Other types will be
1616 added upon request provided we can add a perl and a javascript
1617 version.
1618
1619     {
1620       field => 'credit_card',
1621       type  => 'CC',
1622     }
1623
1624 =item C<validate_if>
1625
1626 If validate_if is specified, the field will only be validated
1627 if the conditions are met.  Works in JS.
1628
1629     validate_if => {field => 'name', required => 1, max_len => 30}
1630     # Will only validate if the field "name" is present and is less than 30 chars.
1631
1632     validate_if => 'name',
1633     # SAME as
1634     validate_if => {field => 'name', required => 1},
1635
1636     validate_if => '! name',
1637     # SAME as
1638     validate_if => {field => 'name', max_in_set => '0 of name'},
1639
1640     validate_if => 'name was_valid',
1641     # SAME as
1642     validate_if => {field => 'name', was_valid => 1},
1643
1644     validate_if => {field => 'country', compare => "eq US"},
1645     # only if country's value is equal to US
1646
1647     validate_if => {field => 'country', compare => "ne US"},
1648     # if country doesn't equal US
1649
1650     validate_if => {field => 'password', match => 'm/^md5\([a-z0-9]{20}\)$/'},
1651     # if password looks like md5(12345678901234567890)
1652
1653     {
1654       field       => 'm/^(\w+)_pass/',
1655       validate_if => '$1_user',
1656       required    => 1,
1657     }
1658     # will validate foo_pass only if foo_user was present.
1659
1660 The validate_if may also contain an arrayref of validation items.  So that
1661 multiple checks can be run.  They will be run in order.  validate_if will
1662 return true only if all options returned true.
1663
1664     validate_if => ['email', 'phone', 'fax']
1665
1666 Optionally, if validate_if is an arrayref, it may contain the word
1667 'OR' as a special keyword.  If the item preceding 'OR' fails validation
1668 the item after 'OR' will be tested instead.  If the item preceding 'OR'
1669 passes validation the item after 'OR' will not be tested.
1670
1671     validate_if => [qw(zip OR postalcode)],
1672
1673 =item C<was_valid>
1674
1675 Typically used by a validate_if.  Allows for checking if this item has successfully
1676 been validated.
1677
1678     {
1679        field => 'password2',
1680        validate_if => {field => 'password', was_valid => 1},
1681     }
1682
1683 This is basically the opposite of was_valid.
1684
1685 =back
1686
1687 =head1 SPECIAL VALIDATION TYPES
1688
1689 =over 4
1690
1691 =item C<field>
1692
1693 Specify which field to work on.  Key may be a regex in the form 'm/\w+_user/'.
1694 This key is required if 'group fields' is used or if validate_if or required_if
1695 are used.  It can optionally be used with other types to specify a different form
1696 element to operate on.  On errors, if a non-default error is found, $field
1697 will be swapped with the value found in field.
1698
1699 The field name may also be a regular expression in the
1700 form of 'm/somepattern/'.  If a regular expression is used, all keys
1701 matching that pattern will be validated.
1702
1703 =item C<name>
1704
1705 Name to use for errors.  If a name is not specified, default errors will use
1706 "The field $field" as the name.  If a non-default error is found, $name
1707 will be swapped with this name.
1708
1709 =item C<delegate_error>
1710
1711 This option allows for any errors generated on a field to delegate to
1712 a different field.  If the field name was a regex, any patterns will
1713 be swapped into the delegate_error value. This option is generally only
1714 useful with the as_hash method of the error object (for inline errors).
1715
1716     {
1717       field => 'zip',
1718       match => 'm/^\d{5}/',
1719     },
1720     {
1721       field => 'zip_plus4',
1722       match => 'm/^\d{4}/',
1723       delegate_error => 'zip',
1724     },
1725     {
1726       field => 'm/^(id_[\d+])_user$/',
1727       delegate_error => '$1',
1728     },
1729
1730 =item C<exclude_js>
1731
1732 This allows the cgi to do checking while keeping the checks from
1733 being run in JavaScript
1734
1735     {
1736       field      => 'cgi_var',
1737       required   => 1,
1738       exclude_js => 1,
1739     }
1740
1741 =item C<exclude_cgi>
1742
1743 This allows the js to do checking while keeping the checks from
1744 being run in the cgi
1745
1746     {
1747       field       => 'js_var',
1748       required    => 1,
1749       exclude_cgi => 1,
1750     }
1751
1752 =item C<vif_disable>
1753
1754 Only functions in javascript.  Will mark set the form element to
1755 disabled if validate_if fails.  It will mark it as enabled if
1756 validate_if is successful.  This item should normally only be used
1757 when onevent includes "change" or "blur".
1758
1759 =back
1760
1761 =head1 MODIFYING VALIDATION TYPES
1762
1763 The following types will modify the form value before it is processed.
1764 They work in both the perl and in javascript as well.  The javascript
1765 version changes the actual value in the form on appropriate form types.
1766
1767 =over 4
1768
1769 =item C<do_not_trim>
1770
1771 By default, validate will trim leading and trailing whitespace
1772 from submitted values.  Set do_not_trim to 1 to allow it to
1773 not trim.
1774
1775     {field => 'foo', do_not_trim => 1}
1776
1777 =item C<trim_control_chars>
1778
1779 Off by default.  If set to true, removes characters in the
1780 \x00 to \x31 range (Tabs are translated to a single space).
1781
1782     {field => 'foo', trim_control_chars => 1}
1783
1784 =item C<replace>
1785
1786 Pass a swap pattern to change the actual value of the form.
1787 Any perl regex can be passed but it is suggested that javascript
1788 compatible regexes are used to make generate_js possible.
1789
1790     {field => 'foo', replace => 's/(\d{3})(\d{3})(\d{3})/($1) $2-$3/'}
1791
1792 =item C<default>
1793
1794 Set item to default value if there is no existing value (undefined
1795 or zero length string).
1796
1797     {field => 'country', default => 'EN'}
1798
1799 =item C<to_upper_case> and C<to_lower_case>
1800
1801 Do what they say they do.
1802
1803 =item C<untaint>
1804
1805 Requires that the validated field has been also checked with
1806 an enum, equals, match, compare, custom, or type check.  If the
1807 field has been checked and there are no errors - the field is "untainted."
1808
1809 This is for use in conjunction with perl's -T switch.
1810
1811 =item C<clear_on_error>
1812
1813 Clears the form field should a validation error occur.  Only supported
1814 on the Javascript side (no affect on the server side).
1815
1816 =back
1817
1818 =head1 ERROR OBJECT
1819
1820 Failed validation results in an error an error object created via the
1821 new_error method.  The default error class is CGI::Ex::Validate::Error.
1822
1823 The error object has several methods for determining what the errors were.
1824
1825 =over 4
1826
1827 =item C<as_array>
1828
1829 Returns an array or arrayref (depending on scalar context) of errors that
1830 occurred in the order that they occurred.  Individual groups may have a heading
1831 and the entire validation will have a heading (the default heading can be changed
1832 via the 'as_array_title' group option).  Each error that occurred is a separate
1833 item and are pre-pended with 'as_array_prefix' (which is a group option - default
1834 is '  ').  The as_array_ options may also be set via a hashref passed to as_array.
1835 as_array_title defaults to 'Please correct the following items:'.
1836
1837   ### if this returns the following
1838   my $array = $err_obj->as_array;
1839   # $array looks like
1840   # ['Please correct the following items:', '  error1', '  error2']
1841
1842   ### then this would return the following
1843   my $array = $err_obj->as_array({
1844     as_array_prefix => '  - ',
1845     as_array_title  => 'Something went wrong:',
1846   });
1847   # $array looks like
1848   # ['Something went wrong:', '  - error1', '  - error2']
1849
1850 =item C<as_string>
1851
1852 Returns values of as_array joined with a newline.  This method is used as
1853 the stringification for the error object.  Values of as_array are joined with
1854 'as_string_join' which defaults to "\n".  If 'as_string_header' is set, it will
1855 be pre-pended onto the error string.  If 'as_string_footer' is set, it will be
1856 appended onto the error string.
1857
1858   ### if this returns the following
1859   my $string = $err_obj->as_string;
1860   # $string looks like
1861   # "Please correct the following items:\n  error1\n  error2"
1862
1863   ### then this would return the following
1864   my $string = $err_obj->as_string({
1865     as_array_prefix  => '  - ',
1866     as_array_title   => 'Something went wrong:',
1867     as_string_join   => '<br />',
1868     as_string_header => '<span class="error">',
1869     as_string_footer => '</span>',
1870   });
1871   # $string looks like
1872   # '<span class="error">Something went wrong:<br />  - error1<br />  - error2</span>'
1873
1874 =item C<as_hash>
1875
1876 Returns a hash or hashref (depending on scalar context) of errors that
1877 occurred.  Each key is the field name of the form that failed
1878 validation with 'as_hash_suffix' added on as a suffix.  as_hash_suffix
1879 is available as a group option and may also be passed in via a
1880 hashref as the only argument to as_hash.  The default value is
1881 '_error'.  The values of the hash are arrayrefs of errors that
1882 occurred to that form element.
1883
1884 By default as_hash will return the values of the hash as arrayrefs (a
1885 list of the errors that occurred to that key).  It is possible to also
1886 return the values as strings.  Three options are available for
1887 formatting: 'as_hash_header' which will be pre-pended onto the error
1888 string, 'as_hash_footer' which will be appended, and 'as_hash_join'
1889 which will be used to join the arrayref.  The only argument required
1890 to force the stringification is 'as_hash_join'.
1891
1892   ### if this returns the following
1893   my $hash = $err_obj->as_hash;
1894   # $hash looks like
1895   # {key1_error => ['error1', 'error2']}
1896
1897   ### then this would return the following
1898   my $hash = $err_obj->as_hash({
1899     as_hash_suffix => '_foo',
1900     as_hash_join   => '<br />',
1901     as_hash_header => '<span class="error">'
1902     as_hash_footer => '</span>'
1903   });
1904   # $hash looks like
1905   # {key1_foo => '<span class="error">error1<br />error2</span>'}
1906
1907 =back
1908
1909 =head1 GROUP OPTIONS
1910
1911 Any key in a validation hash matching the pattern
1912 m/^(group|general)\s+(\w+)$/ is considered a group option (the reason
1913 that either group or general may be used is that CGI::Ex::Validate
1914 used to have the concept of validation groups - these were not
1915 commonly used so support has been deprecated as of the 2.10 release).
1916 Group options will also be looked for in the Validate object ($self)
1917 and can be set when instantiating the object ($self->{raise_error} is
1918 equivalent to $valhash->{'group raise_error'}).
1919
1920 Options may also be set globally before calling validate by
1921 populating the %DEFAULT_OPTIONS global hash.  However, only the options
1922 set properly in the $valhash will be passed to the javascript.
1923
1924 =over 4
1925
1926 =item C<title>
1927
1928 Used as a group section heading when as_array or as_string is called
1929 by the error object.
1930
1931     'group title' => 'Title of errors',
1932
1933 =item C<order>
1934
1935 Order in which to validate key/value pairs of group.
1936
1937     'group order' => [qw(user pass email OR phone)],
1938
1939 =item C<fields>
1940
1941 Arrayref of validation items to validate.
1942
1943     'group fields' => [{
1944         field    => 'field1',
1945         required => 1,
1946     }, {
1947         field    => 'field2',
1948         required => 1,
1949     }],
1950
1951 =item C<validate_if>
1952
1953 If specified - the entire hashref will only be validated if
1954 the "if" conditions are met.
1955
1956     'group validate_if => {field => 'email', required => 1},
1957
1958 This group would only validate all fields if the email field
1959 was present.
1960
1961 =item C<raise_error>
1962
1963 If raise_error is true, any call to validate that fails validation
1964 will die with an error object as the value.
1965
1966 =item C<no_extra_fields>
1967
1968 If no_extra_fields is true, validate will add errors for any field found
1969 in form that does not have a field_val hashref in the validation hash.
1970 Default is false.  If no_extra_fields is set to 'used', it will check for
1971 any keys that were not in a group that was validated.
1972
1973 An important exception to this is that field_val hashrefs or field names listed
1974 in a validate_if or required_if statement will not be included.  You must
1975 have an explicit entry for each key.
1976
1977 =item C<\w+_error>
1978
1979 These items allow for an override of the default errors.
1980
1981   'group required_error' => '$name is really required',
1982   'group max_len_error'  => '$name must be shorter than $value characters',
1983     # OR #
1984   my $self = CGI::Ex::Validate->new({
1985     max_len_error => '$name must be shorter than $value characters',
1986   });
1987
1988 =item C<as_array_title>
1989
1990 Used as the section title for all errors that occur, when as_array
1991 or as_string is called by the error object.
1992
1993 =item C<as_array_prefix>
1994
1995 Used as prefix to individual errors that occur, when as_array
1996 or as_string is called by the error object.  Each individual error
1997 will be prefixed with this string.  Headings will not be prefixed.
1998 Default is '  '.
1999
2000 =item C<as_string_join>
2001
2002 When as_string is called, the values from as_array will be joined with
2003 as_string_join.  Default value is "\n".
2004
2005 =item C<as_string_header>
2006
2007 If set, will be pre-pended onto the string when as_string is called.
2008
2009 =item C<as_string_footer>
2010
2011 If set, will be pre-pended onto the string when as_string is called.
2012
2013 =item C<as_hash_suffix>
2014
2015 Added on to key names during the call to as_hash.  Default is '_error'.
2016
2017 =item C<as_hash_join>
2018
2019 By default, as_hash will return hashref values that are errors joined with
2020 the default as_hash_join value of <br />.  It can also return values that are
2021 arrayrefs of the errors.  This can be done by setting as_hash_join to a non-true value
2022 (for example '')
2023
2024 =item C<as_hash_header>
2025
2026 If as_hash_join has been set to a true value, as_hash_header may be set to
2027 a string that will be pre-pended on to the error string.
2028
2029 =item C<as_hash_footer>
2030
2031 If as_hash_join has been set to a true value, as_hash_footer may be set to
2032 a string that will be postpended on to the error string.
2033
2034 =item C<onevent>
2035
2036 Defaults to {submit => 1}.  This controls when the javascript validation
2037 will take place.  May be passed any or all or load, submit, change, or blur.
2038 Multiple events may be passed in the hash.
2039
2040     'group onevent' => {submit => 1, change => 1}',
2041
2042 A comma separated string of types may also be passed:
2043
2044     'group onevent' => 'submit,change,blur,load',
2045
2046 Currently, change and blur will not work for dynamically matched
2047 field names such as 'm/\w+/'.  Support will be added.
2048
2049 =item C<set_hook>
2050
2051 Defaults document.validate_set_hook which defaults to nothing.  If
2052 "group set_hook" or document.validate_set_hook are set to a function,
2053 they will be passed the key name of a form element that had a
2054 validation error and the error that will be set.  If a true value is
2055 returned, then validate will not also the inline error.  If no value
2056 or false is returned (default) the validate will continue setting the
2057 inline error.  This gives full control over setting inline
2058 errors. samples/validate_js_2_onchange.html has a good example of
2059 using these hooks.
2060
2061     'group set_hook' => "function (args) {
2062       alert("Setting error to field "+args.key);
2063     }",
2064
2065 The args parameter includes key, value, val_hash, and form.
2066
2067 The document.validate_set_hook option is probably the better option to use,
2068 as it helps to separate display functionality out into your html templates
2069 rather than storing too much html logic in your CGI.
2070
2071 =item C<clear_hook>
2072
2073 Similar to set_hook, but called when inline error is cleared.  Its
2074 corresponding default is document.validate_clear_hook.  The clear hook
2075 is also sampled in samples/validate_js_2_onchange.html
2076
2077     'group clear_hook' => "function (args) {
2078       alert("Clear error on field "+args.key);
2079     }",
2080
2081 The args parameter includes key, val_hash, form, and was_valid.
2082
2083 =item C<no_inline>
2084
2085 If set to true, the javascript validation will not attempt to generate
2086 inline errors when the only "group onevent" type is "submit".  Default
2087 is true.  Inline errors are independent of confirm and alert errors.
2088
2089     'group no_inline' => 1,
2090
2091 =item C<no_confirm>
2092
2093 If set to true, the javascript validation will try to use an alert
2094 instead of a confirm to inform the user of errors when one of the
2095 "group onevent" types is "submit".  Alert and confirm are independent
2096 or inline errors.  Default is false.
2097
2098     'group no_confirm' => 1,
2099
2100 =item C<no_alert>
2101
2102 If set to true, the javascript validation will not show an alert box
2103 when errors occur.  Default is false.  This option only comes into
2104 play if no_confirm is also set.  This option is only in effect if
2105 "group onevent" includes "submit".  This option is independent of
2106 inline errors.  Although it is possible to turn off all errors by
2107 setting no_inline, no_confirm, and no_alert all to 1, it is suggested
2108 that at least one of the error reporting facilities is left on.
2109
2110     'group no_alert' => 1,
2111
2112 =back
2113
2114 =head1 JAVASCRIPT
2115
2116 CGI::Ex::Validate provides for having duplicate validation on the
2117 client side as on the server side.  Errors can be shown in any
2118 combination of inline and confirm, inline and alert, inline only,
2119 confirm only, alert only, and none.  These combinations are controlled
2120 by the group options no_inline, no_confirm, and no_alert.
2121 Javascript validation can be generated for a page using the
2122 C<-E<gt>generate_js> Method of CGI::Ex::Validate.  It is also possible
2123 to store the validation inline with the html.  This can be done by
2124 giving each of the elements to be validated an attribute called
2125 "validation", or by setting a global javascript variable called
2126 "document.validation" or "var validation".  An html file containing this
2127 validation will be read in using CGI::Ex::Conf::read_handler_html.
2128
2129 All inline html validation must be written in yaml.
2130
2131 It is anticipated that the html will contain something like one of the
2132 following examples:
2133
2134   <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2135   <script>
2136   document.validation = {
2137     'group no_confirm': 1,
2138     'group no_alert':   1,
2139     'group onevent':    'change,blur,submit',
2140     'group order': ['username', 'password'],
2141     username: {
2142       required: 1,
2143       max_len: 20
2144     },
2145     password: {
2146       required: 1,
2147       max_len: 30
2148     }
2149   };
2150   if (document.check_form) document.check_form('my_form_name');
2151   </script>
2152
2153 Prior to the realization of JSON, YAML was part of the method
2154 for introducing validation into the script.
2155
2156   <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
2157   <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2158   <script>
2159   // \n\ allows all browsers to view this as a single string
2160   document.validation = "\n\
2161   general no_confirm: 1\n\
2162   general no_alert: 1\n\
2163   group order: [username, password]\n\
2164   username:\n\
2165     required: 1\n\
2166     max_len: 20\n\
2167   password:\n\
2168     required: 1\n\
2169     max_len: 30\n\
2170   ";
2171   if (document.check_form) document.check_form('my_form_name');
2172   </script>
2173
2174 Alternately, CGI/Ex/validate.js can parse the YAML from html
2175 form element attributes:
2176
2177   <form name="my_form_name">
2178
2179   Username: <input type=text size=20 name=username validation="
2180     required: 1
2181     max_len: 20
2182   "><br>
2183   <span class=error id=username_error>[% username_error %]</span><br>
2184
2185   Password: <input type=text size=20 name=password validation="
2186     required: 1
2187     max_len: 30
2188   "><br>
2189   <span class=error id=password_error>[% password_error %]</span><br>
2190
2191   <input type=submit>
2192
2193   </form>
2194
2195   <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
2196   <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2197   <script>
2198   if (document.check_form) document.check_form('my_form_name');
2199   </script>
2200
2201 The read_handler_html from CGI::Ex::Conf will find the YAML types
2202 of validation.  The JSON type is what would be generated by default
2203 when the validation is specified in Perl.
2204
2205 If inline errors are enabled (default), each error that occurs will attempt
2206 to find an html element with its name as the id.  For example, if
2207 the field "username" failed validation and created a "username_error",
2208 the javascript would set the html of <span id="username_error"></span>
2209 to the error message.
2210
2211 It is suggested to use something like the following so that you can
2212 have inline javascript validation as well as report validation errors
2213 from the server side as well.
2214
2215    <span class=error id=password_error>[% password_error %]</span><br>
2216
2217 If the javascript fails for some reason, the form should still be able
2218 to submit as normal (fail gracefully).
2219
2220 Additionally, there are two hooks that are called when ever an inline
2221 error is set or cleared.  The following hooks are used in
2222 samples/validate_js_2_onchange.html to highlight the row and set an icon.
2223
2224     document.validate_set_hook = function (args) {
2225       document.getElementById(args.key+'_img').innerHTML
2226         = '<span style="font-weight:bold;color:red">!</span>';
2227       document.getElementById(args.key+'_row').style.background
2228         = '#ffdddd';
2229     };
2230
2231     document.validate_clear_hook = function (args) {
2232       if (args.was_valid) {
2233        document.getElementById(args.key+'_img').innerHTML
2234          = '<span style="font-weight:bold;color:green">+</span>';
2235        document.getElementById(args.key+'_row').style.background
2236          = '#ddffdd';
2237       } else {
2238        document.getElementById(args.key+'_img').innerHTML = '';
2239        document.getElementById(args.key+'_row').style.background = '#fff';
2240       }
2241     };
2242
2243 These hooks can also be set as "group clear_hook" and "group set_hook"
2244 which are defined further above.
2245
2246 If the confirm option is used ("group onevent" includes submit and
2247 "group no_confirm" is false), the errors will be displayed to the
2248 user.  If they choose OK they will be able to try and fix the errors.
2249 If they choose cancel, the form will submit anyway and will rely on
2250 the server to do the validation.  This is for fail safety to make sure
2251 that if the javascript didn't validate correctly, the user can still
2252 submit the data.
2253
2254 =head1 THANKS
2255
2256 Thanks to Eamon Daly for providing bug fixes for bugs in validate.js
2257 caused by HTML::Prototype.
2258
2259 =head1 LICENSE
2260
2261 This module may be distributed under the same terms as Perl itself.
2262
2263 =head1 AUTHOR
2264
2265 Paul Seamons <paul at seamons dot com>
2266
2267 =cut