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