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.24';
  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     return 0 if $value !~ /^([a-z0-9][a-z0-9\-]{0,62} \.)* [a-z0-9][a-z0-9\-]{0,62}$/x;
 665
 666   ### validate a url
 667   } elsif ($type eq 'URL') {
 668     return 0 if ! $value;
 669     $value =~ s|^https?://([^/]+)||i || return 0;
 670     my $dom = $1;
 671     return 0 if ! $self->check_type($dom,'DOMAIN') && ! $self->check_type($dom,'IP');
 672     return 0 if $value && ! $self->check_type($value,'URI');
 673
 674   ### validate a uri - the path portion of a request
 675   } elsif ($type eq 'URI') {
 676     return 0 if ! $value;
 677     return 0 if $value =~ m/\s+/;
 678
 679   } elsif ($type eq 'CC') {
 680     return 0 if ! $value;
 681     ### validate the number
 682     return 0 if $value =~ /[^\d\-\ ]/
 683       || length($value) > 16
 684       || length($value) < 13;
 685
 686     ### simple mod10 check
 687     $value =~ s/\D//g;
 688     my $sum    = 0;
 689     my $switch = 0;
 690     foreach my $digit ( reverse split //, $value ){
 691       $switch = 1 if ++ $switch > 2;
 692       my $y = $digit * $switch;
 693       $y -= 9 if $y > 9;
 694       $sum += $y;
 695     }
 696     return 0 if $sum % 10;
 697
 698   }
 699
 700   return 1;
 701 }
 702
 703 ###----------------------------------------------------------------###
 704
 705 sub get_validation {
 706     my $self = shift;
 707     my $val  = shift;
 708     require CGI::Ex::Conf;
 709     return CGI::Ex::Conf::conf_read($val, {html_key => 'validation', default_ext => $DEFAULT_EXT});
 710 }
 711
 712 ### returns all keys from all groups - even if group has validate_if
 713 sub get_validation_keys {
 714   my $self     = shift;
 715   my $val_hash = shift;
 716   my $form     = shift; # with optional form - will only return keys in validated groups
 717
 718   ### turn the form into a form hash if doesn't look like one already
 719   if ($form) {
 720       die "Invalid form hash or cgi object" if ! ref $form;
 721       if (ref $form ne 'HASH') {
 722           local $self->{cgi_object} = $form;
 723           $form = $self->cgix->get_form($form);
 724       }
 725   }
 726
 727   ### make sure the validation is a hashref
 728   ### get_validation handle odd types
 729   if (ref $val_hash ne 'HASH') {
 730     $val_hash = $self->get_validation($val_hash) if ref $val_hash ne 'SCALAR' || ! ref $val_hash;
 731     die "Validation groups must be a hashref"    if ref $val_hash ne 'HASH';
 732   }
 733
 734   ### parse keys that are group arguments - and those that are keys to validate
 735   my %ARGS;
 736   my @field_keys = grep { /^(?:group|general)\s+(\w+)/
 737                             ? do {$ARGS{$1} = $val_hash->{$_} ; 0}
 738                             : 1 }
 739                    sort keys %$val_hash;
 740
 741   ### only validate this group if it is supposed to be checked
 742   return if $form && $ARGS{'validate_if'} && ! $self->check_conditional($form, $ARGS{'validate_if'});
 743
 744   ### Look first for items in 'group fields' or 'group order'
 745   my %keys;
 746   if (my $fields = $ARGS{'fields'} || $ARGS{'order'}) {
 747     my $type = $ARGS{'fields'} ? 'group fields' : 'group order';
 748     die "Validation '$type' must be an arrayref when passed"
 749       if ! UNIVERSAL::isa($fields, 'ARRAY');
 750     foreach my $field (@$fields) {
 751         die "Non-defined value in '$type'" if ! defined $field;
 752         if (ref $field) {
 753             die "Found nonhashref value in '$type'" if ref($field) ne 'HASH';
 754             die "Element missing \"field\" key/value in '$type'" if ! defined $field->{'field'};
 755             $keys{$field->{'field'}} = $field->{'name'} || 1;
 756         } elsif ($field eq 'OR') {
 757         } else {
 758             die "No element found in '$type' for $field" if ! exists $val_hash->{$field};
 759             die "Found nonhashref value in '$type'" if ref($val_hash->{$field}) ne 'HASH';
 760             $keys{$field} = $val_hash->{$field}->{'name'} || 1;
 761         }
 762     }
 763   }
 764
 765   ### add any remaining field_vals from our original hash
 766   ### this is necessary for items that weren't in group fields or group order
 767   foreach my $field (@field_keys) {
 768       next if $keys{$field};
 769       die "Found nonhashref value for field $field" if ref($val_hash->{$field}) ne 'HASH';
 770       if (defined $val_hash->{$field}->{'field'}) {
 771           $keys{$val_hash->{$field}->{'field'}} = $val_hash->{$field}->{'name'} || 1;
 772       } else {
 773           $keys{$field} = $val_hash->{$field}->{'name'} || 1;
 774       }
 775   }
 776
 777   return \%keys;
 778 }
 779
 780 ###----------------------------------------------------------------###
 781
 782 ### spit out a chunk that will do the validation
 783 sub generate_js {
 784     ### allow for some browsers to not receive the validation js
 785     return "<!-- JS validation not supported in this browser $_ -->"
 786         if $ENV{'HTTP_USER_AGENT'} && grep {$ENV{'HTTP_USER_AGENT'} =~ $_} @UNSUPPORTED_BROWSERS;
 787
 788     my $self        = shift;
 789     my $val_hash    = shift || die "Missing validation";
 790     my $form_name   = shift || die "Missing form name";
 791     my $js_uri_path = shift || $JS_URI_PATH;
 792     $val_hash = $self->get_validation($val_hash);
 793
 794     ### store any extra items from self
 795     my %EXTRA = ();
 796     $EXTRA{"general $_"} = $self->{$_} for grep {/$QR_EXTRA/o} keys %$self; # add 'general' to be used in javascript
 797
 798     my $js_uri_path_validate = $JS_URI_PATH_VALIDATE || do {
 799         die "Missing \$js_uri_path" if ! $js_uri_path;
 800         "$js_uri_path/CGI/Ex/validate.js";
 801     };
 802
 803     if (! $self->{'no_jsondump'} && eval { require CGI::Ex::JSONDump }) {
 804         my $json = CGI::Ex::JSONDump->new({pretty => 1})->dump($val_hash);
 805         return qq{<script src="$js_uri_path_validate"></script>
 806 <script>
 807 document.validation = $json;
 808 if (document.check_form) document.check_form("$form_name");
 809 </script>
 810 };
 811
 812     } elsif (! $self->{'no_json'} && eval { require JSON }) {
 813         my $json = JSON->new(pretty => 1)->objToJson($val_hash);
 814
 815         return qq{<script src="$js_uri_path_validate"></script>
 816 <script>
 817 document.validation = $json;
 818 if (document.check_form) document.check_form("$form_name");
 819 </script>
 820 };
 821
 822     } elsif (eval { require YAML }) {
 823
 824         my $str = YAML::Dump((scalar keys %EXTRA) ? (\%EXTRA) : () , $val_hash);
 825         $str =~ s/(?<!\\)\\(?=[sSdDwWbB0-9?.*+|\-\^\${}()\[\]])/\\\\/g; # fix some issues with YAML
 826         $str =~ s/\n/\\n\\\n/g; # allow for one big string that flows on multiple lines
 827         $str =~ s/\"/\\\"/g; # quotify it
 828
 829         ### get the paths
 830         my $js_uri_path_yaml = $JS_URI_PATH_YAML || do {
 831             die "Missing \$js_uri_path" if ! $js_uri_path;
 832             "$js_uri_path/CGI/Ex/yaml_load.js";
 833         };
 834
 835         ### return the string
 836         return qq{<script src="$js_uri_path_yaml"></script>
 837 <script src="$js_uri_path_validate"></script>
 838 <script>
 839 document.validation = "$str";
 840 if (document.check_form) document.check_form("$form_name");
 841 </script>
 842 };
 843     } else {
 844         return '<!-- no JSON or YAML support found for JS validation -->';
 845     }
 846 }
 847
 848 ###----------------------------------------------------------------###
 849 ### How to handle errors
 850
 851 package CGI::Ex::Validate::Error;
 852
 853 use strict;
 854 use overload '""' => \&as_string;
 855
 856 sub new {
 857     my ($class, $errors, $extra) = @_;
 858     die "Missing or invalid errors arrayref" if ref $errors ne 'ARRAY';
 859     die "Missing or invalid extra  hashref"  if ref $extra  ne 'HASH';
 860     return bless {errors => $errors, extra => $extra}, $class;
 861 }
 862
 863 sub as_string {
 864   my $self = shift;
 865   my $extra  = $self->{extra} || {};
 866   my $extra2 = shift || {};
 867
 868   ### allow for formatting
 869   my $join = defined($extra2->{as_string_join}) ? $extra2->{as_string_join}
 870     : defined($extra->{as_string_join}) ? $extra->{as_string_join}
 871     : "\n";
 872   my $header = defined($extra2->{as_string_header}) ? $extra2->{as_string_header}
 873     : defined($extra->{as_string_header}) ? $extra->{as_string_header} : "";
 874   my $footer = defined($extra2->{as_string_footer}) ? $extra2->{as_string_footer}
 875     : defined($extra->{as_string_footer}) ? $extra->{as_string_footer} : "";
 876
 877   return $header . join($join, @{ $self->as_array($extra2) }) . $footer;
 878 }
 879
 880 ### return an array of applicable errors
 881 sub as_array {
 882   my $self = shift;
 883   my $errors = $self->{errors} || die "Missing errors";
 884   my $extra  = $self->{extra}  || {};
 885   my $extra2 = shift || {};
 886
 887   my $title = defined($extra2->{as_array_title}) ? $extra2->{as_array_title}
 888     : defined($extra->{as_array_title}) ? $extra->{as_array_title}
 889     : "Please correct the following items:";
 890
 891   ### if there are heading items then we may end up needing a prefix
 892   my $has_headings;
 893   if ($title) {
 894     $has_headings = 1;
 895   } else {
 896     foreach (@$errors) {
 897       next if ref;
 898       $has_headings = 1;
 899       last;
 900     }
 901   }
 902
 903   my $prefix = defined($extra2->{as_array_prefix}) ? $extra2->{as_array_prefix}
 904     : defined($extra->{as_array_prefix}) ? $extra->{as_array_prefix}
 905     : $has_headings ? '  ' : '';
 906
 907   ### get the array ready
 908   my @array = ();
 909   push @array, $title if length $title;
 910
 911   ### add the errors
 912   my %found = ();
 913   foreach my $err (@$errors) {
 914     if (! ref $err) {
 915       push @array, $err;
 916       %found = ();
 917     } else {
 918       my $text = $self->get_error_text($err);
 919       next if $found{$text};
 920       $found{$text} = 1;
 921       push @array, "$prefix$text";
 922     }
 923   }
 924
 925   return \@array;
 926 }
 927
 928 ### return a hash of applicable errors
 929 sub as_hash {
 930   my $self = shift;
 931   my $errors = $self->{errors} || die "Missing errors";
 932   my $extra  = $self->{extra}  || {};
 933   my $extra2 = shift || {};
 934
 935   my $suffix = defined($extra2->{as_hash_suffix}) ? $extra2->{as_hash_suffix}
 936     : defined($extra->{as_hash_suffix}) ? $extra->{as_hash_suffix} : '_error';
 937   my $join   = defined($extra2->{as_hash_join}) ? $extra2->{as_hash_join}
 938     : defined($extra->{as_hash_join}) ? $extra->{as_hash_join} : '<br />';
 939
 940   ### now add to the hash
 941   my %found  = ();
 942   my %return = ();
 943   foreach my $err (@$errors) {
 944     next if ! ref $err;
 945
 946     my ($field, $type, $field_val, $ifs_match) = @$err;
 947     die "Missing field name" if ! $field;
 948     if ($field_val->{delegate_error}) {
 949       $field = $field_val->{delegate_error};
 950       $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
 951     }
 952
 953     my $text = $self->get_error_text($err);
 954     next if $found{$field}->{$text};
 955     $found{$field}->{$text} = 1;
 956
 957     $field .= $suffix;
 958     $return{$field} ||= [];
 959     $return{$field} = [$return{$field}] if ! ref($return{$field});
 960     push @{ $return{$field} }, $text;
 961   }
 962
 963   ### allow for elements returned as
 964   if ($join) {
 965     my $header = defined($extra2->{as_hash_header}) ? $extra2->{as_hash_header}
 966       : defined($extra->{as_hash_header}) ? $extra->{as_hash_header} : "";
 967     my $footer = defined($extra2->{as_hash_footer}) ? $extra2->{as_hash_footer}
 968       : defined($extra->{as_hash_footer}) ? $extra->{as_hash_footer} : "";
 969     foreach my $key (keys %return) {
 970       $return{$key} = $header . join($join,@{ $return{$key} }) . $footer;
 971     }
 972   }
 973
 974   return \%return;
 975 }
 976
 977 ### return a user friendly error message
 978 sub get_error_text {
 979   my $self  = shift;
 980   my $err   = shift;
 981   my $extra = $self->{extra} || {};
 982   my ($field, $type, $field_val, $ifs_match) = @$err;
 983   my $dig     = ($type =~ s/(_?\d+)$//) ? $1 : '';
 984   my $type_lc = lc($type);
 985
 986   ### allow for delegated field names - only used for defaults
 987   if ($field_val->{delegate_error}) {
 988     $field = $field_val->{delegate_error};
 989     $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
 990   }
 991
 992   ### the the name of this thing
 993   my $name = $field_val->{'name'} || "The field $field";
 994   $name =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
 995
 996   ### type can look like "required" or "required2" or "required100023"
 997   ### allow for fallback from required100023_error through required_error
 998   my @possible_error_keys = ("${type}_error");
 999   unshift @possible_error_keys, "${type}${dig}_error" if length($dig);
1000
1001   ### look in the passed hash or self first
1002   my $return;
1003   foreach my $key (@possible_error_keys){
1004     $return = $field_val->{$key} || $extra->{$key} || next;
1005     $return =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
1006     $return =~ s/\$field/$field/g;
1007     $return =~ s/\$name/$name/g;
1008     if (my $value = $field_val->{"$type$dig"}) {
1009       $return =~ s/\$value/$value/g if ! ref $value;
1010     }
1011     last;
1012   }
1013
1014   ### set default messages
1015   if (! $return) {
1016     if ($type eq 'required' || $type eq 'required_if') {
1017       $return = "$name is required.";
1018
1019     } elsif ($type eq 'min_values') {
1020       my $n = $field_val->{"min_values${dig}"};
1021       my $values = ($n == 1) ? 'value' : 'values';
1022       $return = "$name had less than $n $values.";
1023
1024     } elsif ($type eq 'max_values') {
1025       my $n = $field_val->{"max_values${dig}"};
1026       my $values = ($n == 1) ? 'value' : 'values';
1027       $return = "$name had more than $n $values.";
1028
1029     } elsif ($type eq 'enum') {
1030       $return = "$name is not in the given list.";
1031
1032     } elsif ($type eq 'equals') {
1033       my $field2 = $field_val->{"equals${dig}"};
1034       my $name2  = $field_val->{"equals${dig}_name"} || "the field $field2";
1035       $name2 =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
1036       $return = "$name did not equal $name2.";
1037
1038     } elsif ($type eq 'min_len') {
1039       my $n = $field_val->{"min_len${dig}"};
1040       my $char = ($n == 1) ? 'character' : 'characters';
1041       $return = "$name was less than $n $char.";
1042
1043     } elsif ($type eq 'max_len') {
1044       my $n = $field_val->{"max_len${dig}"};
1045       my $char = ($n == 1) ? 'character' : 'characters';
1046       $return = "$name was more than $n $char.";
1047
1048     } elsif ($type eq 'max_in_set') {
1049       my $set = $field_val->{"max_in_set${dig}"};
1050       $return = "Too many fields were chosen from the set ($set)";
1051
1052     } elsif ($type eq 'min_in_set') {
1053       my $set = $field_val->{"min_in_set${dig}"};
1054       $return = "Not enough fields were chosen from the set ($set)";
1055
1056     } elsif ($type eq 'match') {
1057       $return = "$name contains invalid characters.";
1058
1059     } elsif ($type eq 'compare') {
1060       $return = "$name did not fit comparison.";
1061
1062     } elsif ($type eq 'sql') {
1063       $return = "$name did not match sql test.";
1064
1065     } elsif ($type eq 'custom') {
1066       $return = "$name did not match custom test.";
1067
1068     } elsif ($type eq 'type') {
1069       my $_type = $field_val->{"type${dig}"};
1070       $return = "$name did not match type $_type.";
1071
1072     } elsif ($type eq 'untaint') {
1073       $return = "$name cannot be untainted without one of the following checks: enum, equals, match, compare, sql, type, custom";
1074
1075     } elsif ($type eq 'no_extra_fields') {
1076       $return = "$name should not be passed to validate.";
1077     }
1078   }
1079
1080   die "Missing error on field $field for type $type$dig" if ! $return;
1081   return $return;
1082
1083 }
1084
1085 ###----------------------------------------------------------------###
1086
1087 1;
1088
1089
1090 __END__
1091
1092 =head1 SYNOPSIS
1093
1094     use CGI::Ex::Validate;
1095
1096     ### THE SHORT
1097
1098     my $errobj = CGI::Ex::Validate->new->validate($form, $val_hash);
1099
1100     ### THE LONG
1101
1102     my $form = CGI->new;
1103      # OR #
1104     my $form = CGI::Ex->new; # OR CGI::Ex->get_form;
1105      # OR #
1106     my $form = {key1 => 'val1', key2 => 'val2'};
1107
1108
1109     ### simplest
1110     my $val_hash = {
1111         username => {
1112             required => 1,
1113             max_len  => 30,
1114             field    => 'username',
1115             # field is optional in this case - will use key name
1116         },
1117         email    => {
1118             required => 1,
1119             max_len  => 100,
1120             type     => 'email',
1121         },
1122         email2   => {
1123             equals   => 'email',
1124         },
1125     };
1126
1127     ### ordered (only onevent submit needs order)
1128     my $val_hash = {
1129         'group order' => [qw(username email email2)],
1130         username => {required => 1, max_len => 30},
1131         email    => ...,
1132         email2   => ...,
1133     };
1134
1135     ### ordered again
1136     my $val_hash = {
1137         'group fields' => [{
1138             field    => 'username', # field is not optional in this case
1139             required => 1,
1140             max_len  => 30,
1141         }, {
1142             field    => 'email',
1143             required => 1,
1144             max_len  => 100,
1145         }, {
1146             field    => 'email2',
1147             equals   => 'email',
1148         }],
1149     };
1150
1151
1152     my $vob    = CGI::Ex::Validate->new;
1153     my $errobj = $vob->validate($form, $val_hash);
1154
1155     # OR #
1156     # import config using any type CGI::Ex::Conf supports
1157     my $errobj = $vob->validate($form, "/somefile/somewhere.val");
1158
1159     if ($errobj) {
1160         my $error_heading = $errobj->as_string; # OR "$errobj";
1161         my $error_list    = $errobj->as_array;  # ordered list of what when wrong
1162         my $error_hash    = $errobj->as_hash;   # hash of arrayrefs of errors
1163     } else {
1164         # the form passed validation
1165     }
1166
1167     ### will add an error for any form key not found in $val_hash
1168     my $vob = CGI::Ex::Validate->new({no_extra_keys => 1});
1169     my $errobj = $vob->validate($form, $val_hash);
1170
1171
1172     my $js_uri_path = '/js/';     # static or dynamic URI path to find CGI/Ex/validate.js
1173     my $form_name   = "the_form"; # name of the form to attach javascript to
1174     my $javascript  = $vob->generate_js($val_hash, $form_name, $js_uri_path);
1175
1176
1177 =head1 DESCRIPTION
1178
1179 CGI::Ex::Validate is one of many validation modules.  It aims to have
1180 all of the basic data validation functions, avoid adding all of the
1181 millions of possible types, while still giving the capability for the
1182 developer to add their own types for the rare cases that the basic
1183 ones don't suffice.  Generally anything more than basic validation
1184 probably needs programmatic or data based validation.
1185
1186 CGI::Ex::Validate also has full support for providing the same
1187 validation in javascript.  It provides methods for attaching the
1188 javascript to existing forms.  This ability is tightly integrated into
1189 CGI::Ex::App, but it should be easy to add validation just about
1190 anywhere using any type of controller.
1191
1192 As opposed to other kitchen sync validation modules, CGI::Ex::Validate
1193 offers the simple types of validation, and makes it easy to add your
1194 own custom types.  Asside from custom and custom_js, all validation
1195 markup is declarative.
1196
1197 =head1 METHODS
1198
1199 =over 4
1200
1201 =item C<new>
1202
1203 Used to instantiate the object.  Arguments are either a hash, or hashref,
1204 or nothing at all.  Keys of the hash become the keys of the object.
1205
1206 =item C<get_validation>
1207
1208 Given a filename or YAML string will return perl hash.  If more than one
1209 group is contained in the file, it will return an arrayref of hashrefs.
1210
1211     my $ref = $self->get_validation($file);
1212
1213 =item C<get_validation_keys>
1214
1215 Given a filename or YAML string or a validation hashref, will return all
1216 of the possible keys found in the validation hash.  This can be used to
1217 check to see if extra items have been passed to validate.  If a second
1218 argument contains a form hash is passed, get_validation_keys will only
1219 return the keys of groups that were validated.
1220
1221     my $key_hashref = $self->get_validation_keys($val_hash);
1222
1223 The values of the hash are the names of the fields.
1224
1225 =item C<validate>
1226
1227 Arguments are a form hashref or cgi object, a validation hashref or
1228 filename, and an optional what_was_validated arrayref (discussed
1229 further later on).  If a CGI object is passed, CGI::Ex::get_form will
1230 be called on that object to turn it into a hashref.  If a filename is
1231 given for the validation, get_validation will be called on that
1232 filename.  If the what_was_validated_arrayref is passed - it will be
1233 populated (pushed) with the field hashes that were actually validated
1234 (anything that was skipped because of validate_if will not be in the
1235 array).
1236
1237 If the form passes validation, validate will return undef.  If it
1238 fails validation, it will return a CGI::Ex::Validate::Error object.
1239 If the 'raise_error' option has been set, validate will die
1240 with a CGI::Ex::validate::Error object as the value.
1241
1242     my $err_obj = $self->validate($form, $val_hash);
1243
1244     # OR #
1245
1246     $self->{raise_error} = 1; # can also be listed in the val_hash
1247     eval { $self->validate($form, $val_hash) };
1248     if ($@) { my $err_obj = $@; }
1249
1250 =item C<generate_js>
1251
1252 Works with CGI::Ex::JSONDump, but can also work with  JSON or YAML
1253 if desired (see L<JSON> or L<YAML>).
1254
1255 Takes a validation hash, a form name, and an optional javascript uri
1256 path and returns Javascript that can be embedded on a page and will
1257 perform identical validations as the server side.  The form name must be
1258 the name of the form that the validation will act upon - the name is
1259 used to register an onsubmit function.  The javascript uri path is
1260 used to embed the locations of javascript source files included
1261 with the CGI::Ex distribution.
1262
1263 The javascript uri path is highly dependent upon the server
1264 configuration and therefore must be configured manually.  It may be
1265 passed to generate_js, or it may be specified in $JS_URI_PATH.  There
1266 are two files included with this module that are needed -
1267 CGI/Ex/yaml_load.js and CGI/Ex/validate.js.  When generating the js
1268 code, generate_js will look in $JS_URI_PATH_YAML and
1269 $JS_URI_PATH_VALIDATE.  If either of these are not set, generate_js
1270 will default to "$JS_URI_PATH/CGI/Ex/yaml_load.js" and
1271 "$JS_URI_PATH/CGI/Ex/validate.js" (Note: yaml_load is only needed
1272 if the flags no_jsondump and no_json have been set).
1273
1274     $self->generate_js($val_hash, 'my_form', "/cgi-bin/js")
1275
1276     # would generate something like the following...
1277
1278     <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
1279     ... more js follows ...
1280
1281     $CGI::Ex::Validate::JS_URI_PATH = "/stock/js";
1282     $self->generate_js($val_hash, 'my_form')
1283
1284     # would generate something like the following...
1285
1286     <script src="/stock/js/CGI/Ex/validate.js"></script>
1287     ... more js follows ...
1288
1289 Referencing yaml_load.js and validate.js can be done in any of
1290 several ways.  They can be copied to or symlinked to a fixed location
1291 in the server's html directory.  They can also be printed out by a cgi.
1292 The method C<-E<gt>print_js> has been provided in CGI::Ex for printing
1293 js files found in the perl hierarchy.  See L<CGI::Ex> for more details.
1294 The $JS_URI_PATH of "/cgi-bin/js" could contain the following:
1295
1296     #!/usr/bin/perl -w
1297
1298     use strict;
1299     use CGI::Ex;
1300
1301     ### path_info should contain something like /CGI/Ex/validate.js
1302     my $info = $ENV{PATH_INFO} || '';
1303     die "Invalid path" if $info !~ m|^(/\w+)+.js$|;
1304     $info =~ s|^/+||;
1305
1306     CGI::Ex->new->print_js($info);
1307     exit;
1308
1309 The print_js method in CGI::Ex is designed to cache the javascript in
1310 the browser.
1311
1312 =item C<-E<gt>cgix>
1313
1314 Returns a CGI::Ex object.  Used internally if a CGI object is
1315 passed to validate rather than a straight form hash.
1316
1317 =back
1318
1319 =head1 VALIDATION HASH
1320
1321 The validation hash may be passed as a hashref or as a filename, or as
1322 a YAML document string.  Experience has shown it to be better
1323 programming to pass in a hashref.  If the validation "hash" is a
1324 filename or a YAML string, it will be translated into a hash using
1325 CGI::Ex::Conf.
1326
1327 Keys matching the regex m/^(general|group)\s+(\w+)$/ such as "group
1328 onevent" are reserved and are counted as GROUP OPTIONS.  Other keys
1329 (if any, should be field names that need validation).
1330
1331 If the GROUP OPTION 'group validate_if' is set, the validation will
1332 only be validated if the conditions of the validate_if are met.  If
1333 'group validate_if' is not specified, then the validation will
1334 proceed.  See the validate_if VALIDATION type for more information.
1335
1336 Each of the items listed in the validation will be validated.  The
1337 validation order is determined in one of three ways:
1338
1339 =over 4
1340
1341 =item Specify 'group fields' arrayref.
1342
1343     # order will be (username, password, 'm/\w+_foo/', somethingelse)
1344     {
1345       'group title' => "User Information",
1346       'group fields' => [
1347         {field => 'username',   required => 1},
1348         {field => 'password',   required => 1},
1349         {field => 'm/\w+_foo/', required => 1},
1350       ],
1351       somethingelse => {required => 1},
1352     }
1353
1354 =item Specify 'group order' arrayref.
1355
1356     # order will be (username, password, 'm/\w+_foo/', somethingelse)
1357     {
1358       'group title' => "User Information",
1359       'group order' => [qw(username password), 'm/\w+_foo/'],
1360       username      => {required => 1},
1361       password      => {required => 1},
1362       'm/\w+_foo/'  => {required => 1},
1363       somethingelse => {required => 1},
1364     }
1365
1366 =item Do nothing - use sorted order.
1367
1368     # order will be ('m/\w+_foo/', password, somethingelse, username)
1369     {
1370       'group title' => "User Information",
1371       username      => {required => 1},
1372       password      => {required => 1},
1373       'm/\w+_foo/'  => {required => 1},
1374       somethingelse => {required => 1},
1375     }
1376
1377 =back
1378
1379 Optionally the 'group fields' or the 'group order' may contain the
1380 word 'OR' as a special keyword.  If the item preceding 'OR' fails
1381 validation the item after 'OR' will be tested instead.  If the item
1382 preceding 'OR' passes validation the item after 'OR' will not be
1383 tested.
1384
1385     'group order' => [qw(zip OR postalcode state OR region)],
1386
1387 At this time, only "group onevent" submit works with this option.  Using
1388 OR is deprecated.  Instead you should use min_in_set or max_in_set.
1389
1390     'zip' => {
1391          max_in_set: '1 of zip, postalcode',
1392     },
1393     'state' => {
1394          max_in_set: '1 of state, region',
1395     },
1396
1397 Each individual field validation hashref will operate on the field contained
1398 in the 'field' key.  This key may also be a regular expression in the
1399 form of 'm/somepattern/'.  If a regular expression is used, all keys
1400 matching that pattern will be validated.  If the field key is
1401 not specified, the key from the top level hash will be used.
1402
1403     foobar => {   # "foobar" is not used as key because field is specified
1404        field    => 'real_key_name',
1405        required => 1,
1406     },
1407     real_key_name2 => {
1408        required => 1,
1409     },
1410
1411 Each of the individual field validation hashrefs should contain the
1412 types listed in VALIDATION TYPES.
1413
1414 =head1 VALIDATION TYPES
1415
1416 This section lists the available validation types.  Multiple instances
1417 of the same type may be used for some validation types by adding a
1418 number to the type (ie match, match2, match232).  Multiple instances
1419 are validated in sorted order.  Types that allow multiple values are:
1420 compare, custom, custom_js, equals, enum, match, required_if, sql,
1421 type, validate_if, and replace (replace is a MODIFICATION TYPE).
1422
1423 =over 4
1424
1425 =item C<compare>
1426
1427 Allows for custom comparisons.  Available types are
1428 >, <, >=, <=, !=, ==, gt, lt, ge, le, ne, and eq.  Comparisons
1429 also work in the JS.
1430
1431     {
1432       field    => 'my_number',
1433       match    => 'm/^\d+$/',
1434       compare1 => '> 100',
1435       compare2 => '< 255',
1436       compare3 => '!= 150',
1437     }
1438
1439 =item C<custom>
1440
1441 Custom value - not available in JS.  Allows for extra programming types.
1442 May be either a boolean value predetermined before calling validate, or may be
1443 a coderef that will be called during validation.  If coderef is called, it will
1444 be passed the field name, the form value for that name, and a reference to the
1445 field validation hash.  If the custom type returns false the element fails
1446 validation and an error is added.
1447
1448     {
1449       field => 'username',
1450       custom => sub {
1451         my ($key, $val, $type, $field_val_hash) = @_;
1452         # do something here
1453         return 0;
1454       },
1455     }
1456
1457 =item C<custom_js>
1458
1459 Custom value - only available in JS.  Allows for extra programming types.
1460 May be a javascript function (if fully declared in javascript), a string containing
1461 a javascript function (that will be eval'ed into a real function),
1462 a boolean value pre-determined before calling validate, or may be
1463 section of javascript that will be eval'ed (the last value of
1464 the eval'ed javascript will determine if validation passed).  A false response indicates
1465 the value did not pass validation.  A true response indicates that it did.  See
1466 the samples/validate_js_0_tests.html page for a sample of usages.
1467
1468     {
1469       field => 'date',
1470       required => 1,
1471       match    => 'm|^\d\d\d\d/\d\d/\d\d$|',
1472       match_error => 'Please enter date in YYYY/MM/DD format',
1473       custom_js => "function (args) {
1474         var t=new Date();
1475         var y=t.getYear()+1900;
1476         var m=t.getMonth() + 1;
1477         var d=t.getDate();
1478         if (m<10) m = '0'+m;
1479         if (d<10) d = '0'+d;
1480         (args.value > ''+y+'/'+m+'/'+d) ? 1 : 0;
1481       }",
1482       custom_js_error => 'The date was not greater than today.',
1483     }
1484
1485 =item C<enum>
1486
1487 Allows for checking whether an item matches a set of options.  In perl
1488 the value may be passed as an arrayref.  In the conf or in perl the
1489 value may be passed of the options joined with ||.
1490
1491     {
1492       field => 'password_type',
1493       enum  => 'plaintext||crypt||md5', # OR enum => [qw(plaintext crypt md5)],
1494     }
1495
1496 =item C<equals>
1497
1498 Allows for comparison of two form elements.  Can have an optional !.
1499
1500     {
1501       field  => 'password',
1502       equals => 'password_verify',
1503     },
1504     {
1505       field  => 'domain1',
1506       equals => '!domain2', # make sure the fields are not the same
1507     }
1508
1509 =item C<had_error>
1510
1511 Typically used by a validate_if.  Allows for checking if this item has had
1512 an error.
1513
1514     {
1515        field => 'alt_password',
1516        validate_if => {field => 'password', had_error => 1},
1517     }
1518
1519 This is basically the opposite of was_valid.
1520
1521 =item C<match>
1522
1523 Allows for regular expression comparison.  Multiple matches may
1524 be concatenated with ||.  Available in JS.
1525
1526     {
1527       field   => 'my_ip',
1528       match   => 'm/^\d{1,3}(\.\d{1,3})3$/',
1529       match_2 => '!/^0\./ || !/^192\./',
1530     }
1531
1532 =item C<max_in_set> and C<min_in_set>
1533
1534 Somewhat like min_values and max_values except that you specify the
1535 fields that participate in the count.  Also - entries that are not
1536 defined or do not have length are not counted.  An optional "of" can
1537 be placed after the number for human readability.
1538
1539     min_in_set => "2 of foo bar baz",
1540       # two of the fields foo, bar or baz must be set
1541       # same as
1542     min_in_set => "2 foo bar baz",
1543       # same as
1544     min_in_set => "2 OF foo bar baz",
1545
1546     validate_if => {field => 'whatever', max_in_set => '0 of whatever'},
1547       # only run validation if there were zero occurrences of whatever
1548
1549 =item C<max_len and min_len>
1550
1551 Allows for check on the length of fields
1552
1553     {
1554       field   => 'site',
1555       min_len => 4,
1556       max_len => 100,
1557     }
1558
1559 =item C<max_values> and C<min_values>
1560
1561 Allows for specifying the maximum number of form elements passed.
1562 max_values defaults to 1 (You must explicitly set it higher
1563 to allow more than one item by any given name).
1564
1565 =item C<required>
1566
1567 Requires the form field to have some value.  If the field is not present,
1568 no other checks will be run.
1569
1570 =item C<required_if>
1571
1572 Requires the form field if the condition is satisfied.  The conditions
1573 available are the same as for validate_if.  This is somewhat the same
1574 as saying:
1575
1576     validate_if => 'some_condition',
1577     required    => 1
1578
1579     required_if => 'some_condition',
1580
1581 If a regex is used for the field name, the required_if
1582 field will have any match patterns swapped in.
1583
1584     {
1585       field       => 'm/^(\w+)_pass/',
1586       required_if => '$1_user',
1587     }
1588
1589 This example would require the "foobar_pass" field to be set
1590 if the "foobar_user" field was passed.
1591
1592 =item C<sql>
1593
1594 SQL query based - not available in JS.  The database handle will be looked
1595 for in the value $self->{dbhs}->{foo} if sql_db_type is set to 'foo',
1596 otherwise it will default to $self->{dbh}.  If $self->{dbhs}->{foo} or
1597 $self->{dbh} is a coderef - they will be called and should return a dbh.
1598
1599     {
1600       field => 'username',
1601       sql   => 'SELECT COUNT(*) FROM users WHERE username = ?',
1602       sql_error_if => 1, # default is 1 - set to 0 to negate result
1603       # sql_db_type  => 'foo', # will look for a dbh under $self->{dbhs}->{foo}
1604     }
1605
1606 =item C<type>
1607
1608 Allows for more strict type checking.  Currently supported types
1609 include CC (credit card), EMAIL, DOMAIN, IP, URL.  Other types will be
1610 added upon request provided we can add a perl and a javascript
1611 version.
1612
1613     {
1614       field => 'credit_card',
1615       type  => 'CC',
1616     }
1617
1618 =item C<validate_if>
1619
1620 If validate_if is specified, the field will only be validated
1621 if the conditions are met.  Works in JS.
1622
1623     validate_if => {field => 'name', required => 1, max_len => 30}
1624     # Will only validate if the field "name" is present and is less than 30 chars.
1625
1626     validate_if => 'name',
1627     # SAME as
1628     validate_if => {field => 'name', required => 1},
1629
1630     validate_if => '! name',
1631     # SAME as
1632     validate_if => {field => 'name', max_in_set => '0 of name'},
1633
1634     validate_if => 'name was_valid',
1635     # SAME as
1636     validate_if => {field => 'name', was_valid => 1},
1637
1638     validate_if => {field => 'country', compare => "eq US"},
1639     # only if country's value is equal to US
1640
1641     validate_if => {field => 'country', compare => "ne US"},
1642     # if country doesn't equal US
1643
1644     validate_if => {field => 'password', match => 'm/^md5\([a-z0-9]{20}\)$/'},
1645     # if password looks like md5(12345678901234567890)
1646
1647     {
1648       field       => 'm/^(\w+)_pass/',
1649       validate_if => '$1_user',
1650       required    => 1,
1651     }
1652     # will validate foo_pass only if foo_user was present.
1653
1654 The validate_if may also contain an arrayref of validation items.  So that
1655 multiple checks can be run.  They will be run in order.  validate_if will
1656 return true only if all options returned true.
1657
1658     validate_if => ['email', 'phone', 'fax']
1659
1660 Optionally, if validate_if is an arrayref, it may contain the word
1661 'OR' as a special keyword.  If the item preceding 'OR' fails validation
1662 the item after 'OR' will be tested instead.  If the item preceding 'OR'
1663 passes validation the item after 'OR' will not be tested.
1664
1665     validate_if => [qw(zip OR postalcode)],
1666
1667 =item C<was_valid>
1668
1669 Typically used by a validate_if.  Allows for checking if this item has successfully
1670 been validated.
1671
1672     {
1673        field => 'password2',
1674        validate_if => {field => 'password', was_valid => 1},
1675     }
1676
1677 This is basically the opposite of was_valid.
1678
1679 =back
1680
1681 =head1 SPECIAL VALIDATION TYPES
1682
1683 =over 4
1684
1685 =item C<field>
1686
1687 Specify which field to work on.  Key may be a regex in the form 'm/\w+_user/'.
1688 This key is required if 'group fields' is used or if validate_if or required_if
1689 are used.  It can optionally be used with other types to specify a different form
1690 element to operate on.  On errors, if a non-default error is found, $field
1691 will be swapped with the value found in field.
1692
1693 The field name may also be a regular expression in the
1694 form of 'm/somepattern/'.  If a regular expression is used, all keys
1695 matching that pattern will be validated.
1696
1697 =item C<name>
1698
1699 Name to use for errors.  If a name is not specified, default errors will use
1700 "The field $field" as the name.  If a non-default error is found, $name
1701 will be swapped with this name.
1702
1703 =item C<delegate_error>
1704
1705 This option allows for any errors generated on a field to delegate to
1706 a different field.  If the field name was a regex, any patterns will
1707 be swapped into the delegate_error value. This option is generally only
1708 useful with the as_hash method of the error object (for inline errors).
1709
1710     {
1711       field => 'zip',
1712       match => 'm/^\d{5}/',
1713     },
1714     {
1715       field => 'zip_plus4',
1716       match => 'm/^\d{4}/',
1717       delegate_error => 'zip',
1718     },
1719     {
1720       field => 'm/^(id_[\d+])_user$/',
1721       delegate_error => '$1',
1722     },
1723
1724 =item C<exclude_js>
1725
1726 This allows the cgi to do checking while keeping the checks from
1727 being run in JavaScript
1728
1729     {
1730       field      => 'cgi_var',
1731       required   => 1,
1732       exclude_js => 1,
1733     }
1734
1735 =item C<exclude_cgi>
1736
1737 This allows the js to do checking while keeping the checks from
1738 being run in the cgi
1739
1740     {
1741       field       => 'js_var',
1742       required    => 1,
1743       exclude_cgi => 1,
1744     }
1745
1746 =item C<vif_disable>
1747
1748 Only functions in javascript.  Will mark set the form element to
1749 disabled if validate_if fails.  It will mark it as enabled if
1750 validate_if is successful.  This item should normally only be used
1751 when onevent includes "change" or "blur".
1752
1753 =back
1754
1755 =head1 MODIFYING VALIDATION TYPES
1756
1757 The following types will modify the form value before it is processed.
1758 They work in both the perl and in javascript as well.  The javascript
1759 version changes the actual value in the form on appropriate form types.
1760
1761 =over 4
1762
1763 =item C<do_not_trim>
1764
1765 By default, validate will trim leading and trailing whitespace
1766 from submitted values.  Set do_not_trim to 1 to allow it to
1767 not trim.
1768
1769     {field => 'foo', do_not_trim => 1}
1770
1771 =item C<trim_control_chars>
1772
1773 Off by default.  If set to true, removes characters in the
1774 \x00 to \x31 range (Tabs are translated to a single space).
1775
1776     {field => 'foo', trim_control_chars => 1}
1777
1778 =item C<replace>
1779
1780 Pass a swap pattern to change the actual value of the form.
1781 Any perl regex can be passed but it is suggested that javascript
1782 compatible regexes are used to make generate_js possible.
1783
1784     {field => 'foo', replace => 's/(\d{3})(\d{3})(\d{3})/($1) $2-$3/'}
1785
1786 =item C<default>
1787
1788 Set item to default value if there is no existing value (undefined
1789 or zero length string).
1790
1791     {field => 'country', default => 'EN'}
1792
1793 =item C<to_upper_case> and C<to_lower_case>
1794
1795 Do what they say they do.
1796
1797 =item C<untaint>
1798
1799 Requires that the validated field has been also checked with
1800 an enum, equals, match, compare, custom, or type check.  If the
1801 field has been checked and there are no errors - the field is "untainted."
1802
1803 This is for use in conjunction with perl's -T switch.
1804
1805 =item C<clear_on_error>
1806
1807 Clears the form field should a validation error occur.  Only supported
1808 on the Javascript side (no affect on the server side).
1809
1810 =back
1811
1812 =head1 ERROR OBJECT
1813
1814 Failed validation results in an error an error object created via the
1815 new_error method.  The default error class is CGI::Ex::Validate::Error.
1816
1817 The error object has several methods for determining what the errors were.
1818
1819 =over 4
1820
1821 =item C<as_array>
1822
1823 Returns an array or arrayref (depending on scalar context) of errors that
1824 occurred in the order that they occurred.  Individual groups may have a heading
1825 and the entire validation will have a heading (the default heading can be changed
1826 via the 'as_array_title' group option).  Each error that occurred is a separate
1827 item and are pre-pended with 'as_array_prefix' (which is a group option - default
1828 is '  ').  The as_array_ options may also be set via a hashref passed to as_array.
1829 as_array_title defaults to 'Please correct the following items:'.
1830
1831   ### if this returns the following
1832   my $array = $err_obj->as_array;
1833   # $array looks like
1834   # ['Please correct the following items:', '  error1', '  error2']
1835
1836   ### then this would return the following
1837   my $array = $err_obj->as_array({
1838     as_array_prefix => '  - ',
1839     as_array_title  => 'Something went wrong:',
1840   });
1841   # $array looks like
1842   # ['Something went wrong:', '  - error1', '  - error2']
1843
1844 =item C<as_string>
1845
1846 Returns values of as_array joined with a newline.  This method is used as
1847 the stringification for the error object.  Values of as_array are joined with
1848 'as_string_join' which defaults to "\n".  If 'as_string_header' is set, it will
1849 be pre-pended onto the error string.  If 'as_string_footer' is set, it will be
1850 appended onto the error string.
1851
1852   ### if this returns the following
1853   my $string = $err_obj->as_string;
1854   # $string looks like
1855   # "Please correct the following items:\n  error1\n  error2"
1856
1857   ### then this would return the following
1858   my $string = $err_obj->as_string({
1859     as_array_prefix  => '  - ',
1860     as_array_title   => 'Something went wrong:',
1861     as_string_join   => '<br />',
1862     as_string_header => '<span class="error">',
1863     as_string_footer => '</span>',
1864   });
1865   # $string looks like
1866   # '<span class="error">Something went wrong:<br />  - error1<br />  - error2</span>'
1867
1868 =item C<as_hash>
1869
1870 Returns a hash or hashref (depending on scalar context) of errors that
1871 occurred.  Each key is the field name of the form that failed
1872 validation with 'as_hash_suffix' added on as a suffix.  as_hash_suffix
1873 is available as a group option and may also be passed in via a
1874 hashref as the only argument to as_hash.  The default value is
1875 '_error'.  The values of the hash are arrayrefs of errors that
1876 occurred to that form element.
1877
1878 By default as_hash will return the values of the hash as arrayrefs (a
1879 list of the errors that occurred to that key).  It is possible to also
1880 return the values as strings.  Three options are available for
1881 formatting: 'as_hash_header' which will be pre-pended onto the error
1882 string, 'as_hash_footer' which will be appended, and 'as_hash_join'
1883 which will be used to join the arrayref.  The only argument required
1884 to force the stringification is 'as_hash_join'.
1885
1886   ### if this returns the following
1887   my $hash = $err_obj->as_hash;
1888   # $hash looks like
1889   # {key1_error => ['error1', 'error2']}
1890
1891   ### then this would return the following
1892   my $hash = $err_obj->as_hash({
1893     as_hash_suffix => '_foo',
1894     as_hash_join   => '<br />',
1895     as_hash_header => '<span class="error">'
1896     as_hash_footer => '</span>'
1897   });
1898   # $hash looks like
1899   # {key1_foo => '<span class="error">error1<br />error2</span>'}
1900
1901 =back
1902
1903 =head1 GROUP OPTIONS
1904
1905 Any key in a validation hash matching the pattern
1906 m/^(group|general)\s+(\w+)$/ is considered a group option (the reason
1907 that either group or general may be used is that CGI::Ex::Validate
1908 used to have the concept of validation groups - these were not
1909 commonly used so support has been deprecated as of the 2.10 release).
1910 Group options will also be looked for in the Validate object ($self)
1911 and can be set when instantiating the object ($self->{raise_error} is
1912 equivalent to $valhash->{'group raise_error'}).
1913
1914 Options may also be set globally before calling validate by
1915 populating the %DEFAULT_OPTIONS global hash.  However, only the options
1916 set properly in the $valhash will be passed to the javascript.
1917
1918 =over 4
1919
1920 =item C<title>
1921
1922 Used as a group section heading when as_array or as_string is called
1923 by the error object.
1924
1925     'group title' => 'Title of errors',
1926
1927 =item C<order>
1928
1929 Order in which to validate key/value pairs of group.
1930
1931     'group order' => [qw(user pass email OR phone)],
1932
1933 =item C<fields>
1934
1935 Arrayref of validation items to validate.
1936
1937     'group fields' => [{
1938         field    => 'field1',
1939         required => 1,
1940     }, {
1941         field    => 'field2',
1942         required => 1,
1943     }],
1944
1945 =item C<validate_if>
1946
1947 If specified - the entire hashref will only be validated if
1948 the "if" conditions are met.
1949
1950     'group validate_if => {field => 'email', required => 1},
1951
1952 This group would only validate all fields if the email field
1953 was present.
1954
1955 =item C<raise_error>
1956
1957 If raise_error is true, any call to validate that fails validation
1958 will die with an error object as the value.
1959
1960 =item C<no_extra_fields>
1961
1962 If no_extra_fields is true, validate will add errors for any field found
1963 in form that does not have a field_val hashref in the validation hash.
1964 Default is false.  If no_extra_fields is set to 'used', it will check for
1965 any keys that were not in a group that was validated.
1966
1967 An important exception to this is that field_val hashrefs or field names listed
1968 in a validate_if or required_if statement will not be included.  You must
1969 have an explicit entry for each key.
1970
1971 =item C<\w+_error>
1972
1973 These items allow for an override of the default errors.
1974
1975   'group required_error' => '$name is really required',
1976   'group max_len_error'  => '$name must be shorter than $value characters',
1977     # OR #
1978   my $self = CGI::Ex::Validate->new({
1979     max_len_error => '$name must be shorter than $value characters',
1980   });
1981
1982 =item C<as_array_title>
1983
1984 Used as the section title for all errors that occur, when as_array
1985 or as_string is called by the error object.
1986
1987 =item C<as_array_prefix>
1988
1989 Used as prefix to individual errors that occur, when as_array
1990 or as_string is called by the error object.  Each individual error
1991 will be prefixed with this string.  Headings will not be prefixed.
1992 Default is '  '.
1993
1994 =item C<as_string_join>
1995
1996 When as_string is called, the values from as_array will be joined with
1997 as_string_join.  Default value is "\n".
1998
1999 =item C<as_string_header>
2000
2001 If set, will be pre-pended onto the string when as_string is called.
2002
2003 =item C<as_string_footer>
2004
2005 If set, will be pre-pended onto the string when as_string is called.
2006
2007 =item C<as_hash_suffix>
2008
2009 Added on to key names during the call to as_hash.  Default is '_error'.
2010
2011 =item C<as_hash_join>
2012
2013 By default, as_hash will return hashref values that are errors joined with
2014 the default as_hash_join value of <br />.  It can also return values that are
2015 arrayrefs of the errors.  This can be done by setting as_hash_join to a non-true value
2016 (for example '')
2017
2018 =item C<as_hash_header>
2019
2020 If as_hash_join has been set to a true value, as_hash_header may be set to
2021 a string that will be pre-pended on to the error string.
2022
2023 =item C<as_hash_footer>
2024
2025 If as_hash_join has been set to a true value, as_hash_footer may be set to
2026 a string that will be postpended on to the error string.
2027
2028 =item C<onevent>
2029
2030 Defaults to {submit => 1}.  This controls when the javascript validation
2031 will take place.  May be passed any or all or load, submit, change, or blur.
2032 Multiple events may be passed in the hash.
2033
2034     'group onevent' => {submit => 1, change => 1}',
2035
2036 A comma separated string of types may also be passed:
2037
2038     'group onevent' => 'submit,change,blur,load',
2039
2040 Currently, change and blur will not work for dynamically matched
2041 field names such as 'm/\w+/'.  Support will be added.
2042
2043 =item C<set_hook>
2044
2045 Defaults document.validate_set_hook which defaults to nothing.  If
2046 "group set_hook" or document.validate_set_hook are set to a function,
2047 they will be passed the key name of a form element that had a
2048 validation error and the error that will be set.  If a true value is
2049 returned, then validate will not also the inline error.  If no value
2050 or false is returned (default) the validate will continue setting the
2051 inline error.  This gives full control over setting inline
2052 errors. samples/validate_js_2_onchange.html has a good example of
2053 using these hooks.
2054
2055     'group set_hook' => "function (args) {
2056       alert("Setting error to field "+args.key);
2057     }",
2058
2059 The args parameter includes key, value, val_hash, and form.
2060
2061 The document.validate_set_hook option is probably the better option to use,
2062 as it helps to separate display functionality out into your html templates
2063 rather than storing too much html logic in your CGI.
2064
2065 =item C<clear_hook>
2066
2067 Similar to set_hook, but called when inline error is cleared.  Its
2068 corresponding default is document.validate_clear_hook.  The clear hook
2069 is also sampled in samples/validate_js_2_onchange.html
2070
2071     'group clear_hook' => "function (args) {
2072       alert("Clear error on field "+args.key);
2073     }",
2074
2075 The args parameter includes key, val_hash, form, and was_valid.
2076
2077 =item C<no_inline>
2078
2079 If set to true, the javascript validation will not attempt to generate
2080 inline errors when the only "group onevent" type is "submit".  Default
2081 is true.  Inline errors are independent of confirm and alert errors.
2082
2083     'group no_inline' => 1,
2084
2085 =item C<no_confirm>
2086
2087 If set to true, the javascript validation will try to use an alert
2088 instead of a confirm to inform the user of errors when one of the
2089 "group onevent" types is "submit".  Alert and confirm are independent
2090 or inline errors.  Default is false.
2091
2092     'group no_confirm' => 1,
2093
2094 =item C<no_alert>
2095
2096 If set to true, the javascript validation will not show an alert box
2097 when errors occur.  Default is false.  This option only comes into
2098 play if no_confirm is also set.  This option is only in effect if
2099 "group onevent" includes "submit".  This option is independent of
2100 inline errors.  Although it is possible to turn off all errors by
2101 setting no_inline, no_confirm, and no_alert all to 1, it is suggested
2102 that at least one of the error reporting facilities is left on.
2103
2104     'group no_alert' => 1,
2105
2106 =back
2107
2108 =head1 JAVASCRIPT
2109
2110 CGI::Ex::Validate provides for having duplicate validation on the
2111 client side as on the server side.  Errors can be shown in any
2112 combination of inline and confirm, inline and alert, inline only,
2113 confirm only, alert only, and none.  These combinations are controlled
2114 by the group options no_inline, no_confirm, and no_alert.
2115 Javascript validation can be generated for a page using the
2116 C<-E<gt>generate_js> Method of CGI::Ex::Validate.  It is also possible
2117 to store the validation inline with the html.  This can be done by
2118 giving each of the elements to be validated an attribute called
2119 "validation", or by setting a global javascript variable called
2120 "document.validation" or "var validation".  An html file containing this
2121 validation will be read in using CGI::Ex::Conf::read_handler_html.
2122
2123 All inline html validation must be written in yaml.
2124
2125 It is anticipated that the html will contain something like one of the
2126 following examples:
2127
2128   <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2129   <script>
2130   document.validation = {
2131     'group no_confirm': 1,
2132     'group no_alert':   1,
2133     'group onevent':    'change,blur,submit',
2134     'group order': ['username', 'password'],
2135     username: {
2136       required: 1,
2137       max_len: 20
2138     },
2139     password: {
2140       required: 1,
2141       max_len: 30
2142     }
2143   };
2144   if (document.check_form) document.check_form('my_form_name');
2145   </script>
2146
2147 Prior to the realization of JSON, YAML was part of the method
2148 for introducing validation into the script.
2149
2150   <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
2151   <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2152   <script>
2153   // \n\ allows all browsers to view this as a single string
2154   document.validation = "\n\
2155   general no_confirm: 1\n\
2156   general no_alert: 1\n\
2157   group order: [username, password]\n\
2158   username:\n\
2159     required: 1\n\
2160     max_len: 20\n\
2161   password:\n\
2162     required: 1\n\
2163     max_len: 30\n\
2164   ";
2165   if (document.check_form) document.check_form('my_form_name');
2166   </script>
2167
2168 Alternately, CGI/Ex/validate.js can parse the YAML from html
2169 form element attributes:
2170
2171   <form name="my_form_name">
2172
2173   Username: <input type=text size=20 name=username validation="
2174     required: 1
2175     max_len: 20
2176   "><br>
2177   <span class=error id=username_error>[% username_error %]</span><br>
2178
2179   Password: <input type=text size=20 name=password validation="
2180     required: 1
2181     max_len: 30
2182   "><br>
2183   <span class=error id=password_error>[% password_error %]</span><br>
2184
2185   <input type=submit>
2186
2187   </form>
2188
2189   <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
2190   <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2191   <script>
2192   if (document.check_form) document.check_form('my_form_name');
2193   </script>
2194
2195 The read_handler_html from CGI::Ex::Conf will find the YAML types
2196 of validation.  The JSON type is what would be generated by default
2197 when the validation is specified in Perl.
2198
2199 If inline errors are enabled (default), each error that occurs will attempt
2200 to find an html element with its name as the id.  For example, if
2201 the field "username" failed validation and created a "username_error",
2202 the javascript would set the html of <span id="username_error"></span>
2203 to the error message.
2204
2205 It is suggested to use something like the following so that you can
2206 have inline javascript validation as well as report validation errors
2207 from the server side as well.
2208
2209    <span class=error id=password_error>[% password_error %]</span><br>
2210
2211 If the javascript fails for some reason, the form should still be able
2212 to submit as normal (fail gracefully).
2213
2214 Additionally, there are two hooks that are called when ever an inline
2215 error is set or cleared.  The following hooks are used in
2216 samples/validate_js_2_onchange.html to highlight the row and set an icon.
2217
2218     document.validate_set_hook = function (args) {
2219       document.getElementById(args.key+'_img').innerHTML
2220         = '<span style="font-weight:bold;color:red">!</span>';
2221       document.getElementById(args.key+'_row').style.background
2222         = '#ffdddd';
2223     };
2224
2225     document.validate_clear_hook = function (args) {
2226       if (args.was_valid) {
2227        document.getElementById(args.key+'_img').innerHTML
2228          = '<span style="font-weight:bold;color:green">+</span>';
2229        document.getElementById(args.key+'_row').style.background
2230          = '#ddffdd';
2231       } else {
2232        document.getElementById(args.key+'_img').innerHTML = '';
2233        document.getElementById(args.key+'_row').style.background = '#fff';
2234       }
2235     };
2236
2237 These hooks can also be set as "group clear_hook" and "group set_hook"
2238 which are defined further above.
2239
2240 If the confirm option is used ("group onevent" includes submit and
2241 "group no_confirm" is false), the errors will be displayed to the
2242 user.  If they choose OK they will be able to try and fix the errors.
2243 If they choose cancel, the form will submit anyway and will rely on
2244 the server to do the validation.  This is for fail safety to make sure
2245 that if the javascript didn't validate correctly, the user can still
2246 submit the data.
2247
2248 =head1 THANKS
2249
2250 Thanks to Eamon Daly for providing bug fixes for bugs in validate.js
2251 caused by HTML::Prototype.
2252
2253 =head1 LICENSE
2254
2255 This module may be distributed under the same terms as Perl itself.
2256
2257 =head1 AUTHOR
2258
2259 Paul Seamons <paul at seamons dot com>
2260
2261 =cut