]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Validate.pm
2749642b763de75bc73a7a2dd412727195af2379
1 package CGI
::Ex
::Validate
;
5 CGI::Ex::Validate - another form validator - but it does javascript in parallel
9 ###----------------------------------------------------------------###
10 # Copyright 2006 - Paul Seamons #
11 # Distributed under the Perl Artistic License without warranty #
12 ###----------------------------------------------------------------###
28 $QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/;
29 @UNSUPPORTED_BROWSERS = (qr/MSIE\s+5.0\d/i);
33 ###----------------------------------------------------------------###
36 my $class = shift || __PACKAGE__
;
37 my $self = (@_ && ref($_[0])) ? shift : {@_};
39 ### allow for global defaults
40 foreach (keys %DEFAULT_OPTIONS) {
41 $self->{$_} = $DEFAULT_OPTIONS{$_} if ! exists $self->{$_};
44 return bless $self, $class;
47 ###----------------------------------------------------------------###
51 return $self->{cgix
} ||= do {
57 ### the main validation routine
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
66 ### turn the form into a form if it is really a CGI object
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);
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);
78 ### allow for validation passed as single group hash, single group array,
79 ### or array of group hashes or group arrays
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'};
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;
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).
99 foreach (sort keys %$group_val) {
100 /^(group|general)\s+(\w+)/ ? push(@group_keys, [$1, $2, $_]) : push(@field_keys, $_);
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
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
115 push @fields, $field_val;
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 push @$fields, $field_val;
132 ### Finally we have our arrayref of hashrefs that each have their 'field' key
133 ### now lets do the validation
136 my $hold_error; # hold the error for a moment - to allow for an "Or" operation
137 foreach (my $i = 0; $i <= $#$fields; $i ++) {
138 my $ref = $fields->[$i];
139 if (! ref($ref) && $ref eq 'OR') {
140 $i ++ if $found; # if found skip the OR altogether
145 die "Missing field key during normal validation" if ! $ref->{'field'};
146 local $ref->{'was_validated'} = 1;
147 my @err = $self->validate_buddy($form, $ref->{'field'}, $ref);
148 if (delete($ref->{'was_validated'}) && $what_was_validated) {
149 push @$what_was_validated, $ref;
152 ### test the error - if errors occur allow for OR - if OR fails use errors from first fail
154 if ($i < $#$fields && ! ref($fields->[$i + 1]) && $fields->[$i + 1] eq 'OR') {
157 push @errors, $hold_error ? @$hold_error : @err;
164 push(@errors, @$hold_error) if $hold_error; # allow for final OR to work
166 ### add on errors as requested
167 if ($#errors != -1) {
168 push @ERRORS, $title if $title;
169 push @ERRORS, @errors;
172 ### add on general options, and group options if errors in group occurred
173 foreach (@group_keys) {
174 my ($type, $short_key, $full_key) = @$_;
175 next if $type eq 'group' && ($#errors == -1 || $short_key =~ /^(field|order|title)$/);
176 $EXTRA{$short_key} = $group_val->{$full_key};
180 ### store any extra items from self
181 $EXTRA{$_} = $self->{$_} for grep {/$QR_EXTRA/o} keys %$self;
183 ### allow for checking for unused keys
184 if ($EXTRA{no_extra_fields
}) {
185 my $which = ($EXTRA{no_extra_fields
} =~ /used/i) ? 'used' : 'all';
186 my $ref = ($which eq 'all') ? $val_hash : \
@USED_GROUPS;
187 my $keys = $self->get_validation_keys($ref);
188 foreach my $key (sort keys %$form) {
189 next if $keys->{$key};
190 push @ERRORS, [$key, 'no_extra_fields', {}, undef];
194 ### return what they want
195 if ($#ERRORS != -1) {
196 my $err_obj = $self->new_error(\
@ERRORS, \
%EXTRA);
197 die $err_obj if $EXTRA{'raise_error'};
200 return wantarray ? () : undef;
206 return CGI
::Ex
::Validate
::Error-
>new(@_);
209 ### allow for optional validation on groups and on individual items
210 sub check_conditional
{
211 my ($self, $form, $ifs, $N_level, $ifs_match) = @_;
214 $N_level ++; # prevent too many recursive checks
216 ### can pass a single hash - or an array ref of hashes
218 die "Need reference passed to check_conditional";
219 } elsif (! ref($ifs)) {
221 } elsif (UNIVERSAL
::isa
($ifs,'HASH')) {
225 ### run the if options here
226 ### multiple items can be passed - all are required unless OR is used to separate
228 foreach (my $i = 0; $i <= $#$ifs; $i ++) {
229 my $ref = $ifs->[$i];
232 $i ++ if $found; # if found skip the OR altogether
236 if ($ref =~ s/^\s*!\s*//) {
237 $ref = {field
=> $ref, max_in_set
=> "0 of $ref"};
239 $ref = {field
=> $ref, required
=> 1};
245 ### get the field - allow for custom variables based upon a match
246 my $field = $ref->{'field'} || die "Missing field key during validate_if (possibly used a reference to a main hash *foo -> &foo)";
247 $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
249 my @err = $self->validate_buddy($form, $field, $ref, $N_level);
250 $found = 0 if scalar @err;
256 ### this is where the main checking goes on
259 my ($form, $field, $field_val, $N_level, $ifs_match) = @_;
261 $N_level ++; # prevent too many recursive checks
262 die "Max dependency level reached $N_level" if $N_level > 10;
265 my $types = [sort keys %$field_val];
267 ### allow for not running some tests in the cgi
268 if ($field_val->{'exclude_cgi'}) {
269 delete $field_val->{'was_validated'};
270 return wantarray ? @errors : $#errors + 1;
273 ### allow for field names that contain regular expressions
274 if ($field =~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) {
275 my ($not,$pat,$opt) = ($1,$3,$4);
277 die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/;
278 foreach my $_field (sort keys %$form) {
279 next if ($not && $_field =~ m/(?$opt:$pat)/) || (! $not && $_field !~ m/(?$opt:$pat)/);
280 my @match = (undef, $1, $2, $3, $4, $5); # limit to the matches
281 push @errors, $self->validate_buddy($form, $_field, $field_val, $N_level, \
@match);
283 return wantarray ? @errors : $#errors + 1;
286 my $values = UNIVERSAL
::isa
($form->{$field},'ARRAY') ? $form->{$field} : [$form->{$field}];
287 my $n_values = $#$values + 1;
289 ### allow for default value
290 if (exists $field_val->{'default'}) {
291 if ($n_values == 0 || ($n_values == 1 && (! defined($values->[0]) || ! length($values->[0])))) {
292 $form->{$field} = $values->[0] = $field_val->{'default'};
296 ### allow for a few form modifiers
298 foreach my $value (@$values) {
299 next if ! defined $value;
300 if (! $field_val->{'do_not_trim'}) { # whitespace
305 if ($field_val->{'to_upper_case'}) { # uppercase
308 } elsif ($field_val->{'to_lower_case'}) { # lowercase
313 # allow for inline specified modifications (ie s/foo/bar/)
314 foreach my $type (grep {/^replace_?\d*$/} @$types) {
315 my $ref = UNIVERSAL
::isa
($field_val->{$type},'ARRAY') ? $field_val->{$type}
316 : [split(/\s*\|\|\s*/,$field_val->{$type})];
317 foreach my $rx (@$ref) {
318 if ($rx !~ m/^\s*s([^\s\w])(.+)\1(.*)\1([eigsmx]*)$/s) {
319 die "Not sure how to parse that replace ($rx)";
321 my ($pat, $swap, $opt) = ($2, $3, $4);
322 die "The e option cannot be used in swap on field $field" if $opt =~ /e/;
323 my $global = $opt =~ s/g//g;
326 foreach my $value (@$values) {
327 $value =~ s
{(?$opt:$pat)}{
328 my @match = (undef, $1, $2, $3, $4, $5, $6); # limit on the number of matches
330 $copy =~ s/\$(\d+)/defined($match[$1]) ? $match[$1] : ""/ge;
332 $copy; # return of the swap
336 foreach my $value (@$values) {
337 $value =~ s
{(?$opt:$pat)}{
338 my @match = (undef, $1, $2, $3, $4, $5, $6); # limit on the number of matches
340 $copy =~ s/\$(\d+)/defined($match[$1]) ? $match[$1] : ""/ge;
342 $copy; # return of the swap
348 ### put them back into the form if we have modified it
350 if ($n_values == 1) {
351 $form->{$field} = $values->[0];
352 $self->{cgi_object
}->param(-name
=> $field, -value
=> $values->[0])
353 if $self->{cgi_object
};
355 ### values in @{ $form->{$field} } were modified directly
356 $self->{cgi_object
}->param(-name
=> $field, -value
=> $values)
357 if $self->{cgi_object
};
361 ### only continue if a validate_if is not present or passes test
364 foreach my $type (grep {/^validate_if_?\d*$/} @$types) {
366 my $ifs = $field_val->{$type};
367 my $ret = $self->check_conditional($form, $ifs, $N_level, $ifs_match);
368 $needs_val ++ if $ret;
370 if (! $needs_val && $n_vif) {
371 delete $field_val->{'was_validated'};
372 return wantarray ? @errors : $#errors + 1;
375 ### check for simple existence
376 ### optionally check only if another condition is met
377 my $is_required = $field_val->{'required'} ? 'required' : '';
378 if (! $is_required) {
379 foreach my $type (grep {/^required_if_?\d*$/} @$types) {
380 my $ifs = $field_val->{$type};
381 next if ! $self->check_conditional($form, $ifs, $N_level, $ifs_match);
382 $is_required = $type;
387 && ($n_values == 0 || ($n_values == 1 && (! defined($values->[0]) || ! length $values->[0])))) {
388 return 1 if ! wantarray;
389 push @errors, [$field, $is_required, $field_val, $ifs_match];
394 my $n = exists($field_val->{'min_values'}) ? $field_val->{'min_values'} || 0 : 0;
395 if ($n_values < $n) {
396 return 1 if ! wantarray;
397 push @errors, [$field, 'min_values', $field_val, $ifs_match];
402 $field_val->{'max_values'} = 1 if ! exists $field_val->{'max_values'};
403 $n = $field_val->{'max_values'} || 0;
404 if ($n_values > $n) {
405 return 1 if ! wantarray;
406 push @errors, [$field, 'max_values', $field_val, $ifs_match];
410 ### max_in_set and min_in_set checks
411 my @min = grep {/^min_in_set_?\d*$/} @$types;
412 my @max = grep {/^max_in_set_?\d*$/} @$types;
413 foreach ([min
=> \
@min],
415 my ($minmax, $keys) = @$_;
416 foreach my $type (@$keys) {
417 $field_val->{$type} =~ m/^\s*(\d+)(?i:\s*of)?\s+(.+)\s*$/
418 || die "Invalid in_set check $field_val->{$type}";
420 foreach my $_field (split /[\s,]+/, $2) {
421 my $ref = UNIVERSAL
::isa
($form->{$_field},'ARRAY') ? $form->{$_field} : [$form->{$_field}];
422 foreach my $_value (@$ref) {
423 $n -- if defined($_value) && length($_value);
426 if ( ($minmax eq 'min' && $n > 0)
427 || ($minmax eq 'max' && $n < 0)) {
428 return 1 if ! wantarray;
429 push @errors, [$field, $type, $field_val, $ifs_match];
435 ### at this point @errors should still be empty
436 my $content_checked; # allow later for possible untainting (only happens if content was checked)
438 ### loop on values of field
439 foreach my $value (@$values) {
441 ### allow for enum types
442 if (exists $field_val->{'enum'}) {
443 my $ref = ref($field_val->{'enum'}) ? $field_val->{'enum'} : [split(/\s*\|\|\s*/,$field_val->{'enum'})];
446 $found = 1 if defined($value) && $_ eq $value;
449 return 1 if ! wantarray;
450 push @errors, [$field, 'enum', $field_val, $ifs_match];
452 $content_checked = 1;
455 ### field equality test
456 foreach my $type (grep {/^equals_?\d*$/} @$types) {
457 my $field2 = $field_val->{$type};
458 my $not = ($field2 =~ s/^!\s*//) ? 1 : 0;
460 if ($field2 =~ m/^([\"\'])(.*)\1$/) {
462 $success = (defined($value) && $value eq $test);
463 } elsif (exists($form->{$field2}) && defined($form->{$field2})) {
464 $success = (defined($value) && $value eq $form->{$field2});
465 } elsif (! defined($value)) {
466 $success = 1; # occurs if they are both undefined
468 if ($not ? $success : ! $success) {
469 return 1 if ! wantarray;
470 push @errors, [$field, $type, $field_val, $ifs_match];
472 $content_checked = 1;
476 if (exists $field_val->{'min_len'}) {
477 my $n = $field_val->{'min_len'};
478 if (! defined($value) || length($value) < $n) {
479 return 1 if ! wantarray;
480 push @errors, [$field, 'min_len', $field_val, $ifs_match];
485 if (exists $field_val->{'max_len'}) {
486 my $n = $field_val->{'max_len'};
487 if (defined($value) && length($value) > $n) {
488 return 1 if ! wantarray;
489 push @errors, [$field, 'max_len', $field_val, $ifs_match];
493 ### now do match types
494 foreach my $type (grep {/^match_?\d*$/} @$types) {
495 my $ref = UNIVERSAL
::isa
($field_val->{$type},'ARRAY') ? $field_val->{$type}
496 : UNIVERSAL
::isa
($field_val->{$type}, 'Regexp') ? [$field_val->{$type}]
497 : [split(/\s*\|\|\s*/,$field_val->{$type})];
498 foreach my $rx (@$ref) {
499 if (UNIVERSAL
::isa
($rx,'Regexp')) {
500 if (! defined($value) || $value !~ $rx) {
501 push @errors, [$field, $type, $field_val, $ifs_match];
504 if ($rx !~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) {
505 die "Not sure how to parse that match ($rx)";
507 my ($not,$pat,$opt) = ($1,$3,$4);
509 die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/;
510 if ( ( $not && ( defined($value) && $value =~ m/(?$opt:$pat)/))
511 || (! $not && (! defined($value) || $value !~ m/(?$opt:$pat)/))
513 return 1 if ! wantarray;
514 push @errors, [$field, $type, $field_val, $ifs_match];
518 $content_checked = 1;
521 ### allow for comparison checks
522 foreach my $type (grep {/^compare_?\d*$/} @$types) {
523 my $ref = UNIVERSAL
::isa
($field_val->{$type},'ARRAY') ? $field_val->{$type}
524 : [split(/\s*\|\|\s*/,$field_val->{$type})];
525 foreach my $comp (@$ref) {
528 if ($comp =~ /^\s*(>|<|[><!=]=)\s*([\d\.\-]+)\s*$/) {
529 my $val = $value || 0;
531 if ($1 eq '>' ) { $test = ($val > $2) }
532 elsif ($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) }
538 } elsif ($comp =~ /^\s*(eq|ne|gt|ge|lt|le)\s+(.+?)\s*$/) {
539 my $val = defined($value) ? $value : '';
540 my ($op, $value2) = ($1, $2);
541 $value2 =~ s/^([\"\'])(.*)\1$/$2/;
542 if ($op eq 'gt') { $test = ($val gt $value2) }
543 elsif ($op eq 'lt') { $test = ($val lt $value2) }
544 elsif ($op eq 'ge') { $test = ($val ge $value2) }
545 elsif ($op eq 'le') { $test = ($val le $value2) }
546 elsif ($op eq 'ne') { $test = ($val ne $value2) }
547 elsif ($op eq 'eq') { $test = ($val eq $value2) }
550 die "Not sure how to compare \"$comp\"";
553 return 1 if ! wantarray;
554 push @errors, [$field, $type, $field_val, $ifs_match];
557 $content_checked = 1;
560 ### server side sql type
561 foreach my $type (grep {/^sql_?\d*$/} @$types) {
562 my $db_type = $field_val->{"${type}_db_type"};
563 my $dbh = ($db_type) ? $self->{dbhs
}->{$db_type} : $self->{dbh
};
565 die "Missing dbh for $type type on field $field" . ($db_type ? " and db_type $db_type" : "");
566 } elsif (UNIVERSAL
::isa
($dbh,'CODE')) {
567 $dbh = &$dbh($field, $self) || die "SQL Coderef did not return a dbh";
569 my $sql = $field_val->{$type};
570 my @args = ($value) x
$sql =~ tr/?//;
571 my $return = $dbh->selectrow_array($sql, {}, @args); # is this right - copied from O::FORMS
572 $field_val->{"${type}_error_if"} = 1 if ! defined $field_val->{"${type}_error_if"};
573 if ( (! $return && $field_val->{"${type}_error_if"})
574 || ($return && ! $field_val->{"${type}_error_if"}) ) {
575 return 1 if ! wantarray;
576 push @errors, [$field, $type, $field_val, $ifs_match];
578 $content_checked = 1;
581 ### server side custom type
582 foreach my $type (grep {/^custom_?\d*$/} @$types) {
583 my $check = $field_val->{$type};
584 next if UNIVERSAL
::isa
($check, 'CODE') ? &$check($field, $value, $field_val, $type) : $check;
585 return 1 if ! wantarray;
586 push @errors, [$field, $type, $field_val, $ifs_match];
587 $content_checked = 1;
590 ### do specific type checks
591 foreach my $type (grep {/^type_?\d*$/} @$types) {
592 if (! $self->check_type($value,$field_val->{'type'},$field,$form)){
593 return 1 if ! wantarray;
594 push @errors, [$field, $type, $field_val, $ifs_match];
596 $content_checked = 1;
600 ### allow for the data to be "untainted"
601 ### this is only allowable if the user ran some other check for the datatype
602 if ($field_val->{'untaint'} && $#errors == -1) {
603 if (! $content_checked) {
604 push @errors, [$field, 'untaint', $field_val, $ifs_match];
606 ### generic untainter - assuming the other required content_checks did good validation
607 $_ = /(.*)/ ? $1 : die "Couldn't match?" foreach @$values;
608 if ($n_values == 1) {
609 $form->{$field} = $values->[0];
610 $self->{cgi_object
}->param(-name
=> $field, -value
=> $values->[0])
611 if $self->{cgi_object
};
613 ### values in @{ $form->{$field} } were modified directly
614 $self->{cgi_object
}->param(-name
=> $field, -value
=> $values)
615 if $self->{cgi_object
};
620 ### all done - time to return
621 return wantarray ? @errors : $#errors + 1;
624 ###----------------------------------------------------------------###
626 ### used to validate specific types
630 my $type = uc(shift);
632 ### do valid email address for our system
633 if ($type eq 'EMAIL') {
634 return 0 if ! $value;
635 my($local_p,$dom) = ($value =~ /^(.+)\@(.+?)$/) ? ($1,$2) : return 0;
637 return 0 if length($local_p) > 60;
638 return 0 if length($dom) > 100;
639 return 0 if ! $self->check_type($dom,'DOMAIN') && ! $self->check_type($dom,'IP');
640 return 0 if ! $self->check_type($local_p,'LOCAL_PART');
642 ### the "username" portion of an email address
643 } elsif ($type eq 'LOCAL_PART') {
644 return 0 if ! defined($value) || ! length($value);
645 return 0 if $value =~ m/[^a-z0-9.\-!&+]/;
646 return 0 if $value =~ m/^[\.\-]/;
647 return 0 if $value =~ m/[\.\-\&]$/;
648 return 0 if $value =~ m/(\.\-|\-\.|\.\.)/;
650 ### standard IP address
651 } elsif ($type eq 'IP') {
652 return 0 if ! $value;
653 return (4 == grep {!/\D/ && $_ < 256} split /\./, $value, 4);
655 ### domain name - including tld and subdomains (which are all domains)
656 } elsif ($type eq 'DOMAIN') {
657 return 0 if ! $value;
658 return 0 if $value =~ m/[^a-z0-9.\-]/;
659 return 0 if $value =~ m/^[\.\-]/;
660 return 0 if $value =~ m/(\.\-|\-\.|\.\.)/;
661 return 0 if length($value) > 255;
662 return 0 if $value !~ s/\.([a-z]+)$//;
665 if ($ext eq 'name') { # .name domains
666 return 0 if $value !~ /^[a-z0-9][a-z0-9\-]{0,62} \. [a-z0-9][a-z0-9\-]{0,62}$/x;
667 } else { # any other domains
668 return 0 if $value !~ /^([a-z0-9][a-z0-9\-]{0,62} \.)* [a-z0-9][a-z0-9\-]{0,62}$/x;
672 } elsif ($type eq 'URL') {
673 return 0 if ! $value;
674 $value =~ s
|^https
?://([^/]+)||i
|| return 0;
676 return 0 if ! $self->check_type($dom,'DOMAIN') && ! $self->check_type($dom,'IP');
677 return 0 if $value && ! $self->check_type($value,'URI');
679 ### validate a uri - the path portion of a request
680 } elsif ($type eq 'URI') {
681 return 0 if ! $value;
682 return 0 if $value =~ m/\s+/;
684 } elsif ($type eq 'CC') {
685 return 0 if ! $value;
686 ### validate the number
687 return 0 if $value =~ /[^\d\-\ ]/
688 || length($value) > 16
689 || length($value) < 13;
691 ### simple mod10 check
695 foreach my $digit ( reverse split //, $value ){
696 $switch = 1 if ++ $switch > 2;
697 my $y = $digit * $switch;
701 return 0 if $sum % 10;
708 ###----------------------------------------------------------------###
713 return CGI
::Ex
::Conf
::conf_read
($val, {html_key
=> 'validation', default_ext
=> $DEFAULT_EXT});
716 ### returns all keys from all groups - even if group has validate_if
717 sub get_validation_keys
{
719 my $val_hash = shift;
720 my $form = shift; # with optional form - will only return keys in validated groups
723 ### if a form was passed - make sure it is a hashref
726 die "Invalid form hash or cgi object";
727 } elsif(! UNIVERSAL
::isa
($form,'HASH')) {
729 $form = CGI
::Ex-
>new->get_form($form);
733 my $refs = $self->get_validation($val_hash);
734 $refs = [$refs] if ! UNIVERSAL
::isa
($refs,'ARRAY');
735 foreach my $group_val (@$refs) {
736 die "Group found that was not a hashref" if ! UNIVERSAL
::isa
($group_val, 'HASH');
738 ### if form is passed, check to see if the group passed validation
740 my $validate_if = $group_val->{'group validate_if'};
741 next if $validate_if && ! $self->check_conditional($form, $validate_if);
744 if ($group_val->{"group fields"}) {
745 die "Group fields must be an arrayref" if ! UNIVERSAL
::isa
($group_val->{"group fields"}, 'ARRAY');
746 foreach my $field_val (@{ $group_val->{"group fields"} }) {
747 next if ! ref($field_val) && $field_val eq 'OR';
748 die "Field_val must be a hashref" if ! UNIVERSAL
::isa
($field_val, 'HASH');
749 my $key = $field_val->{'field'} || die "Missing field key in field_val hashref";
750 $keys{$key} = $field_val->{'name'} || 1;
752 } elsif ($group_val->{"group order"}) {
753 die "Group order must be an arrayref" if ! UNIVERSAL
::isa
($group_val->{"group order"}, 'ARRAY');
754 foreach my $key (@{ $group_val->{"group order"} }) {
755 my $field_val = $group_val->{$key};
756 next if ! $field_val && $key eq 'OR';
757 die "Field_val for $key must be a hashref" if ! UNIVERSAL
::isa
($field_val, 'HASH');
758 $key = $field_val->{'field'} if $field_val->{'field'};
759 $keys{$key} = $field_val->{'name'} || 1;
764 foreach my $key (keys %$group_val) {
765 next if $key =~ /^(general|group)\s/;
766 my $field_val = $group_val->{$key};
767 next if ! UNIVERSAL
::isa
($field_val, 'HASH');
768 $keys{$key} = $field_val->{'name'} || 1;
775 ###----------------------------------------------------------------###
777 ### spit out a chunk that will do the validation
779 ### allow for some browsers to not receive the validation js
780 return "<!-- JS validation not supported in this browser $_ -->"
781 if $ENV{'HTTP_USER_AGENT'} && grep {$ENV{'HTTP_USER_AGENT'} =~ $_} @UNSUPPORTED_BROWSERS;
784 my $val_hash = shift || die "Missing validation";
785 my $form_name = shift || die "Missing form name";
786 my $js_uri_path = shift || $JS_URI_PATH;
787 $val_hash = $self->get_validation($val_hash);
789 ### store any extra items from self
791 $EXTRA{"general $_"} = $self->{$_} for grep {/$QR_EXTRA/o} keys %$self; # add 'general' to be used in javascript
793 my $js_uri_path_validate = $JS_URI_PATH_VALIDATE || do {
794 die "Missing \$js_uri_path" if ! $js_uri_path;
795 "$js_uri_path/CGI/Ex/validate.js";
798 if (eval { require JSON
}) {
799 my $json = JSON-
>new(pretty
=> 1)->objToJson($val_hash);
801 return qq{<script src="$js_uri_path_validate"></script>
803 document.validation = $json;
804 if (document.check_form) document.check_form("$form_name");
808 } elsif (eval { require YAML
}) {
810 my $str = YAML
::Dump
((scalar keys %EXTRA) ? (\
%EXTRA) : () , $val_hash);
811 $str =~ s/(?<!\\)\\(?=[sSdDwWbB0-9?.*+|\-\^\${}()\[\]])/\\\\/g; # fix some issues with YAML
812 $str =~ s/\n/\\n\\\n/g; # allow for one big string that flows on multiple lines
813 $str =~ s/\"/\\\"/g; # quotify it
816 my $js_uri_path_yaml = $JS_URI_PATH_YAML || do {
817 die "Missing \$js_uri_path" if ! $js_uri_path;
818 "$js_uri_path/CGI/Ex/yaml_load.js";
821 ### return the string
822 return qq{<script src="$js_uri_path_yaml"></script>
823 <script src="$js_uri_path_validate"></script>
825 document.validation = "$str";
826 if (document.check_form) document.check_form("$form_name");
830 return '<!-- no JSON or YAML support found for JS validation -->';
834 ###----------------------------------------------------------------###
835 ### How to handle errors
837 package CGI
::Ex
::Validate
::Error
;
840 use overload
'""' => \
&as_string
;
843 my $class = shift || __PACKAGE__
;
845 my $extra = shift || {};
846 die "Missing or invalid arrayref" if ! UNIVERSAL
::isa
($errors, 'ARRAY');
847 die "Missing or invalid hashref" if ! UNIVERSAL
::isa
($extra, 'HASH');
848 return bless {errors
=> $errors, extra
=> $extra}, $class;
853 my $extra = $self->{extra
} || {};
854 my $extra2 = shift || {};
856 ### allow for formatting
857 my $join = defined($extra2->{as_string_join
}) ? $extra2->{as_string_join
}
858 : defined($extra->{as_string_join
}) ? $extra->{as_string_join
}
860 my $header = defined($extra2->{as_string_header
}) ? $extra2->{as_string_header
}
861 : defined($extra->{as_string_header
}) ? $extra->{as_string_header
} : "";
862 my $footer = defined($extra2->{as_string_footer
}) ? $extra2->{as_string_footer
}
863 : defined($extra->{as_string_footer
}) ? $extra->{as_string_footer
} : "";
865 return $header . join($join, @{ $self->as_array($extra2) }) . $footer;
868 ### return an array of applicable errors
871 my $errors = $self->{errors
} || die "Missing errors";
872 my $extra = $self->{extra
} || {};
873 my $extra2 = shift || {};
875 my $title = defined($extra2->{as_array_title
}) ? $extra2->{as_array_title
}
876 : defined($extra->{as_array_title
}) ? $extra->{as_array_title
}
877 : "Please correct the following items:";
879 ### if there are heading items then we may end up needing a prefix
891 my $prefix = defined($extra2->{as_array_prefix
}) ? $extra2->{as_array_prefix
}
892 : defined($extra->{as_array_prefix
}) ? $extra->{as_array_prefix
}
893 : $has_headings ? ' ' : '';
895 ### get the array ready
897 push @array, $title if length $title;
901 foreach my $err (@$errors) {
906 my $text = $self->get_error_text($err);
907 next if $found{$text};
909 push @array, "$prefix$text";
916 ### return a hash of applicable errors
919 my $errors = $self->{errors
} || die "Missing errors";
920 my $extra = $self->{extra
} || {};
921 my $extra2 = shift || {};
923 my $suffix = defined($extra2->{as_hash_suffix
}) ? $extra2->{as_hash_suffix
}
924 : defined($extra->{as_hash_suffix
}) ? $extra->{as_hash_suffix
} : '_error';
925 my $join = defined($extra2->{as_hash_join
}) ? $extra2->{as_hash_join
}
926 : defined($extra->{as_hash_join
}) ? $extra->{as_hash_join
} : '<br />';
928 ### now add to the hash
931 foreach my $err (@$errors) {
934 my ($field, $type, $field_val, $ifs_match) = @$err;
935 die "Missing field name" if ! $field;
936 if ($field_val->{delegate_error
}) {
937 $field = $field_val->{delegate_error
};
938 $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
941 my $text = $self->get_error_text($err);
942 next if $found{$field}->{$text};
943 $found{$field}->{$text} = 1;
946 $return{$field} ||= [];
947 $return{$field} = [$return{$field}] if ! ref($return{$field});
948 push @{ $return{$field} }, $text;
951 ### allow for elements returned as
953 my $header = defined($extra2->{as_hash_header
}) ? $extra2->{as_hash_header
}
954 : defined($extra->{as_hash_header
}) ? $extra->{as_hash_header
} : "";
955 my $footer = defined($extra2->{as_hash_footer
}) ? $extra2->{as_hash_footer
}
956 : defined($extra->{as_hash_footer
}) ? $extra->{as_hash_footer
} : "";
957 foreach my $key (keys %return) {
958 $return{$key} = $header . join($join,@{ $return{$key} }) . $footer;
965 ### return a user friendly error message
969 my $extra = $self->{extra
} || {};
970 my ($field, $type, $field_val, $ifs_match) = @$err;
971 my $dig = ($type =~ s/(_?\d+)$//) ? $1 : '';
972 my $type_lc = lc($type);
974 ### allow for delegated field names - only used for defaults
975 if ($field_val->{delegate_error
}) {
976 $field = $field_val->{delegate_error
};
977 $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
980 ### the the name of this thing
981 my $name = $field_val->{'name'} || "The field $field";
982 $name =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
984 ### type can look like "required" or "required2" or "required100023"
985 ### allow for fallback from required100023_error through required_error
986 my @possible_error_keys = ("${type}_error");
987 unshift @possible_error_keys, "${type}${dig}_error" if length($dig);
989 ### look in the passed hash or self first
991 foreach my $key (@possible_error_keys){
992 $return = $field_val->{$key} || $extra->{$key} || next;
993 $return =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
994 $return =~ s/\$field/$field/g;
995 $return =~ s/\$name/$name/g;
996 if (my $value = $field_val->{"$type$dig"}) {
997 $return =~ s/\$value/$value/g if ! ref $value;
1002 ### set default messages
1004 if ($type eq 'required' || $type eq 'required_if') {
1005 $return = "$name is required.";
1007 } elsif ($type eq 'min_values') {
1008 my $n = $field_val->{"min_values${dig}"};
1009 my $values = ($n == 1) ? 'value' : 'values';
1010 $return = "$name had less than $n $values.";
1012 } elsif ($type eq 'max_values') {
1013 my $n = $field_val->{"max_values${dig}"};
1014 my $values = ($n == 1) ? 'value' : 'values';
1015 $return = "$name had more than $n $values.";
1017 } elsif ($type eq 'enum') {
1018 $return = "$name is not in the given list.";
1020 } elsif ($type eq 'equals') {
1021 my $field2 = $field_val->{"equals${dig}"};
1022 my $name2 = $field_val->{"equals${dig}_name"} || "the field $field2";
1023 $name2 =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
1024 $return = "$name did not equal $name2.";
1026 } elsif ($type eq 'min_len') {
1027 my $n = $field_val->{"min_len${dig}"};
1028 my $char = ($n == 1) ? 'character' : 'characters';
1029 $return = "$name was less than $n $char.";
1031 } elsif ($type eq 'max_len') {
1032 my $n = $field_val->{"max_len${dig}"};
1033 my $char = ($n == 1) ? 'character' : 'characters';
1034 $return = "$name was more than $n $char.";
1036 } elsif ($type eq 'max_in_set') {
1037 my $set = $field_val->{"max_in_set${dig}"};
1038 $return = "Too many fields were chosen from the set ($set)";
1040 } elsif ($type eq 'min_in_set') {
1041 my $set = $field_val->{"min_in_set${dig}"};
1042 $return = "Not enough fields were chosen from the set ($set)";
1044 } elsif ($type eq 'match') {
1045 $return = "$name contains invalid characters.";
1047 } elsif ($type eq 'compare') {
1048 $return = "$name did not fit comparison.";
1050 } elsif ($type eq 'sql') {
1051 $return = "$name did not match sql test.";
1053 } elsif ($type eq 'custom') {
1054 $return = "$name did not match custom test.";
1056 } elsif ($type eq 'type') {
1057 my $_type = $field_val->{"type${dig}"};
1058 $return = "$name did not match type $_type.";
1060 } elsif ($type eq 'untaint') {
1061 $return = "$name cannot be untainted without one of the following checks: enum, equals, match, compare, sql, type, custom";
1063 } elsif ($type eq 'no_extra_fields') {
1064 $return = "$name should not be passed to validate.";
1068 die "Missing error on field $field for type $type$dig" if ! $return;
1073 ###----------------------------------------------------------------###
1082 use CGI::Ex::Validate;
1086 my $errobj = CGI::Ex::Validate->new->validate($form, $val_hash);
1090 my $form = CGI->new;
1092 my $form = CGI::Ex->new; # OR CGI::Ex->get_form;
1094 my $form = {key1 => 'val1', key2 => 'val2'};
1102 field => 'username',
1103 # field is optional in this case - will use key name
1110 validate_if => 'email',
1117 'group order' => [qw(username email email2)],
1118 username => {required => 1, max_len => 30},
1125 'group fields' => [{
1126 field => 'username', # field is not optional in this case
1135 validate_if => 'email',
1141 my $vob = CGI::Ex::Validate->new;
1142 my $errobj = $vob->validate($form, $val_hash);
1144 my $errobj = $vob->validate($form, "/somefile/somewhere.val"); # import config using yaml file
1146 my $errobj = $vob->validate($form, "/somefile/somewhere.pl"); # import config using perl file
1148 my $errobj = $vob->validate($form, "--- # a yaml document\n"); # import config using yaml str
1152 my $error_heading = $errobj->as_string; # OR "$errobj";
1153 my $error_list = $errobj->as_array; # ordered list of what when wrong
1154 my $error_hash = $errobj->as_hash; # hash of arrayrefs of errors
1156 # form passed validation
1159 ### will add an error for any form key not found in $val_hash
1160 my $vob = CGI::Ex::Validate->new({no_extra_keys => 1});
1161 my $errobj = $vob->validate($form, $val_hash);
1165 CGI::Ex::Validate is one of many validation modules. It aims to have
1166 all of the basic data validation functions, avoid adding all of the
1167 millions of possible types, while still giving the capability for the
1168 developer to add their own types.
1170 CGI::Ex::Validate can work in a simple way like all of the other
1171 validators do. However, it also allows for grouping of validation
1172 items and conditional validation of groups or individual items. This
1173 is more in line with the normal validation procedures for a website.
1175 It also has full support for providing the same validation in javascript.
1176 It provides methods for attaching the javascript to existing forms.
1184 Used to instantiate the object. Arguments are either a hash, or hashref,
1185 or nothing at all. Keys of the hash become the keys of the object.
1187 =item C<get_validation>
1189 Given a filename or YAML string will return perl hash. If more than one
1190 group is contained in the file, it will return an arrayref of hashrefs.
1192 my $ref = $self->get_validation($file);
1194 =item C<get_validation_keys>
1196 Given a filename or YAML string or a validation hashref, will return all
1197 of the possible keys found in the validation hash. This can be used to
1198 check to see if extra items have been passed to validate. If a second
1199 argument contains a form hash is passed, get_validation_keys will only
1200 return the keys of groups that were validated.
1202 my $key_hashref = $self->get_validation_keys($val_hash);
1204 The values of the hash are the names of the fields.
1208 Arguments are a form hashref or cgi object, a validation hashref or
1209 filename, and an optional what_was_validated arrayref. If a CGI
1210 object is passed, CGI::Ex::get_form will be called on that object to
1211 turn it into a hashref. If a filename is given for the validation,
1212 get_validation will be called on that filename. If the
1213 what_was_validated_arrayref is passed - it will be populated (pushed)
1214 with the field hashes that were actually validated (anything that was
1215 skipped because of validate_if will not be in the array).
1217 If the form passes validation, validate will return undef. If it
1218 fails validation, it will return a CGI::Ex::Validate::Error object.
1219 If the 'raise_error' general option has been set, validate will die
1220 with a CGI::Ex::validate::Error object as the value.
1222 my $err_obj = $self->validate($form, $val_hash);
1226 $self->{raise_error} = 1; # raise error can also be listed in the
1227 val_hash eval { $self->validate($form, $val_hash) }; if ($@) { my
1230 =item C<generate_js>
1232 Requires JSON or YAML to work properly (see L<JSON> or L<YAML>).
1234 Takes a validation hash, a form name, and an optional javascript uri
1235 path and returns Javascript that can be embedded on a page and will
1236 perform identical validations as the server side. The validation can
1237 be any validation hash (or arrayref of hashes. The form name must be
1238 the name of the form that the validation will act upon - the name is
1239 used to register an onsubmit function. The javascript uri path is
1240 used to embed the locations two external javascript source files.
1243 The javascript uri path is highly dependent upon the server
1244 configuration and therefore must be configured manually. It may be
1245 passed to generate_js, or it may be specified in $JS_URI_PATH. There
1246 are two files included with this module that are needed -
1247 CGI/Ex/yaml_load.js and CGI/Ex/validate.js. When generating the js
1248 code, generate_js will look in $JS_URI_PATH_YAML and
1249 $JS_URI_PATH_VALIDATE. If either of these are not set, generate_js
1250 will default to "$JS_URI_PATH/CGI/Ex/yaml_load.js" and
1251 "$JS_URI_PATH/CGI/Ex/validate.js".
1253 $self->generate_js($val_hash, 'my_form', "/cgi-bin/js")
1255 # would generate something like the following...
1257 <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
1258 <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
1259 ... more js follows ...
1261 $CGI::Ex::Validate::JS_URI_PATH = "/stock/js";
1262 $CGI::Ex::Validate::JS_URI_PATH_YAML = "/js/yaml_load.js";
1263 $self->generate_js($val_hash, 'my_form')
1265 # would generate something like the following...
1267 <script src="/js/yaml_load.js"></script>
1268 <script src="/stock/js/CGI/Ex/validate.js"></script>
1269 ... more js follows ...
1271 Referencing yaml_load.js and validate.js can be done in any of
1272 several ways. They can be copied to or symlinked to a fixed location
1273 in the servers html directory. They can also be printed out by a cgi.
1274 The method C<-E<gt>print_js> has been provided in CGI::Ex for printing
1275 js files found in the perl hierarchy. See L<CGI::Ex> for more details.
1276 The $JS_URI_PATH of "/cgi-bin/js" could contain the following:
1283 ### path_info should contain something like /CGI/Ex/yaml_load.js
1284 my $info = $ENV{PATH_INFO} || '';
1285 die "Invalid path" if $info !~ m|^(/\w+)+.js$|;
1288 CGI::Ex->new->print_js($info);
1291 The print_js method in CGI::Ex is designed to cache the javascript in
1292 the browser (caching is suggested as they are medium sized files).
1296 Returns a CGI::Ex object. Used internally.
1300 =head1 VALIDATION HASH
1302 The validation hash may be passed as a perl a hashref or as a
1303 filename, or as a YAML document string. If it is a filename, it will
1304 be translated into a hash using the %EXT_HANDLER for the extension on
1305 the file. If there is no extension, it will use $DEFAULT_EXT as a
1308 The validation "hash" may also be an arrayref of hashrefs. In this
1309 case, each arrayref is treated as a group and is validated separately.
1310 A group can have a validate_if function that allows for that
1311 particular group to apply only if certain conditions are met.
1315 Each hashref that is passed as a validation hash is treated as a
1316 group. Keys matching the regex m/^group\s+(\w+)$/ are reserved and
1317 are counted as GROUP OPTIONS. Keys matching the regex m/^general\s+(\w+)$/
1318 are reserved and are counted as GENERAL OPTIONS. Other keys (if
1319 any, should be keys that need validation).
1321 If the GROUP OPTION 'group validate_if' is set, the group will only
1322 be validated if the conditions are met. Any group with out a validate_if
1323 fill be automatically validated.
1325 Each of the items listed in the group will be validated. The
1326 validation order is determined in one of three ways:
1330 =item Specify 'group fields' arrayref.
1332 # order will be (username, password, 'm/\w+_foo/', somethingelse)
1334 'group title' => "User Information",
1336 {field => 'username', required => 1},
1337 {field => 'password', required => 1},
1338 {field => 'm/\w+_foo/', required => 1},
1340 somethingelse => {required => 1},
1343 =item Specify 'group order' arrayref.
1345 # order will be (username, password, 'm/\w+_foo/', somethingelse)
1347 'group title' => "User Information",
1348 'group order' => [qw(username password), 'm/\w+_foo/'],
1349 username => {required => 1},
1350 password => {required => 1},
1351 'm/\w+_foo/' => {required => 1},
1352 somethingelse => {required => 1},
1355 =item Do nothing - use sorted order.
1357 # order will be ('m/\w+_foo/', password, somethingelse, username)
1359 'group title' => "User Information",
1360 username => {required => 1},
1361 password => {required => 1},
1362 'm/\w+_foo/' => {required => 1},
1363 somethingelse => {required => 1},
1368 Each of the individual field validation hashrefs should contain the
1369 types listed in VALIDATION TYPES.
1371 Optionally the 'group fields' or the 'group order' may contain the
1372 word 'OR' as a special keyword. If the item preceding 'OR' fails
1373 validation the item after 'OR' will be tested instead. If the item
1374 preceding 'OR' passes validation the item after 'OR' will not be
1377 'group order' => [qw(zip OR postalcode state OR region)],
1379 Each individual validation hashref will operate on the field contained
1380 in the 'field' key. This key may also be a regular expression in the
1381 form of 'm/somepattern/'. If a regular expression is used, all keys
1382 matching that pattern will be validated.
1384 =head1 VALIDATION TYPES
1386 This section lists the available validation types. Multiple instances
1387 of the same type may be used for some validation types by adding a
1388 number to the type (ie match, match2, match232, match_94). Multiple
1389 instances are validated in sorted order. Types that allow multiple
1406 =item C<validate_if>
1408 If validate_if is specified, the field will only be validated
1409 if the conditions are met. Works in JS.
1411 validate_if => {field => 'name', required => 1, max_len => 30}
1412 # Will only validate if the field "name" is present and is less than 30 chars.
1414 validate_if => 'name',
1416 validate_if => {field => 'name', required => 1},
1418 validate_if => '! name',
1420 validate_if => {field => 'name', max_in_set => '0 of name'},
1422 validate_if => {field => 'country', compare => "eq US"},
1423 # only if country's value is equal to US
1425 validate_if => {field => 'country', compare => "ne US"},
1426 # if country doesn't equal US
1428 validate_if => {field => 'password', match => 'm/^md5\([a-z0-9]{20}\)$/'},
1429 # if password looks like md5(12345678901234567890)
1432 field => 'm/^(\w+)_pass/',
1433 validate_if => '$1_user',
1436 # will validate foo_pass only if foo_user was present.
1438 The validate_if may also contain an arrayref of validation items. So that
1439 multiple checks can be run. They will be run in order. validate_if will
1440 return true only if all options returned true.
1442 validate_if => ['email', 'phone', 'fax']
1444 Optionally, if validate_if is an arrayref, it may contain the word
1445 'OR' as a special keyword. If the item preceding 'OR' fails validation
1446 the item after 'OR' will be tested instead. If the item preceding 'OR'
1447 passes validation the item after 'OR' will not be tested.
1449 validate_if => [qw(zip OR postalcode)],
1451 =item C<required_if>
1453 Requires the form field if the condition is satisfied. The conditions
1454 available are the same as for validate_if. This is somewhat the same
1457 validate_if => 'some_condition',
1460 required_if => 'some_condition',
1462 If a regex is used for the field name, the required_if
1463 field will have any match patterns swapped in.
1466 field => 'm/^(\w+)_pass/',
1467 required_if => '$1_user',
1470 This example would require the "foobar_pass" field to be set
1471 if the "foobar_user" field was passed.
1475 Requires the form field to have some value. If the field is not present,
1476 no other checks will be run.
1478 =item C<min_values> and C<max_values>
1480 Allows for specifying the maximum number of form elements passed.
1481 max_values defaults to 1 (You must explicitly set it higher
1482 to allow more than one item by any given name).
1484 =item C<min_in_set> and C<max_in_set>
1486 Somewhat like min_values and max_values except that you specify the
1487 fields that participate in the count. Also - entries that are not
1488 defined or do not have length are not counted. An optional "of" can
1489 be placed after the number for human readability.
1491 min_in_set => "2 of foo bar baz",
1492 # two of the fields foo, bar or baz must be set
1494 min_in_set => "2 foo bar baz",
1496 min_in_set => "2 OF foo bar baz",
1498 validate_if => {field => 'whatever', max_in_set => '0 of whatever'},
1499 # only run validation if there were zero occurrences of whatever
1503 Allows for checking whether an item matches a set of options. In perl
1504 the value may be passed as an arrayref. In the conf or in perl the
1505 value may be passed of the options joined with ||.
1508 field => 'password_type',
1509 enum => 'plaintext||crypt||md5', # OR enum => [qw(plaintext crypt md5)],
1514 Allows for comparison of two form elements. Can have an optional !.
1517 field => 'password',
1518 equals => 'password_verify',
1522 equals => '!domain2', # make sure the fields are not the same
1525 =item C<min_len and max_len>
1527 Allows for check on the length of fields
1537 Allows for regular expression comparison. Multiple matches may
1538 be concatenated with ||. Available in JS.
1542 match => 'm/^\d{1,3}(\.\d{1,3})3$/',
1543 match_2 => '!/^0\./ || !/^192\./',
1548 Allows for custom comparisons. Available types are
1549 >, <, >=, <=, !=, ==, gt, lt, ge, le, ne, and eq. Comparisons
1550 also work in the JS.
1553 field => 'my_number',
1554 match => 'm/^\d+$/',
1555 compare1 => '> 100',
1556 compare2 => '< 255',
1557 compare3 => '!= 150',
1562 SQL query based - not available in JS. The database handle will be looked
1563 for in the value $self->{dbhs}->{foo} if sql_db_type is set to 'foo',
1564 otherwise it will default to $self->{dbh}. If $self->{dbhs}->{foo} or
1565 $self->{dbh} is a coderef - they will be called and should return a dbh.
1568 field => 'username',
1569 sql => 'SELECT COUNT(*) FROM users WHERE username = ?',
1570 sql_error_if => 1, # default is 1 - set to 0 to negate result
1571 # sql_db_type => 'foo', # will look for a dbh under $self->{dbhs}->{foo}
1576 Custom value - not available in JS. Allows for extra programming types.
1577 May be either a boolean value predetermined before calling validate, or may be
1578 a coderef that will be called during validation. If coderef is called, it will
1579 be passed the field name, the form value for that name, and a reference to the
1580 field validation hash. If the custom type returns false the element fails
1581 validation and an error is added.
1584 field => 'username',
1586 my ($key, $val, $type, $field_val_hash) = @_;
1594 Custom value - only available in JS. Allows for extra programming types.
1595 May be either a boolean value pre-determined before calling validate, or may be
1596 section of javascript that will be eval'ed. The last value (return value) of
1597 the eval'ed javascript will determine if validation passed. A false value indicates
1598 the value did not pass validation. A true value indicates that it did. See
1599 the t/samples/js_validate_3.html page for a sample of usage.
1604 match => 'm|^\d\d\d\d/\d\d/\d\d$|',
1605 match_error => 'Please enter date in YYYY/MM/DD format',
1608 var y=t.getYear()+1900;
1609 var m=t.getMonth() + 1;
1611 if (m<10) m = '0'+m;
1612 if (d<10) d = '0'+d;
1613 (value > ''+y+'/'+m+'/'+d) ? 1 : 0;
1615 custom_js_error => 'The date was not greater than today.',
1620 Allows for more strict type checking. Currently supported types
1621 include CC (credit card). Other types will be added upon request provided
1622 we can add a perl and a javascript version.
1625 field => 'credit_card',
1631 =head1 SPECIAL VALIDATION TYPES
1637 Specify which field to work on. Key may be a regex in the form 'm/\w+_user/'.
1638 This key is required if 'group fields' is used or if validate_if or required_if
1639 are used. It can optionally be used with other types to specify a different form
1640 element to operate on. On errors, if a non-default error is found, $field
1641 will be swapped with the value found in field.
1643 The field name may also be a regular expression in the
1644 form of 'm/somepattern/'. If a regular expression is used, all keys
1645 matching that pattern will be validated.
1649 Name to use for errors. If a name is not specified, default errors will use
1650 "The field $field" as the name. If a non-default error is found, $name
1651 will be swapped with this name.
1653 =item C<delegate_error>
1655 This option allows for any errors generated on a field to delegate to
1656 a different field. If the field name was a regex, any patterns will
1657 be swapped into the delegate_error value. This option is generally only
1658 useful with the as_hash method of the error object (for inline errors).
1662 match => 'm/^\d{5}/',
1665 field => 'zip_plus4',
1666 match => 'm/^\d{4}/',
1667 delegate_error => 'zip',
1670 field => 'm/^(id_[\d+])_user$/',
1671 delegate_error => '$1',
1676 This allows the cgi to do checking while keeping the checks from
1677 being run in JavaScript
1685 =item C<exclude_cgi>
1687 This allows the js to do checking while keeping the checks from
1688 being run in the cgi
1698 =head1 MODIFYING VALIDATION TYPES
1700 The following types will modify the form value before it is processed.
1701 They work in both the perl and in javascript as well. The javascript
1702 version changes the actual value in the form on appropriate form types.
1706 =item C<do_not_trim>
1708 By default, validate will trim leading and trailing whitespace
1709 from submitted values. Set do_not_trim to 1 to allow it to
1712 {field => 'foo', do_not_trim => 1}
1716 Pass a swap pattern to change the actual value of the form.
1717 Any perl regex can be passed but it is suggested that javascript
1718 compatible regexes are used to make generate_js possible.
1720 {field => 'foo', replace => 's/(\d{3})(\d{3})(\d{3})/($1) $2-$3/'}
1724 Set item to default value if there is no existing value (undefined
1725 or zero length string).
1727 {field => 'country', default => 'EN'}
1729 =item C<to_upper_case> and C<to_lower_case>
1731 Do what they say they do.
1735 Requires that the validated field has been also checked with
1736 an enum, equals, match, compare, custom, or type check. If the
1737 field has been checked and there are no errors - the field is "untainted."
1739 This is for use in conjunction with perl's -T switch.
1745 Failed validation results in an error an error object created via the
1746 new_error method. The default error class is CGI::Ex::Validate::Error.
1748 The error object has several methods for determining what the errors were.
1754 Returns an array or arrayref (depending on scalar context) of errors that
1755 occurred in the order that they occurred. Individual groups may have a heading
1756 and the entire validation will have a heading (the default heading can be changed
1757 via the 'as_array_title' general option). Each error that occurred is a separate
1758 item and are pre-pended with 'as_array_prefix' (which is a general option - default
1759 is ' '). The as_array_ options may also be set via a hashref passed to as_array.
1760 as_array_title defaults to 'Please correct the following items:'.
1762 ### if this returns the following
1763 my $array = $err_obj->as_array;
1765 # ['Please correct the following items:', ' error1', ' error2']
1767 ### then this would return the following
1768 my $array = $err_obj->as_array({
1769 as_array_prefix => ' - ',
1770 as_array_title => 'Something went wrong:',
1773 # ['Something went wrong:', ' - error1', ' - error2']
1777 Returns values of as_array joined with a newline. This method is used as
1778 the stringification for the error object. Values of as_array are joined with
1779 'as_string_join' which defaults to "\n". If 'as_string_header' is set, it will
1780 be pre-pended onto the error string. If 'as_string_footer' is set, it will be
1781 appended onto the error string.
1783 ### if this returns the following
1784 my $string = $err_obj->as_string;
1785 # $string looks like
1786 # "Please correct the following items:\n error1\n error2"
1788 ### then this would return the following
1789 my $string = $err_obj->as_string({
1790 as_array_prefix => ' - ',
1791 as_array_title => 'Something went wrong:',
1792 as_string_join => '<br />',
1793 as_string_header => '<span class="error">',
1794 as_string_footer => '</span>',
1796 # $string looks like
1797 # '<span class="error">Something went wrong:<br /> - error1<br /> - error2</span>'
1801 Returns a hash or hashref (depending on scalar context) of errors that
1802 occurred. Each key is the field name of the form that failed validation with
1803 'as_hash_suffix' added on as a suffix. as_hash_suffix is available as a general option
1804 and may also be passed in via a hashref as the only argument to as_hash.
1805 The default value is '_error'. The values of the hash are arrayrefs of errors
1806 that occurred to that form element.
1808 By default as_hash will return the values of the hash as arrayrefs (a list of the errors
1809 that occurred to that key). It is possible to also return the values as strings.
1810 Three options are available for formatting: 'as_hash_header' which will be pre-pended
1811 onto the error string, 'as_hash_footer' which will be appended, and 'as_hash_join' which
1812 will be used to join the arrayref. The only argument required to force the
1813 stringification is 'as_hash_join'.
1815 ### if this returns the following
1816 my $hash = $err_obj->as_hash;
1818 # {key1_error => ['error1', 'error2']}
1820 ### then this would return the following
1821 my $hash = $err_obj->as_hash({
1822 as_hash_suffix => '_foo',
1823 as_hash_join => '<br />',
1824 as_hash_header => '<span class="error">'
1825 as_hash_footer => '</span>'
1828 # {key1_foo => '<span class="error">error1<br />error2</span>'}
1832 =head1 GROUP OPTIONS
1834 Any key in a validation hash matching the pattern m/^group\s+(\w+)$/
1835 is considered a group option. The current know options are:
1839 =item C<'group title'>
1841 Used as a group section heading when as_array or as_string is called
1842 by the error object.
1844 =item C<'group order'>
1846 Order in which to validate key/value pairs of group.
1848 =item C<'group fields'>
1850 Arrayref of validation items to validate.
1852 =item C<'group validate_if'>
1854 Conditions that will be checked to see if the group should be validated.
1855 If no validate_if option is found, the group will be validated.
1859 =head1 GENERAL OPTIONS
1861 Any key in a validation hash matching the pattern m/^general\s+(\w+)$/
1862 is considered a general option. General options will also be looked
1863 for in the Validate object ($self) and can be set when instantiating
1864 the object ($self->{raise_error} is equivalent to
1865 $valhash->{'general raise_error'}). The current know options are:
1867 General options may be set in any group using the syntax:
1869 'general general_option_name' => 'general_option_value'
1871 They will only be set if the group's validate_if is successful or
1872 if the group does not have a validate_if. It is also possible to set
1873 a "group general" option using the following syntax:
1875 'group general_option_name' => 'general_option_value'
1877 These items will only be set if the group fails validation.
1878 If a group has a validate_if block and passes validation, the group
1879 items will not be used. This is so that a failed section can have
1880 its own settings. Note though that the last option found will be
1881 used and that items set in $self override those set in the validation
1884 Options may also be set globally before calling validate by
1885 populating the %DEFAULT_OPTIONS global hash.
1889 =item C<'general raise_error'>
1891 If raise_error is true, any call to validate that fails validation
1892 will die with an error object as the value.
1894 =item C<'general no_extra_fields'>
1896 If no_extra_fields is true, validate will add errors for any field found
1897 in form that does not have a field_val hashref in the validation hash.
1898 Default is false. If no_extra_fields is set to 'used', it will check for
1899 any keys that were not in a group that was validated.
1901 An important exception to this is that field_val hashrefs or field names listed
1902 in a validate_if or required_if statement will not be included. You must
1903 have an explicit entry for each key.
1905 =item C<'general \w+_error'>
1907 These items allow for an override of the default errors.
1909 'general required_error' => '$name is really required',
1910 'general max_len_error' => '$name must be shorter than $value characters',
1912 my $self = CGI::Ex::Validate->new({
1913 max_len_error => '$name must be shorter than $value characters',
1916 =item C<'general as_array_title'>
1918 Used as the section title for all errors that occur, when as_array
1919 or as_string is called by the error object.
1921 =item C<'general as_array_prefix'>
1923 Used as prefix to individual errors that occur, when as_array
1924 or as_string is called by the error object. Each individual error
1925 will be prefixed with this string. Headings will not be prefixed.
1928 =item C<'general as_string_join'>
1930 When as_string is called, the values from as_array will be joined with
1931 as_string_join. Default value is "\n".
1933 =item C<'general as_string_header'>
1935 If set, will be pre-pended onto the string when as_string is called.
1937 =item C<'general as_string_footer'>
1939 If set, will be pre-pended onto the string when as_string is called.
1941 =item C<'general as_hash_suffix'>
1943 Added on to key names during the call to as_hash. Default is '_error'.
1945 =item C<'general as_hash_join'>
1947 By default, as_hash will return hashref values that are errors joined with
1948 the default as_hash_join value of <br />. It can also return values that are
1949 arrayrefs of the errors. This can be done by setting as_hash_join to a non-true value
1952 =item C<'general as_hash_header'>
1954 If as_hash_join has been set to a true value, as_hash_header may be set to
1955 a string that will be pre-pended on to the error string.
1957 =item C<'general as_hash_footer'>
1959 If as_hash_join has been set to a true value, as_hash_footer may be set to
1960 a string that will be postpended on to the error string.
1962 =item C<'general no_inline'>
1964 If set to true, the javascript validation will not attempt to generate inline
1965 errors. Default is true. Inline errors are independent of confirm and alert
1968 =item C<'general no_confirm'>
1970 If set to true, the javascript validation will try to use an alert instead
1971 of a confirm to inform the user of errors. Alert and confirm are independent
1972 or inline errors. Default is false.
1974 =item C<'general no_alert'>
1976 If set to true, the javascript validation will not show an alert box
1977 when errors occur. Default is false. This option only comes into
1978 play if no_confirm is also set. This option is independent of inline
1979 errors. Although it is possible to turn off all errors by setting
1980 no_inline, no_confirm, and no_alert all to 1, it is suggested that at
1981 least one of the error reporting facilities is left on.
1985 It is possible to have a group that contains nothing but general options.
1988 {'general error_title' => 'The following things went wrong',
1989 'general error_prefix' => ' - ',
1990 'general raise_error' => 1,
1991 'general name_suffix' => '_foo_error',
1992 'general required_error' => '$name is required',
1994 {'group title' => 'User Information',
1995 username => {required => 1},
1996 email => {required => 1},
1997 password => {required => 1},
2003 CGI::Ex::Validate provides for having duplicate validation on the
2004 client side as on the server side. Errors can be shown in any
2005 combination of inline and confirm, inline and alert, inline only,
2006 confirm only, alert only, and none. These combinations are controlled
2007 by the general options no_inline, no_confirm, and no_alert.
2008 Javascript validation can be generated for a page using the
2009 C<-E<gt>generate_js> Method of CGI::Ex::Validate. It is also possible
2010 to store the validation inline with the html. This can be done by
2011 giving each of the elements to be validated an attribute called
2012 "validation", or by setting a global javascript variable called
2013 "document.validation" or "var validation". An html file containing this
2014 validation will be read in using CGI::Ex::Conf::read_handler_html.
2016 All inline html validation must be written in yaml.
2018 It is anticipated that the html will contain something like either of the
2021 <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
2022 <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2024 // \n\ allows all browsers to view this as a single string
2025 document.validation = "\n\
2026 general no_confirm: 1\n\
2027 general no_alert: 1\n\
2028 group order: [username, password]\n\
2036 if (document.check_form) document.check_form('my_form_name');
2039 Alternately we can use element attributes:
2041 <form name="my_form_name">
2043 Username: <input type=text size=20 name=username validation="
2047 <span class=error id=username_error>[% username_error %]</span><br>
2049 Password: <input type=text size=20 name=password validation="
2053 <span class=error id=password_error>[% password_error %]</span><br>
2059 <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
2060 <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2062 if (document.check_form) document.check_form('my_form_name');
2065 The read_handler_html from CGI::Ex::Conf will find either of these
2066 types of validation.
2068 If inline errors are asked for, each error that occurs will attempt
2069 to find an html element with its name as the id. For example, if
2070 the field "username" failed validation and created a "username_error",
2071 the javascript would set the html of <span id="username_error"></span>
2072 to the error message.
2074 It is suggested to use something like the following so that you can
2075 have inline javascript validation as well as report validation errors
2076 from the server side as well.
2078 <span class=error id=password_error>[% password_error %]</span><br>
2080 If the javascript fails for some reason, the form should still be able
2081 to submit as normal (fail gracefully).
2083 If the confirm option is used, the errors will be displayed to the user.
2084 If they choose OK they will be able to try and fix the errors. If they
2085 choose cancel, the form will submit anyway and will rely on the server
2086 to do the validation. This is for fail safety to make sure that if the
2087 javascript didn't validate correctly, the user can still submit the data.
2091 Thanks to Eamon Daly for providing bug fixes for bugs in validate.js
2092 caused by HTML::Prototype.
2100 This module may be distributed under the same terms as Perl itself.
This page took 0.19679 seconds and 4 git commands to generate.