]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Validate.pm
6b8401445b99189d35096551e053f321bbf9bfd1
1 package CGI
::Ex
::Validate
;
5 CGI::Ex::Validate - another form validator - but it does javascript in parallel
9 ###----------------------------------------------------------------###
10 # Copyright 2007 - 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 $field_val->{'field'} = $field if ! defined $field_val->{'field'};
130 push @$fields, $field_val;
133 ### Finally we have our arrayref of hashrefs that each have their 'field' key
134 ### now lets do the validation
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
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;
153 ### test the error - if errors occur allow for OR - if OR fails use errors from first fail
155 if ($i < $#$fields && ! ref($fields->[$i + 1]) && $fields->[$i + 1] eq 'OR') {
158 push @errors, $hold_error ? @$hold_error : @err;
165 push(@errors, @$hold_error) if $hold_error; # allow for final OR to work
167 ### add on errors as requested
168 if ($#errors != -1) {
169 push @ERRORS, $title if $title;
170 push @ERRORS, @errors;
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};
181 ### store any extra items from self
182 $EXTRA{$_} = $self->{$_} for grep {/$QR_EXTRA/o} keys %$self;
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];
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'};
201 return wantarray ? () : undef;
207 return CGI
::Ex
::Validate
::Error-
>new(@_);
210 ### allow for optional validation on groups and on individual items
211 sub check_conditional
{
212 my ($self, $form, $ifs, $N_level, $ifs_match) = @_;
215 $N_level ++; # prevent too many recursive checks
217 ### can pass a single hash - or an array ref of hashes
219 die "Need reference passed to check_conditional";
220 } elsif (! ref($ifs)) {
222 } elsif (UNIVERSAL
::isa
($ifs,'HASH')) {
226 ### run the if options here
227 ### multiple items can be passed - all are required unless OR is used to separate
229 foreach (my $i = 0; $i <= $#$ifs; $i ++) {
230 my $ref = $ifs->[$i];
233 $i ++ if $found; # if found skip the OR altogether
237 if ($ref =~ s/^\s*!\s*//) {
238 $ref = {field
=> $ref, max_in_set
=> "0 of $ref"};
240 $ref = {field
=> $ref, required
=> 1};
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;
250 my @err = $self->validate_buddy($form, $field, $ref, $N_level);
251 $found = 0 if scalar @err;
257 ### this is where the main checking goes on
260 my ($form, $field, $field_val, $N_level, $ifs_match) = @_;
262 $N_level ++; # prevent too many recursive checks
263 die "Max dependency level reached $N_level" if $N_level > 10;
266 my $types = [sort keys %$field_val];
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;
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);
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);
284 return wantarray ? @errors : $#errors + 1;
287 my $values = UNIVERSAL
::isa
($form->{$field},'ARRAY') ? $form->{$field} : [$form->{$field}];
288 my $n_values = $#$values + 1;
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'};
297 ### allow for a few form modifiers
299 foreach my $value (@$values) {
300 next if ! defined $value;
301 if (! $field_val->{'do_not_trim'}) { # whitespace
306 if ($field_val->{'trim_control_chars'}) {
308 $value =~ y/\x00-\x1F//d;
311 if ($field_val->{'to_upper_case'}) { # uppercase
314 } elsif ($field_val->{'to_lower_case'}) { # lowercase
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)";
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;
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
336 $copy =~ s/\$(\d+)/defined($match[$1]) ? $match[$1] : ""/ge;
338 $copy; # return of the swap
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
347 $copy =~ s/\$(\d+)/defined($match[$1]) ? $match[$1] : ""/ge;
349 $copy; # return of the swap
355 ### put them back into the form if we have modified it
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
};
362 ### values in @{ $form->{$field} } were modified directly
363 $self->{cgi_object
}->param(-name
=> $field, -value
=> $values)
364 if $self->{cgi_object
};
368 ### only continue if a validate_if is not present or passes test
371 foreach my $type (grep {/^validate_if_?\d*$/} @$types) {
373 my $ifs = $field_val->{$type};
374 my $ret = $self->check_conditional($form, $ifs, $N_level, $ifs_match);
375 $needs_val ++ if $ret;
377 if (! $needs_val && $n_vif) {
378 delete $field_val->{'was_validated'};
379 return wantarray ? @errors : $#errors + 1;
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;
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];
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];
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];
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],
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}";
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);
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];
442 ### at this point @errors should still be empty
443 my $content_checked; # allow later for possible untainting (only happens if content was checked)
445 ### loop on values of field
446 foreach my $value (@$values) {
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'})];
453 $found = 1 if defined($value) && $_ eq $value;
456 return 1 if ! wantarray;
457 push @errors, [$field, 'enum', $field_val, $ifs_match];
459 $content_checked = 1;
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;
467 if ($field2 =~ m/^([\"\'])(.*)\1$/) {
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
475 if ($not ? $success : ! $success) {
476 return 1 if ! wantarray;
477 push @errors, [$field, $type, $field_val, $ifs_match];
479 $content_checked = 1;
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];
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];
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];
511 if ($rx !~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) {
512 die "Not sure how to parse that match ($rx)";
514 my ($not,$pat,$opt) = ($1,$3,$4);
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)/))
520 return 1 if ! wantarray;
521 push @errors, [$field, $type, $field_val, $ifs_match];
525 $content_checked = 1;
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) {
535 if ($comp =~ /^\s*(>|<|[><!=]=)\s*([\d\.\-]+)\s*$/) {
536 my $val = $value || 0;
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) }
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) }
557 die "Not sure how to compare \"$comp\"";
560 return 1 if ! wantarray;
561 push @errors, [$field, $type, $field_val, $ifs_match];
564 $content_checked = 1;
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
};
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";
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];
585 $content_checked = 1;
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;
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];
603 $content_checked = 1;
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];
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
};
620 ### values in @{ $form->{$field} } were modified directly
621 $self->{cgi_object
}->param(-name
=> $field, -value
=> $values)
622 if $self->{cgi_object
};
627 ### all done - time to return
628 return wantarray ? @errors : $#errors + 1;
631 ###----------------------------------------------------------------###
633 ### used to validate specific types
637 my $type = uc(shift);
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;
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');
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/(\.\-|\-\.|\.\.)/;
657 ### standard IP address
658 } elsif ($type eq 'IP') {
659 return 0 if ! $value;
660 return (4 == grep {!/\D/ && $_ < 256} split /\./, $value, 4);
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]+)$//;
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;
679 } elsif ($type eq 'URL') {
680 return 0 if ! $value;
681 $value =~ s
|^https
?://([^/]+)||i
|| return 0;
683 return 0 if ! $self->check_type($dom,'DOMAIN') && ! $self->check_type($dom,'IP');
684 return 0 if $value && ! $self->check_type($value,'URI');
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+/;
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;
698 ### simple mod10 check
702 foreach my $digit ( reverse split //, $value ){
703 $switch = 1 if ++ $switch > 2;
704 my $y = $digit * $switch;
708 return 0 if $sum % 10;
715 ###----------------------------------------------------------------###
720 return CGI
::Ex
::Conf
::conf_read
($val, {html_key
=> 'validation', default_ext
=> $DEFAULT_EXT});
723 ### returns all keys from all groups - even if group has validate_if
724 sub get_validation_keys
{
726 my $val_hash = shift;
727 my $form = shift; # with optional form - will only return keys in validated groups
730 ### if a form was passed - make sure it is a hashref
733 die "Invalid form hash or cgi object";
734 } elsif(! UNIVERSAL
::isa
($form,'HASH')) {
736 $form = CGI
::Ex-
>new->get_form($form);
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');
745 ### if form is passed, check to see if the group passed validation
747 my $validate_if = $group_val->{'group validate_if'};
748 next if $validate_if && ! $self->check_conditional($form, $validate_if);
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;
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;
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;
782 ###----------------------------------------------------------------###
784 ### spit out a chunk that will do the validation
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;
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);
796 ### store any extra items from self
798 $EXTRA{"general $_"} = $self->{$_} for grep {/$QR_EXTRA/o} keys %$self; # add 'general' to be used in javascript
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";
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>
809 document.validation = $json;
810 if (document.check_form) document.check_form("$form_name");
814 } elsif (! $self->{'no_json'} && eval { require JSON
}) {
815 my $json = JSON-
>new(pretty
=> 1)->objToJson($val_hash);
817 return qq{<script src="$js_uri_path_validate"></script>
819 document.validation = $json;
820 if (document.check_form) document.check_form("$form_name");
824 } elsif (eval { require YAML
}) {
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
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";
837 ### return the string
838 return qq{<script src="$js_uri_path_yaml"></script>
839 <script src="$js_uri_path_validate"></script>
841 document.validation = "$str";
842 if (document.check_form) document.check_form("$form_name");
846 return '<!-- no JSON or YAML support found for JS validation -->';
850 ###----------------------------------------------------------------###
851 ### How to handle errors
853 package CGI
::Ex
::Validate
::Error
;
856 use overload
'""' => \
&as_string
;
859 my $class = shift || __PACKAGE__
;
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;
869 my $extra = $self->{extra
} || {};
870 my $extra2 = shift || {};
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
}
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
} : "";
881 return $header . join($join, @{ $self->as_array($extra2) }) . $footer;
884 ### return an array of applicable errors
887 my $errors = $self->{errors
} || die "Missing errors";
888 my $extra = $self->{extra
} || {};
889 my $extra2 = shift || {};
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:";
895 ### if there are heading items then we may end up needing a prefix
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 ? ' ' : '';
911 ### get the array ready
913 push @array, $title if length $title;
917 foreach my $err (@$errors) {
922 my $text = $self->get_error_text($err);
923 next if $found{$text};
925 push @array, "$prefix$text";
932 ### return a hash of applicable errors
935 my $errors = $self->{errors
} || die "Missing errors";
936 my $extra = $self->{extra
} || {};
937 my $extra2 = shift || {};
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 />';
944 ### now add to the hash
947 foreach my $err (@$errors) {
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;
957 my $text = $self->get_error_text($err);
958 next if $found{$field}->{$text};
959 $found{$field}->{$text} = 1;
962 $return{$field} ||= [];
963 $return{$field} = [$return{$field}] if ! ref($return{$field});
964 push @{ $return{$field} }, $text;
967 ### allow for elements returned as
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;
981 ### return a user friendly error message
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);
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;
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;
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);
1005 ### look in the passed hash or self first
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;
1018 ### set default messages
1020 if ($type eq 'required' || $type eq 'required_if') {
1021 $return = "$name is required.";
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.";
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.";
1033 } elsif ($type eq 'enum') {
1034 $return = "$name is not in the given list.";
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.";
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.";
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.";
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)";
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)";
1060 } elsif ($type eq 'match') {
1061 $return = "$name contains invalid characters.";
1063 } elsif ($type eq 'compare') {
1064 $return = "$name did not fit comparison.";
1066 } elsif ($type eq 'sql') {
1067 $return = "$name did not match sql test.";
1069 } elsif ($type eq 'custom') {
1070 $return = "$name did not match custom test.";
1072 } elsif ($type eq 'type') {
1073 my $_type = $field_val->{"type${dig}"};
1074 $return = "$name did not match type $_type.";
1076 } elsif ($type eq 'untaint') {
1077 $return = "$name cannot be untainted without one of the following checks: enum, equals, match, compare, sql, type, custom";
1079 } elsif ($type eq 'no_extra_fields') {
1080 $return = "$name should not be passed to validate.";
1084 die "Missing error on field $field for type $type$dig" if ! $return;
1089 ###----------------------------------------------------------------###
1098 use CGI::Ex::Validate;
1102 my $errobj = CGI::Ex::Validate->new->validate($form, $val_hash);
1106 my $form = CGI->new;
1108 my $form = CGI::Ex->new; # OR CGI::Ex->get_form;
1110 my $form = {key1 => 'val1', key2 => 'val2'};
1118 field => 'username',
1119 # field is optional in this case - will use key name
1126 validate_if => 'email',
1133 'group order' => [qw(username email email2)],
1134 username => {required => 1, max_len => 30},
1141 'group fields' => [{
1142 field => 'username', # field is not optional in this case
1151 validate_if => 'email',
1157 my $vob = CGI::Ex::Validate->new;
1158 my $errobj = $vob->validate($form, $val_hash);
1160 my $errobj = $vob->validate($form, "/somefile/somewhere.val"); # import config using yaml file
1162 my $errobj = $vob->validate($form, "/somefile/somewhere.pl"); # import config using perl file
1164 my $errobj = $vob->validate($form, "--- # a yaml document\n"); # import config using yaml str
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
1172 # form passed validation
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);
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.
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.
1191 It also has full support for providing the same validation in javascript.
1192 It provides methods for attaching the javascript to existing forms.
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.
1203 =item C<get_validation>
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.
1208 my $ref = $self->get_validation($file);
1210 =item C<get_validation_keys>
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.
1218 my $key_hashref = $self->get_validation_keys($val_hash);
1220 The values of the hash are the names of the fields.
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).
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.
1238 my $err_obj = $self->validate($form, $val_hash);
1242 $self->{raise_error} = 1; # raise error can also be listed in the
1243 val_hash eval { $self->validate($form, $val_hash) }; if ($@) { my
1246 =item C<generate_js>
1248 Requires JSON or YAML to work properly (see L<JSON> or L<YAML>).
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.
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".
1269 $self->generate_js($val_hash, 'my_form', "/cgi-bin/js")
1271 # would generate something like the following...
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 ...
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')
1281 # would generate something like the following...
1283 <script src="/js/yaml_load.js"></script>
1284 <script src="/stock/js/CGI/Ex/validate.js"></script>
1285 ... more js follows ...
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:
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$|;
1304 CGI::Ex->new->print_js($info);
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).
1312 Returns a CGI::Ex object. Used internally.
1316 =head1 VALIDATION HASH
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
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.
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).
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.
1341 Each of the items listed in the group will be validated. The
1342 validation order is determined in one of three ways:
1346 =item Specify 'group fields' arrayref.
1348 # order will be (username, password, 'm/\w+_foo/', somethingelse)
1350 'group title' => "User Information",
1352 {field => 'username', required => 1},
1353 {field => 'password', required => 1},
1354 {field => 'm/\w+_foo/', required => 1},
1356 somethingelse => {required => 1},
1359 =item Specify 'group order' arrayref.
1361 # order will be (username, password, 'm/\w+_foo/', somethingelse)
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},
1371 =item Do nothing - use sorted order.
1373 # order will be ('m/\w+_foo/', password, somethingelse, username)
1375 'group title' => "User Information",
1376 username => {required => 1},
1377 password => {required => 1},
1378 'm/\w+_foo/' => {required => 1},
1379 somethingelse => {required => 1},
1384 Each of the individual field validation hashrefs should contain the
1385 types listed in VALIDATION TYPES.
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
1393 'group order' => [qw(zip OR postalcode state OR region)],
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.
1400 =head1 VALIDATION TYPES
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
1422 =item C<validate_if>
1424 If validate_if is specified, the field will only be validated
1425 if the conditions are met. Works in JS.
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.
1430 validate_if => 'name',
1432 validate_if => {field => 'name', required => 1},
1434 validate_if => '! name',
1436 validate_if => {field => 'name', max_in_set => '0 of name'},
1438 validate_if => {field => 'country', compare => "eq US"},
1439 # only if country's value is equal to US
1441 validate_if => {field => 'country', compare => "ne US"},
1442 # if country doesn't equal US
1444 validate_if => {field => 'password', match => 'm/^md5\([a-z0-9]{20}\)$/'},
1445 # if password looks like md5(12345678901234567890)
1448 field => 'm/^(\w+)_pass/',
1449 validate_if => '$1_user',
1452 # will validate foo_pass only if foo_user was present.
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.
1458 validate_if => ['email', 'phone', 'fax']
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.
1465 validate_if => [qw(zip OR postalcode)],
1467 =item C<required_if>
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
1473 validate_if => 'some_condition',
1476 required_if => 'some_condition',
1478 If a regex is used for the field name, the required_if
1479 field will have any match patterns swapped in.
1482 field => 'm/^(\w+)_pass/',
1483 required_if => '$1_user',
1486 This example would require the "foobar_pass" field to be set
1487 if the "foobar_user" field was passed.
1491 Requires the form field to have some value. If the field is not present,
1492 no other checks will be run.
1494 =item C<min_values> and C<max_values>
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).
1500 =item C<min_in_set> and C<max_in_set>
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.
1507 min_in_set => "2 of foo bar baz",
1508 # two of the fields foo, bar or baz must be set
1510 min_in_set => "2 foo bar baz",
1512 min_in_set => "2 OF foo bar baz",
1514 validate_if => {field => 'whatever', max_in_set => '0 of whatever'},
1515 # only run validation if there were zero occurrences of whatever
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 ||.
1524 field => 'password_type',
1525 enum => 'plaintext||crypt||md5', # OR enum => [qw(plaintext crypt md5)],
1530 Allows for comparison of two form elements. Can have an optional !.
1533 field => 'password',
1534 equals => 'password_verify',
1538 equals => '!domain2', # make sure the fields are not the same
1541 =item C<min_len and max_len>
1543 Allows for check on the length of fields
1553 Allows for regular expression comparison. Multiple matches may
1554 be concatenated with ||. Available in JS.
1558 match => 'm/^\d{1,3}(\.\d{1,3})3$/',
1559 match_2 => '!/^0\./ || !/^192\./',
1564 Allows for custom comparisons. Available types are
1565 >, <, >=, <=, !=, ==, gt, lt, ge, le, ne, and eq. Comparisons
1566 also work in the JS.
1569 field => 'my_number',
1570 match => 'm/^\d+$/',
1571 compare1 => '> 100',
1572 compare2 => '< 255',
1573 compare3 => '!= 150',
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.
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}
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.
1600 field => 'username',
1602 my ($key, $val, $type, $field_val_hash) = @_;
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.
1620 match => 'm|^\d\d\d\d/\d\d/\d\d$|',
1621 match_error => 'Please enter date in YYYY/MM/DD format',
1624 var y=t.getYear()+1900;
1625 var m=t.getMonth() + 1;
1627 if (m<10) m = '0'+m;
1628 if (d<10) d = '0'+d;
1629 (value > ''+y+'/'+m+'/'+d) ? 1 : 0;
1631 custom_js_error => 'The date was not greater than today.',
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.
1641 field => 'credit_card',
1647 =head1 SPECIAL VALIDATION TYPES
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.
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.
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.
1669 =item C<delegate_error>
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).
1678 match => 'm/^\d{5}/',
1681 field => 'zip_plus4',
1682 match => 'm/^\d{4}/',
1683 delegate_error => 'zip',
1686 field => 'm/^(id_[\d+])_user$/',
1687 delegate_error => '$1',
1692 This allows the cgi to do checking while keeping the checks from
1693 being run in JavaScript
1701 =item C<exclude_cgi>
1703 This allows the js to do checking while keeping the checks from
1704 being run in the cgi
1714 =head1 MODIFYING VALIDATION TYPES
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.
1722 =item C<do_not_trim>
1724 By default, validate will trim leading and trailing whitespace
1725 from submitted values. Set do_not_trim to 1 to allow it to
1728 {field => 'foo', do_not_trim => 1}
1730 =item C<trim_control_chars>
1732 Off by default. If set to true, removes characters in the
1733 \x00 to \x31 range (Tabs are translated to a single space).
1735 {field => 'foo', trim_control_chars => 1}
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.
1743 {field => 'foo', replace => 's/(\d{3})(\d{3})(\d{3})/($1) $2-$3/'}
1747 Set item to default value if there is no existing value (undefined
1748 or zero length string).
1750 {field => 'country', default => 'EN'}
1752 =item C<to_upper_case> and C<to_lower_case>
1754 Do what they say they do.
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."
1762 This is for use in conjunction with perl's -T switch.
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.
1771 The error object has several methods for determining what the errors were.
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:'.
1785 ### if this returns the following
1786 my $array = $err_obj->as_array;
1788 # ['Please correct the following items:', ' error1', ' error2']
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:',
1796 # ['Something went wrong:', ' - error1', ' - error2']
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.
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"
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>',
1819 # $string looks like
1820 # '<span class="error">Something went wrong:<br /> - error1<br /> - error2</span>'
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.
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'.
1838 ### if this returns the following
1839 my $hash = $err_obj->as_hash;
1841 # {key1_error => ['error1', 'error2']}
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>'
1851 # {key1_foo => '<span class="error">error1<br />error2</span>'}
1855 =head1 GROUP OPTIONS
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:
1862 =item C<'group title'>
1864 Used as a group section heading when as_array or as_string is called
1865 by the error object.
1867 =item C<'group order'>
1869 Order in which to validate key/value pairs of group.
1871 =item C<'group fields'>
1873 Arrayref of validation items to validate.
1875 =item C<'group validate_if'>
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.
1882 =head1 GENERAL OPTIONS
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:
1890 General options may be set in any group using the syntax:
1892 'general general_option_name' => 'general_option_value'
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:
1898 'group general_option_name' => 'general_option_value'
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
1907 Options may also be set globally before calling validate by
1908 populating the %DEFAULT_OPTIONS global hash.
1912 =item C<'general raise_error'>
1914 If raise_error is true, any call to validate that fails validation
1915 will die with an error object as the value.
1917 =item C<'general no_extra_fields'>
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.
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.
1928 =item C<'general \w+_error'>
1930 These items allow for an override of the default errors.
1932 'general required_error' => '$name is really required',
1933 'general max_len_error' => '$name must be shorter than $value characters',
1935 my $self = CGI::Ex::Validate->new({
1936 max_len_error => '$name must be shorter than $value characters',
1939 =item C<'general as_array_title'>
1941 Used as the section title for all errors that occur, when as_array
1942 or as_string is called by the error object.
1944 =item C<'general as_array_prefix'>
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.
1951 =item C<'general as_string_join'>
1953 When as_string is called, the values from as_array will be joined with
1954 as_string_join. Default value is "\n".
1956 =item C<'general as_string_header'>
1958 If set, will be pre-pended onto the string when as_string is called.
1960 =item C<'general as_string_footer'>
1962 If set, will be pre-pended onto the string when as_string is called.
1964 =item C<'general as_hash_suffix'>
1966 Added on to key names during the call to as_hash. Default is '_error'.
1968 =item C<'general as_hash_join'>
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
1975 =item C<'general as_hash_header'>
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.
1980 =item C<'general as_hash_footer'>
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.
1985 =item C<'general no_inline'>
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
1991 =item C<'general no_confirm'>
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.
1997 =item C<'general no_alert'>
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.
2008 It is possible to have a group that contains nothing but general options.
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',
2017 {'group title' => 'User Information',
2018 username => {required => 1},
2019 email => {required => 1},
2020 password => {required => 1},
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.
2039 All inline html validation must be written in yaml.
2041 It is anticipated that the html will contain something like either of the
2044 <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
2045 <script src="/cgi-bin/js/CGI/Ex/validate.js"></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\
2059 if (document.check_form) document.check_form('my_form_name');
2062 Alternately we can use element attributes:
2064 <form name="my_form_name">
2066 Username: <input type=text size=20 name=username validation="
2070 <span class=error id=username_error>[% username_error %]</span><br>
2072 Password: <input type=text size=20 name=password validation="
2076 <span class=error id=password_error>[% password_error %]</span><br>
2082 <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
2083 <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2085 if (document.check_form) document.check_form('my_form_name');
2088 The read_handler_html from CGI::Ex::Conf will find either of these
2089 types of validation.
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.
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.
2101 <span class=error id=password_error>[% password_error %]</span><br>
2103 If the javascript fails for some reason, the form should still be able
2104 to submit as normal (fail gracefully).
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.
2114 Thanks to Eamon Daly for providing bug fixes for bugs in validate.js
2115 caused by HTML::Prototype.
2123 This module may be distributed under the same terms as Perl itself.
This page took 0.196677 seconds and 4 git commands to generate.