]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Validate.pm
591168f1bfbae72bc729ef9067da56a0ea47cc0b
1 package CGI
::Ex
::Validate
;
3 ### CGI Extended Validator
5 ###----------------------------------------------------------------###
6 # Copyright 2004 - Paul Seamons #
7 # Distributed under the Perl Artistic License without warranty #
8 ###----------------------------------------------------------------###
10 ### See perldoc at bottom
26 $ERROR_PACKAGE = 'CGI::Ex::Validate::Error';
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 {
59 return $self->{conf_obj
} ||= CGI
::Ex
::Conf-
>new({
60 default_ext
=> $DEFAULT_EXT,
65 ### the main validation routine
67 my $self = (! ref($_[0])) ? shift-
>new # $class->validate
68 : UNIVERSAL
::isa
($_[0], __PACKAGE__
) ? shift # $self->validate
69 : __PACKAGE__-
>new; # &validate
70 my $form = shift || die "Missing form hash";
71 my $val_hash = shift || die "Missing validation hash";
72 my $what_was_validated = shift; # allow for extra arrayref that stores what was validated
74 ### turn the form into a form if it is really a CGI object
76 die "Invalid form hash or cgi object";
77 } elsif(! UNIVERSAL
::isa
($form,'HASH')) {
78 local $self->{cgi_object
} = $form;
79 $form = $self->cgix->get_form($form);
82 ### get the validation - let get_validation deal with types
83 ### if a ref is not passed - assume it is a filename
84 $val_hash = $self->get_validation($val_hash);
86 ### allow for validation passed as single group hash, single group array,
87 ### or array of group hashes or group arrays
91 my $group_order = (UNIVERSAL
::isa
($val_hash,'HASH')) ? [$val_hash] : $val_hash;
92 foreach my $group_val (@$group_order) {
93 die "Validation groups must be a hashref" if ! UNIVERSAL
::isa
($group_val,'HASH');
94 my $title = $group_val->{'group title'};
95 my $validate_if = $group_val->{'group validate_if'};
97 ### only validate this group if it is supposed to be checked
98 next if $validate_if && ! $self->check_conditional($form, $validate_if);
99 push @USED_GROUPS, $group_val;
101 ### If the validation items were not passed as an arrayref.
102 ### Look for a group order and then fail back to the keys of the group.
103 ### We will keep track of what was added using %found - the keys will
104 ### be the hash signatures of the field_val hashes (ignore the hash internals).
105 my @order = sort keys %$group_val;
106 my $fields = $group_val->{'group fields'};
107 my %found = (); # attempt to keep track of what field_vals have been added
108 if ($fields) { # if I passed group fields array - use it
109 die "'group fields' must be an arrayref" if ! UNIVERSAL
::isa
($fields,'ARRAY');
110 } else { # other wise - create our own array
112 if (my $order = $group_val->{'group order'} || \
@order) {
113 die "Validation 'group order' must be an arrayref" if ! UNIVERSAL
::isa
($order,'ARRAY');
114 foreach my $field (@$order) {
115 next if $field =~ /^(group|general)\s/;
116 my $field_val = exists($group_val->{$field}) ? $group_val->{$field}
117 : ($field eq 'OR') ? 'OR' : die "No element found in group for $field";
118 $found{"$field_val"} = 1; # do this before modifying on the next line
119 if (ref $field_val && ! $field_val->{'field'}) {
120 $field_val = { %$field_val, 'field' => $field }; # copy the values to add the key
122 push @fields, $field_val;
128 ### double check which field_vals have been used so far
129 foreach my $field_val (@$fields) {
130 my $field = $field_val->{'field'} || die "Missing field key in validation";
131 $found{"$field_val"} = 1;
134 ### add any remaining field_vals from the order
135 ### this is necessary for items that weren't in group fields or group order
136 foreach my $field (@order) {
137 next if $field =~ /^(group|general)\s/;
138 my $field_val = $group_val->{$field};
139 die "Found a nonhashref value on field $field" if ! UNIVERSAL
::isa
($field_val, 'HASH');
140 next if $found{"$field_val"}; # do before modifying ref on next line
141 $field_val = { %$field_val, 'field' => $field } if ! $field_val->{'field'}; # copy the values
142 push @$fields, $field_val;
145 ### Finally we have our arrayref of hashrefs that each have their 'field' key
146 ### now lets do the validation
149 my $hold_error; # hold the error for a moment - to allow for an "Or" operation
150 foreach (my $i = 0; $i <= $#$fields; $i ++) {
151 my $ref = $fields->[$i];
152 if (! ref($ref) && $ref eq 'OR') {
153 $i ++ if $found; # if found skip the OR altogether
158 die "Missing field key during normal validation" if ! $ref->{'field'};
159 local $ref->{'was_validated'} = 1;
160 my @err = $self->validate_buddy($form, $ref->{'field'}, $ref);
161 if (delete($ref->{'was_validated'}) && $what_was_validated) {
162 push @$what_was_validated, $ref;
165 ### test the error - if errors occur allow for OR - if OR fails use errors from first fail
167 if ($i < $#$fields && ! ref($fields->[$i + 1]) && $fields->[$i + 1] eq 'OR') {
170 push @errors, $hold_error ? @$hold_error : @err;
177 push(@errors, @$hold_error) if $hold_error; # allow for final OR to work
179 ### add on errors as requested
180 if ($#errors != -1) {
181 push @ERRORS, $title if $title;
182 push @ERRORS, @errors;
185 ### add on general options, and group options if errors in group occurred
186 foreach my $field (@order) {
187 next if $field !~ /^(general|group)\s+(\w+)$/;
189 next if $1 eq 'group' && ($#errors == -1 || $key =~ /^(field|order|title)$/);
190 $EXTRA{$key} = $group_val->{$field};
194 ### store any extra items from self
195 foreach my $key (keys %$self) {
196 next if $key !~ $QR_EXTRA;
197 $EXTRA{$key} = $self->{$key};
200 ### allow for checking for unused keys
201 if ($EXTRA{no_extra_fields
}) {
202 my $which = ($EXTRA{no_extra_fields
} =~ /used/i) ? 'used' : 'all';
203 my $ref = ($which eq 'all') ? $val_hash : \
@USED_GROUPS;
204 my $keys = $self->get_validation_keys($ref);
205 foreach my $key (sort keys %$form) {
206 next if $keys->{$key};
207 $self->add_error(\
@ERRORS, $key, 'no_extra_fields', {}, undef);
211 ### return what they want
212 if ($#ERRORS != -1) {
213 my $err_obj = $ERROR_PACKAGE->new(\
@ERRORS, \
%EXTRA);
214 die $err_obj if $EXTRA{raise_error
};
217 return wantarray ? () : undef;
222 ### allow for optional validation on groups and on individual items
223 sub check_conditional
{
224 my ($self, $form, $ifs, $N_level, $ifs_match) = @_;
227 $N_level ++; # prevent too many recursive checks
229 ### can pass a single hash - or an array ref of hashes
231 die "Need reference passed to check_conditional";
232 } elsif (! ref($ifs)) {
234 } elsif (UNIVERSAL
::isa
($ifs,'HASH')) {
238 ### run the if options here
239 ### multiple items can be passed - all are required unless OR is used to separate
241 foreach (my $i = 0; $i <= $#$ifs; $i ++) {
242 my $ref = $ifs->[$i];
245 $i ++ if $found; # if found skip the OR altogether
249 if ($ref =~ s/^\s*!\s*//) {
250 $ref = {field
=> $ref, max_in_set
=> "0 of $ref"};
252 $ref = {field
=> $ref, required
=> 1};
258 ### get the field - allow for custom variables based upon a match
259 my $field = $ref->{'field'} || die "Missing field key during validate_if (possibly used a reference to a main hash *foo -> &foo)";
260 $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
262 my @err = $self->validate_buddy($form, $field, $ref, $N_level);
263 $found = 0 if scalar @err;
269 ### this is where the main checking goes on
272 my ($form, $field, $field_val, $N_level, $ifs_match) = @_;
274 $N_level ++; # prevent too many recursive checks
275 die "Max dependency level reached $N_level" if $N_level > 10;
278 my $types = [sort keys %$field_val];
280 ### allow for not running some tests in the cgi
281 if (scalar $self->filter_type('exclude_cgi',$types)) {
282 delete $field_val->{'was_validated'};
283 return wantarray ? @errors : $#errors + 1;
286 ### allow for field names that contain regular expressions
287 if ($field =~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) {
288 my ($not,$pat,$opt) = ($1,$3,$4);
290 die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/;
291 foreach my $_field (sort keys %$form) {
292 next if ($not && $_field =~ m/(?$opt:$pat)/) || (! $not && $_field !~ m/(?$opt:$pat)/);
293 my @match = (undef,$1,$2,$3,$4,$5); # limit to the matches
294 push @errors, $self->validate_buddy($form, $_field, $field_val, $N_level, \
@match);
296 return wantarray ? @errors : $#errors + 1;
299 ### allow for default value
300 foreach my $type ($self->filter_type('default', $types)) {
301 if (! defined($form->{$field}) || (! ref($form->{$field}) && ! length($form->{$field}))) {
302 $form->{$field} = $field_val->{$type};
306 my $n_values = UNIVERSAL
::isa
($form->{$field},'ARRAY') ? $#{ $form->{$field} } + 1 : 1;
307 my $values = ($n_values > 1) ? $form->{$field} : [$form->{$field}];
309 ### allow for a few form modifiers
311 foreach my $value (@$values) {
312 next if ! defined $value;
313 if (! scalar $self->filter_type('do_not_trim',$types)) { # whitespace
318 if (scalar $self->filter_type('to_upper_case',$types)) { # uppercase
321 } elsif (scalar $self->filter_type('to_lower_case',$types)) { # lowercase
326 # allow for inline specified modifications (ie s/foo/bar/)
327 foreach my $type ($self->filter_type('replace',$types)) {
328 my $ref = UNIVERSAL
::isa
($field_val->{$type},'ARRAY') ? $field_val->{$type}
329 : [split(/\s*\|\|\s*/,$field_val->{$type})];
330 foreach my $rx (@$ref) {
331 if ($rx !~ m/^\s*s([^\s\w])(.+)\1(.*)\1([eigsmx]*)$/s) {
332 die "Not sure how to parse that match ($rx)";
334 my ($pat,$swap,$opt) = ($2,$3,$4);
335 die "The e option cannot be used in swap on field $field" if $opt =~ /e/;
336 my $global = $opt =~ s/g//g;
339 foreach my $value (@$values) {
340 $value =~ s
{(?$opt:$pat)}{
341 my @match = (undef,$1,$2,$3,$4,$5,$6); # limit on the number of matches
343 $copy =~ s/\$(\d+)/defined($match[$1]) ? $match[$1] : ""/ge;
345 $copy; # return of the swap
349 foreach my $value (@$values) {
350 $value =~ s
{(?$opt:$pat)}{
351 my @match = (undef,$1,$2,$3,$4,$5,$6); # limit on the number of matches
353 $copy =~ s/\$(\d+)/defined($match[$1]) ? $match[$1] : ""/ge;
355 $copy; # return of the swap
361 ### put them back into the form if we have modified it
363 if ($n_values == 1) {
364 $form->{$field} = $values->[0];
365 $self->{cgi_object
}->param(-name
=> $field, -value
=> $values->[0])
366 if $self->{cgi_object
};
368 ### values in @{ $form->{$field} } were modified directly
369 $self->{cgi_object
}->param(-name
=> $field, -value
=> $values)
370 if $self->{cgi_object
};
374 ### only continue if a validate_if is not present or passes test
377 foreach my $type ($self->filter_type('validate_if',$types)) {
379 my $ifs = $field_val->{$type};
380 my $ret = $self->check_conditional($form, $ifs, $N_level, $ifs_match);
381 $needs_val ++ if $ret;
383 if (! $needs_val && $n_vif) {
384 delete $field_val->{'was_validated'};
385 return wantarray ? @errors : $#errors + 1;
388 ### check for simple existence
389 ### optionally check only if another condition is met
390 my $is_required = '';
391 foreach my $type ($self->filter_type('required',$types)) {
392 next if ! $field_val->{$type};
393 $is_required = $type;
396 if (! $is_required) {
397 foreach my $type ($self->filter_type('required_if',$types)) {
398 my $ifs = $field_val->{$type};
399 next if ! $self->check_conditional($form, $ifs, $N_level, $ifs_match);
400 $is_required = $type;
404 if ($is_required && (! defined($form->{$field})
405 || ((UNIVERSAL
::isa
($form->{$field},'ARRAY') && $#{ $form->{$field} } == -1)
406 || ! length($form->{$field})))) {
407 return 1 if ! wantarray;
408 $self->add_error(\
@errors, $field, $is_required, $field_val, $ifs_match);
413 foreach my $type ($self->filter_type('min_values',$types)) {
414 my $n = $field_val->{$type} || 0;
415 if ($n_values < $n) {
416 return 1 if ! wantarray;
417 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
423 my @keys = $self->filter_type('max_values',$types);
425 push @keys, 'max_values';
426 $field_val->{'max_values'} = 1;
428 foreach my $type (@keys) {
429 my $n = $field_val->{$type} || 0;
430 if ($n_values > $n) {
431 return 1 if ! wantarray;
432 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
437 ### max_in_set and min_in_set checks
438 foreach my $minmax (qw(min max)) {
439 my @keys = $self->filter_type("${minmax}_in_set",$types);
440 foreach my $type (@keys) {
441 $field_val->{$type} =~ m/^\s*(\d+)(?i:\s*of)?\s+(.+)\s*$/
442 || die "Invalid in_set check $field_val->{$type}";
444 foreach my $_field (split /[\s,]+/, $2) {
445 my $ref = UNIVERSAL
::isa
($form->{$_field},'ARRAY') ? $form->{$_field} : [$form->{$_field}];
446 foreach my $_value (@$ref) {
447 $n -- if defined($_value) && length($_value);
450 if ( ($minmax eq 'min' && $n > 0)
451 || ($minmax eq 'max' && $n < 0)) {
452 return 1 if ! wantarray;
453 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
459 ### at this point @errors should still be empty
460 my $content_checked; # allow later for possible untainting (only happens if content was checked)
462 ### loop on values of field
463 foreach my $value (@$values) {
465 ### allow for enum types
466 foreach my $type ($self->filter_type('enum',$types)) {
467 my $ref = ref($field_val->{$type}) ? $field_val->{$type} : [split(/\s*\|\|\s*/,$field_val->{$type})];
470 $found = 1 if defined($value) && $_ eq $value;
473 return 1 if ! wantarray;
474 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
476 $content_checked = 1;
479 ### field equality test
480 foreach my $type ($self->filter_type('equals',$types)) {
481 my $field2 = $field_val->{$type};
482 my $not = ($field2 =~ s/^!\s*//) ? 1 : 0;
484 if ($field2 =~ m/^([\"\'])(.*)\1$/) {
486 $success = (defined($value) && $value eq $test);
487 } elsif (exists($form->{$field2}) && defined($form->{$field2})) {
488 $success = (defined($value) && $value eq $form->{$field2});
489 } elsif (! defined($value)) {
490 $success = 1; # occurs if they are both undefined
492 if ($not ? $success : ! $success) {
493 return 1 if ! wantarray;
494 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
496 $content_checked = 1;
500 foreach my $type ($self->filter_type('min_len',$types)) {
501 my $n = $field_val->{$type};
502 if (! defined($value) || length($value) < $n) {
503 return 1 if ! wantarray;
504 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
509 foreach my $type ($self->filter_type('max_len',$types)) {
510 my $n = $field_val->{$type};
511 if (defined($value) && length($value) > $n) {
512 return 1 if ! wantarray;
513 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
517 ### now do match types
518 foreach my $type ($self->filter_type('match',$types)) {
519 my $ref = UNIVERSAL
::isa
($field_val->{$type},'ARRAY') ? $field_val->{$type}
520 : UNIVERSAL
::isa
($field_val->{$type}, 'Regexp') ? [$field_val->{$type}]
521 : [split(/\s*\|\|\s*/,$field_val->{$type})];
522 foreach my $rx (@$ref) {
523 if (UNIVERSAL
::isa
($rx,'Regexp')) {
524 if (! defined($value) || $value !~ $rx) {
525 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
528 if ($rx !~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) {
529 die "Not sure how to parse that match ($rx)";
531 my ($not,$pat,$opt) = ($1,$3,$4);
533 die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/;
534 if ( ( $not && ( defined($value) && $value =~ m/(?$opt:$pat)/))
535 || (! $not && (! defined($value) || $value !~ m/(?$opt:$pat)/))
537 return 1 if ! wantarray;
538 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
542 $content_checked = 1;
545 ### allow for comparison checks
546 foreach my $type ($self->filter_type('compare',$types)) {
547 my $ref = UNIVERSAL
::isa
($field_val->{$type},'ARRAY') ? $field_val->{$type}
548 : [split(/\s*\|\|\s*/,$field_val->{$type})];
549 foreach my $comp (@$ref) {
552 if ($comp =~ /^\s*(>|<|[><!=]=)\s*([\d\.\-]+)\s*$/) {
553 my $val = $value || 0;
555 if ($1 eq '>' ) { $test = ($val > $2) }
556 elsif ($1 eq '<' ) { $test = ($val < $2) }
557 elsif ($1 eq '>=') { $test = ($val >= $2) }
558 elsif ($1 eq '<=') { $test = ($val <= $2) }
559 elsif ($1 eq '!=') { $test = ($val != $2) }
560 elsif ($1 eq '==') { $test = ($val == $2) }
562 } elsif ($comp =~ /^\s*(eq|ne|gt|ge|lt|le)\s+(.+?)\s*$/) {
563 my $val = defined($value) ? $value : '';
564 my ($op, $value2) = ($1, $2);
565 $value2 =~ s/^([\"\'])(.*)\1$/$2/;
566 if ($op eq 'gt') { $test = ($val gt $value2) }
567 elsif ($op eq 'lt') { $test = ($val lt $value2) }
568 elsif ($op eq 'ge') { $test = ($val ge $value2) }
569 elsif ($op eq 'le') { $test = ($val le $value2) }
570 elsif ($op eq 'ne') { $test = ($val ne $value2) }
571 elsif ($op eq 'eq') { $test = ($val eq $value2) }
574 die "Not sure how to compare \"$comp\"";
577 return 1 if ! wantarray;
578 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
581 $content_checked = 1;
584 ### server side sql type
585 foreach my $type ($self->filter_type('sql',$types)) {
586 my $db_type = $field_val->{"${type}_db_type"};
587 my $dbh = ($db_type) ? $self->{dbhs
}->{$db_type} : $self->{dbh
};
589 die "Missing dbh for $type type on field $field" . ($db_type ? " and db_type $db_type" : "");
590 } elsif (UNIVERSAL
::isa
($dbh,'CODE')) {
591 $dbh = &$dbh($field, $self) || die "SQL Coderef did not return a dbh";
593 my $sql = $field_val->{$type};
594 my @args = ($value) x
$sql =~ tr/?//;
595 my $return = $dbh->selectrow_array($sql, {}, @args); # is this right - copied from O::FORMS
596 $field_val->{"${type}_error_if"} = 1 if ! defined $field_val->{"${type}_error_if"};
597 if ( (! $return && $field_val->{"${type}_error_if"})
598 || ($return && ! $field_val->{"${type}_error_if"}) ) {
599 return 1 if ! wantarray;
600 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
602 $content_checked = 1;
605 ### server side custom type
606 foreach my $type ($self->filter_type('custom',$types)) {
607 my $check = $field_val->{$type};
608 next if UNIVERSAL
::isa
($check, 'CODE') ? &$check($field, $value, $field_val, $type) : $check;
609 return 1 if ! wantarray;
610 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
611 $content_checked = 1;
614 ### do specific type checks
615 foreach my $type ($self->filter_type('type',$types)) {
616 if (! $self->check_type($value,$field_val->{'type'},$field,$form)){
617 return 1 if ! wantarray;
618 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
620 $content_checked = 1;
624 ### allow for the data to be "untainted"
625 ### this is only allowable if the user ran some other check for the datatype
626 foreach my $type ($self->filter_type('untaint',$types)) {
627 last if $#errors != -1;
628 if (! $content_checked) {
629 $self->add_error(\
@errors, $field, $type, $field_val, $ifs_match);
631 ### generic untainter - assuming the other required content_checks did good validation
632 $_ = /(.*)/ ? $1 : die "Couldn't match?" foreach @$values;
633 if ($n_values == 1) {
634 $form->{$field} = $values->[0];
635 $self->{cgi_object
}->param(-name
=> $field, -value
=> $values->[0])
636 if $self->{cgi_object
};
638 ### values in @{ $form->{$field} } were modified directly
639 $self->{cgi_object
}->param(-name
=> $field, -value
=> $values)
640 if $self->{cgi_object
};
645 ### all done - time to return
646 return wantarray ? @errors : $#errors + 1;
649 ### simple error adder abstraction
656 ### allow for multiple validations in the same hash
657 ### ie Match, Match1, Match2, Match234
661 my $order = shift || die "Missing order array";
664 push @array, $_ if /^\Q$type\E_?\d*$/;
666 return wantarray ? @array : $#array + 1;
669 ###----------------------------------------------------------------###
671 ### used to validate specific types
675 my $type = uc(shift);
677 ### do valid email address for our system
678 if ($type eq 'EMAIL') {
679 return 0 if ! $value;
680 my($local_p,$dom) = ($value =~ /^(.+)\@(.+?)$/) ? ($1,$2) : return 0;
682 return 0 if length($local_p) > 60;
683 return 0 if length($dom) > 100;
684 return 0 if ! $self->check_type($dom,'DOMAIN') && ! $self->check_type($dom,'IP');
685 return 0 if ! $self->check_type($local_p,'LOCAL_PART');
687 ### the "username" portion of an email address
688 } elsif ($type eq 'LOCAL_PART') {
689 return 0 if ! defined($value) || ! length($value);
690 return 0 if $value =~ m/[^a-z0-9.\-\!\&]/;
691 return 0 if $value =~ m/^[\.\-]/;
692 return 0 if $value =~ m/[\.\-\&]$/;
693 return 0 if $value =~ m/(\.\-|\-\.|\.\.)/;
695 ### standard IP address
696 } elsif ($type eq 'IP') {
697 return 0 if ! $value;
698 return (4 == grep {!/\D/ && $_ < 256} split /\./, $value, 4);
700 ### domain name - including tld and subdomains (which are all domains)
701 } elsif ($type eq 'DOMAIN') {
702 return 0 if ! $value;
703 return 0 if $value =~ m/[^a-z0-9.\-]/;
704 return 0 if $value =~ m/^[\.\-]/;
705 return 0 if $value =~ m/(\.\-|\-\.|\.\.)/;
706 return 0 if length($value) > 255;
707 return 0 if $value !~ s/\.([a-z]+)$//;
710 if ($ext eq 'name') { # .name domains
711 return 0 if $value !~ /^[a-z0-9][a-z0-9\-]{0,62} \. [a-z0-9][a-z0-9\-]{0,62}$/x;
712 } else { # any other domains
713 return 0 if $value !~ /^([a-z0-9][a-z0-9\-]{0,62} \.)* [a-z0-9][a-z0-9\-]{0,62}$/x;
717 } elsif ($type eq 'URL') {
718 return 0 if ! $value;
719 $value =~ s
|^https
?://([^/]+)||i
|| return 0;
721 return 0 if ! $self->check_type($dom,'DOMAIN') && ! $self->check_type($dom,'IP');
722 return 0 if $value && ! $self->check_type($value,'URI');
724 ### validate a uri - the path portion of a request
725 } elsif ($type eq 'URI') {
726 return 0 if ! $value;
727 return 0 if $value =~ m/\s+/;
729 } elsif ($type eq 'CC') {
730 return 0 if ! $value;
731 ### validate the number
732 return 0 if $value =~ /[^\d\-\ ]/
733 || length($value) > 16
734 || length($value) < 13;
736 ### simple mod10 check
740 foreach my $digit ( reverse split //, $value ){
741 $switch = 1 if ++ $switch > 2;
742 my $y = $digit * $switch;
746 return 0 if $sum % 10;
753 ###----------------------------------------------------------------###
758 return $self->conf->read($val, {html_key
=> 'validation'});
761 ### returns all keys from all groups - even if group has validate_if
762 sub get_validation_keys
{
764 my $val_hash = shift;
765 my $form = shift; # with optional form - will only return keys in validated groups
768 ### if a form was passed - make sure it is a hashref
771 die "Invalid form hash or cgi object";
772 } elsif(! UNIVERSAL
::isa
($form,'HASH')) {
774 $form = CGI
::Ex-
>new->get_form($form);
778 my $refs = $self->get_validation($val_hash);
779 $refs = [$refs] if ! UNIVERSAL
::isa
($refs,'ARRAY');
780 foreach my $group_val (@$refs) {
781 die "Group found that was not a hashref" if ! UNIVERSAL
::isa
($group_val, 'HASH');
783 ### if form is passed, check to see if the group passed validation
785 my $validate_if = $group_val->{'group validate_if'};
786 next if $validate_if && ! $self->check_conditional($form, $validate_if);
789 if ($group_val->{"group fields"}) {
790 die "Group fields must be an arrayref" if ! UNIVERSAL
::isa
($group_val->{"group fields"}, 'ARRAY');
791 foreach my $field_val (@{ $group_val->{"group fields"} }) {
792 next if ! ref($field_val) && $field_val eq 'OR';
793 die "Field_val must be a hashref" if ! UNIVERSAL
::isa
($field_val, 'HASH');
794 my $key = $field_val->{'field'} || die "Missing field key in field_val hashref";
795 $keys{$key} = $field_val->{'name'} || 1;
797 } elsif ($group_val->{"group order"}) {
798 die "Group order must be an arrayref" if ! UNIVERSAL
::isa
($group_val->{"group order"}, 'ARRAY');
799 foreach my $key (@{ $group_val->{"group order"} }) {
800 my $field_val = $group_val->{$key};
801 next if ! $field_val && $key eq 'OR';
802 die "Field_val for $key must be a hashref" if ! UNIVERSAL
::isa
($field_val, 'HASH');
803 $key = $field_val->{'field'} if $field_val->{'field'};
804 $keys{$key} = $field_val->{'name'} || 1;
809 foreach my $key (keys %$group_val) {
810 next if $key =~ /^(general|group)\s/;
811 my $field_val = $group_val->{$key};
812 next if ! UNIVERSAL
::isa
($field_val, 'HASH');
813 $keys{$key} = $field_val->{'name'} || 1;
820 ###----------------------------------------------------------------###
822 ### spit out a chunk that will do the validation
824 ### allow for some browsers to not receive the validation
825 if ($ENV{HTTP_USER_AGENT
}) {
826 foreach (@UNSUPPORTED_BROWSERS) {
827 next if $ENV{HTTP_USER_AGENT
} !~ $_;
828 return "<!-- JS Validation not supported in this browser $_ -->"
833 my $val_hash = shift || die "Missing validation";
834 my $form_name = shift || die "Missing form name";
835 my $js_uri_path = shift || $JS_URI_PATH;
836 $val_hash = $self->get_validation($val_hash);
839 ### store any extra items from self
841 foreach my $key (keys %$self) {
842 next if $key !~ $QR_EXTRA;
843 $EXTRA{"general $key"} = $self->{$key};
846 my $str = &YAML
::Dump
((scalar keys %EXTRA) ? (\
%EXTRA) : () , $val_hash);
847 $str =~ s/(?<!\\)\\(?=[sSdDwWbB0-9?.*+|\-\^\${}()\[\]])/\\\\/g;
848 $str =~ s/\n/\\n\\\n/g; # allow for one big string
849 $str =~ s/\"/\\\"/g; # quotify it
852 my $js_uri_path_yaml = $JS_URI_PATH_YAML || do {
853 die "Missing \$js_uri_path" if ! $js_uri_path;
854 "$js_uri_path/CGI/Ex/yaml_load.js";
856 my $js_uri_path_validate = $JS_URI_PATH_VALIDATE || do {
857 die "Missing \$js_uri_path" if ! $js_uri_path;
858 "$js_uri_path/CGI/Ex/validate.js";
861 ### return the string
862 return qq{<script src="$js_uri_path_yaml"></script>
863 <script src="$js_uri_path_validate"></script>
865 document.validation = "$str";
866 if (document.check_form) document.check_form("$form_name");
872 ###----------------------------------------------------------------###
873 ### How to handle errors
875 package CGI
::Ex
::Validate
::Error
;
878 use overload
'""' => \
&as_string
;
881 my $class = shift || __PACKAGE__
;
883 my $extra = shift || {};
884 die "Missing or invalid arrayref" if ! UNIVERSAL
::isa
($errors, 'ARRAY');
885 die "Missing or invalid hashref" if ! UNIVERSAL
::isa
($extra, 'HASH');
886 return bless {errors
=> $errors, extra
=> $extra}, $class;
891 my $extra = $self->{extra
} || {};
892 my $extra2 = shift || {};
894 ### allow for formatting
895 my $join = defined($extra2->{as_string_join
}) ? $extra2->{as_string_join
}
896 : defined($extra->{as_string_join
}) ? $extra->{as_string_join
}
898 my $header = defined($extra2->{as_string_header
}) ? $extra2->{as_string_header
}
899 : defined($extra->{as_string_header
}) ? $extra->{as_string_header
} : "";
900 my $footer = defined($extra2->{as_string_footer
}) ? $extra2->{as_string_footer
}
901 : defined($extra->{as_string_footer
}) ? $extra->{as_string_footer
} : "";
903 return $header . join($join, @{ $self->as_array($extra2) }) . $footer;
906 ### return an array of applicable errors
909 my $errors = $self->{errors
} || die "Missing errors";
910 my $extra = $self->{extra
} || {};
911 my $extra2 = shift || {};
913 my $title = defined($extra2->{as_array_title
}) ? $extra2->{as_array_title
}
914 : defined($extra->{as_array_title
}) ? $extra->{as_array_title
}
915 : "Please correct the following items:";
917 ### if there are heading items then we may end up needing a prefix
929 my $prefix = defined($extra2->{as_array_prefix
}) ? $extra2->{as_array_prefix
}
930 : defined($extra->{as_array_prefix
}) ? $extra->{as_array_prefix
}
931 : $has_headings ? ' ' : '';
933 ### get the array ready
935 push @array, $title if length $title;
939 foreach my $err (@$errors) {
944 my $text = $self->get_error_text($err);
945 next if $found{$text};
947 push @array, "$prefix$text";
954 ### return a hash of applicable errors
957 my $errors = $self->{errors
} || die "Missing errors";
958 my $extra = $self->{extra
} || {};
959 my $extra2 = shift || {};
961 my $suffix = defined($extra2->{as_hash_suffix
}) ? $extra2->{as_hash_suffix
}
962 : defined($extra->{as_hash_suffix
}) ? $extra->{as_hash_suffix
} : '_error';
963 my $join = defined($extra2->{as_hash_join
}) ? $extra2->{as_hash_join
}
964 : defined($extra->{as_hash_join
}) ? $extra->{as_hash_join
} : '<br />';
966 ### now add to the hash
969 foreach my $err (@$errors) {
972 my ($field, $type, $field_val, $ifs_match) = @$err;
973 die "Missing field name" if ! $field;
974 if ($field_val->{delegate_error
}) {
975 $field = $field_val->{delegate_error
};
976 $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
979 my $text = $self->get_error_text($err);
980 next if $found{$field}->{$text};
981 $found{$field}->{$text} = 1;
984 $return{$field} ||= [];
985 $return{$field} = [$return{$field}] if ! ref($return{$field});
986 push @{ $return{$field} }, $text;
989 ### allow for elements returned as
991 my $header = defined($extra2->{as_hash_header
}) ? $extra2->{as_hash_header
}
992 : defined($extra->{as_hash_header
}) ? $extra->{as_hash_header
} : "";
993 my $footer = defined($extra2->{as_hash_footer
}) ? $extra2->{as_hash_footer
}
994 : defined($extra->{as_hash_footer
}) ? $extra->{as_hash_footer
} : "";
995 foreach my $key (keys %return) {
996 $return{$key} = $header . join($join,@{ $return{$key} }) . $footer;
1003 ### return a user friendly error message
1004 sub get_error_text
{
1007 my $extra = $self->{extra
} || {};
1008 my ($field, $type, $field_val, $ifs_match) = @$err;
1009 my $dig = ($type =~ s/(_?\d+)$//) ? $1 : '';
1010 my $type_lc = lc($type);
1012 ### allow for delegated field names - only used for defaults
1013 if ($field_val->{delegate_error
}) {
1014 $field = $field_val->{delegate_error
};
1015 $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
1018 ### the the name of this thing
1019 my $name = $field_val->{'name'} || "The field $field";
1020 $name =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
1022 ### type can look like "required" or "required2" or "required100023"
1023 ### allow for fallback from required100023_error through required_error
1024 my @possible_error_keys = ("${type}_error");
1025 unshift @possible_error_keys, "${type}${dig}_error" if length($dig);
1027 ### look in the passed hash or self first
1029 foreach my $key (@possible_error_keys){
1030 $return = $field_val->{$key} || $extra->{$key} || next;
1031 $return =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
1032 $return =~ s/\$field/$field/g;
1033 $return =~ s/\$name/$name/g;
1034 if (my $value = $field_val->{"$type$dig"}) {
1035 $return =~ s/\$value/$value/g if ! ref $value;
1040 ### set default messages
1042 if ($type eq 'required' || $type eq 'required_if') {
1043 $return = "$name is required.";
1045 } elsif ($type eq 'min_values') {
1046 my $n = $field_val->{"min_values${dig}"};
1047 my $values = ($n == 1) ? 'value' : 'values';
1048 $return = "$name had less than $n $values.";
1050 } elsif ($type eq 'max_values') {
1051 my $n = $field_val->{"max_values${dig}"};
1052 my $values = ($n == 1) ? 'value' : 'values';
1053 $return = "$name had more than $n $values.";
1055 } elsif ($type eq 'enum') {
1056 $return = "$name is not in the given list.";
1058 } elsif ($type eq 'equals') {
1059 my $field2 = $field_val->{"equals${dig}"};
1060 my $name2 = $field_val->{"equals${dig}_name"} || "the field $field2";
1061 $name2 =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
1062 $return = "$name did not equal $name2.";
1064 } elsif ($type eq 'min_len') {
1065 my $n = $field_val->{"min_len${dig}"};
1066 my $char = ($n == 1) ? 'character' : 'characters';
1067 $return = "$name was less than $n $char.";
1069 } elsif ($type eq 'max_len') {
1070 my $n = $field_val->{"max_len${dig}"};
1071 my $char = ($n == 1) ? 'character' : 'characters';
1072 $return = "$name was more than $n $char.";
1074 } elsif ($type eq 'max_in_set') {
1075 my $set = $field_val->{"max_in_set${dig}"};
1076 $return = "Too many fields were chosen from the set ($set)";
1078 } elsif ($type eq 'min_in_set') {
1079 my $set = $field_val->{"min_in_set${dig}"};
1080 $return = "Not enough fields were chosen from the set ($set)";
1082 } elsif ($type eq 'match') {
1083 $return = "$name contains invalid characters.";
1085 } elsif ($type eq 'compare') {
1086 $return = "$name did not fit comparison.";
1088 } elsif ($type eq 'sql') {
1089 $return = "$name did not match sql test.";
1091 } elsif ($type eq 'custom') {
1092 $return = "$name did not match custom test.";
1094 } elsif ($type eq 'type') {
1095 my $_type = $field_val->{"type${dig}"};
1096 $return = "$name did not match type $_type.";
1098 } elsif ($type eq 'untaint') {
1099 $return = "$name cannot be untainted without one of the following checks: enum, equals, match, compare, sql, type, custom";
1101 } elsif ($type eq 'no_extra_fields') {
1102 $return = "$name should not be passed to validate.";
1106 die "Missing error on field $field for type $type$dig" if ! $return;
1111 ###----------------------------------------------------------------###
1120 CGI::Ex::Validate - Yet another form validator - does good javascript too
1122 $Id: Validate.pm,v 1.79 2005/02/23 21:28:11 pauls Exp $
1126 use CGI::Ex::Validate;
1130 my $errobj = CGI::Ex::Validate->new->validate($form, $val_hash);
1134 my $form = CGI->new;
1136 my $form = CGI::Ex->new; # OR CGI::Ex->get_form;
1138 my $form = {key1 => 'val1', key2 => 'val2'};
1143 username => {required => 1,
1145 field => 'username',
1146 # field is optional in this case - will use key name
1148 email => {required => 1,
1151 email2 => {validate_if => 'email'
1158 'group order' => [qw(username email email2)],
1159 username => {required => 1, max_len => 30},
1167 {field => 'username', # field is not optional in this case
1176 validate_if => 'email',
1183 my $vob = CGI::Ex::Validate->new;
1184 my $errobj = $vob->validate($form, $val_hash);
1186 my $errobj = $vob->validate($form, "/somefile/somewhere.val"); # import config using yaml file
1188 my $errobj = $vob->validate($form, "/somefile/somewhere.pl"); # import config using perl file
1190 my $errobj = $vob->validate($form, "--- # a yaml document\n"); # import config using yaml str
1194 my $error_heading = $errobj->as_string; # OR "$errobj";
1195 my $error_list = $errobj->as_array; # ordered list of what when wrong
1196 my $error_hash = $errobj->as_hash; # hash of arrayrefs of errors
1198 # form passed validation
1201 ### will add an error for any form key not found in $val_hash
1202 my $vob = CGI::Ex::Validate->new({no_extra_keys => 1});
1203 my $errobj = $vob->validate($form, $val_hash);
1207 CGI::Ex::Validate is yet another module used for validating input. It
1208 aims to have all of the power of former modules, while advancing them
1209 with more flexibility, external validation files, and identical
1210 javascript validation. CGI::Ex::Validate can work in a simple way
1211 like all of the other validators do. However, it also allows for
1212 grouping of validation items and conditional validaion of groups or
1213 individual items. This is more in line with the normal validation
1214 procedures for a website.
1222 Used to instantiate the object. Arguments are either a hash, or hashref,
1223 or nothing at all. Keys of the hash become the keys of the object.
1225 =item C<get_validation>
1227 Given a filename or YAML string will return perl hash. If more than one
1228 group is contained in the file, it will return an arrayref of hashrefs.
1230 my $ref = $self->get_validation($file);
1232 =item C<get_validation_keys>
1234 Given a filename or YAML string or a validation hashref, will return all
1235 of the possible keys found in the validation hash. This can be used to
1236 check to see if extra items have been passed to validate. If a second
1237 argument contains a form hash is passed, get_validation_keys will only
1238 return the keys of groups that were validated.
1240 my $key_hashref = $self->get_validation_keys($val_hash);
1242 The values of the hash are the names of the fields.
1246 Arguments are a form hashref or cgi object, a validation hashref or filename, and
1247 an optional what_was_validated arrayref.
1248 If a CGI object is passed, CGI::Ex::get_form will be called on that object
1249 to turn it into a hashref. If a filename is given for the validation, get_validation
1250 will be called on that filename. If the what_was_validated_arrayref is passed - it
1251 will be populated (pushed) with the field hashes that were actually validated (anything
1252 that was skipped because of validate_if will not be in the array).
1254 If the form passes validation, validate will return undef. If it fails validation, it
1255 will return a CGI::Ex::Validate::Error object. If the 'raise_error' general option
1256 has been set, validate will die with a CGI::Ex::validate::Error object as the value.
1258 my $err_obj = $self->validate($form, $val_hash);
1262 $self->{raise_error} = 1; # raise error can also be listed in the val_hash
1263 eval { $self->validate($form, $val_hash) };
1268 =item C<generate_js>
1270 Requires YAML to work properly (see L<YAML>).
1272 Takes a validation hash, a form name, and an optional javascript uri
1273 path and returns Javascript that can be embedded on a page and will
1274 perform identical validations as the server side. The validation can
1275 be any validation hash (or arrayref of hashes. The form name must be
1276 the name of the form that the validation will act upon - the name is
1277 used to register an onsubmit function. The javascript uri path is
1278 used to embed the locations two external javascript source files.
1281 The javascript uri path is highly dependent upon the server
1282 implementation and therefore must be configured manually. It may be
1283 passed to generate_js, or it may be specified in $JS_URI_PATH. There
1284 are two files included with this module that are needed -
1285 CGI/Ex/yaml_load.js and CGI/Ex/validate.js. When generating the js
1286 code, generate_js will look in $JS_URI_PATH_YAML and
1287 $JS_URI_PATH_VALIDATE. If either of these are not set, generate_js
1288 will default to "$JS_URI_PATH/CGI/Ex/yaml_load.js" and
1289 "$JS_URI_PATH/CGI/Ex/validate.js".
1291 $self->generate_js($val_hash, 'my_form', "/cgi-bin/js")
1292 # would generate something like the following...
1293 # <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
1294 # <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
1295 # ... more js follows ...
1297 $CGI::Ex::Validate::JS_URI_PATH = "/stock/js";
1298 $CGI::Ex::Validate::JS_URI_PATH_YAML = "/js/yaml_load.js";
1299 $self->generate_js($val_hash, 'my_form')
1300 # would generate something like the following...
1301 # <script src="/js/yaml_load.js"></script>
1302 # <script src="/stock/js/CGI/Ex/validate.js"></script>
1303 # ... more js follows ...
1305 Referencing yaml_load.js and validate.js can be done in any of
1306 several ways. They can be copied to or symlinked to a fixed location
1307 in the servers html directory. They can also be printed out by a cgi.
1308 The method C<-E<gt>print_js> has been provided in CGI::Ex for printing
1309 js files found in the perl heirchy. See L<CGI::Ex> for more details.
1310 The $JS_URI_PATH of "/cgi-bin/js" could contain the following:
1317 ### path_info should contain something like /CGI/Ex/yaml_load.js
1318 my $info = $ENV{PATH_INFO} || '';
1319 die "Invalid path" if $info !~ m|^(/\w+)+.js$|;
1322 CGI::Ex->new->print_js($info);
1325 The print_js method in CGI::Ex is designed to cache the javascript in
1326 the browser (caching is suggested as they are medium sized files).
1330 Returns a CGI::Ex object. Used internally.
1334 Returns a CGI::Ex::Conf object. Used internally.
1338 =head1 VALIDATION HASH
1340 The validation hash may be passed as a perl a hashref or
1341 as a filename, or as a YAML document string. If it is a filename,
1342 it will be translated into a hash using the %EXT_HANDLER for the
1343 extension on the file. If there is no extension, it will use $DEFAULT_EXT
1346 The validation hash may also be an arrayref of hashrefs. In this
1347 case, each arrayref is treated as a group and is validated separately.
1351 Each hashref that is passed as a validation hash is treated as a
1352 group. Keys matching the regex m/^group\s+(\w+)$/ are reserved and
1353 are counted as GROUP OPTIONS. Keys matching the regex m/^general\s+(\w+)$/
1354 are reserved and are counted as GENERAL OPTIONS. Other keys (if
1355 any, should be keys that need validation).
1357 If the GROUP OPTION 'group validate_if' is set, the group will only
1358 be validated if the conditions are met. Any group with out a validate_if
1359 fill be automatically validated.
1361 Each of the items listed in the group will be validated. The
1362 validation order is determined in one of three ways:
1366 =item Specify 'group fields' arrayref.
1368 # order will be (username, password, 'm/\w+_foo/', somethingelse)
1370 'group title' => "User Information",
1372 {field => 'username', required => 1},
1373 {field => 'password', required => 1},
1374 {field => 'm/\w+_foo/', required => 1},
1376 somethingelse => {required => 1},
1379 =item Specify 'group order' arrayref.
1381 # order will be (username, password, 'm/\w+_foo/', somethingelse)
1383 'group title' => "User Information",
1384 'group order' => [qw(username password), 'm/\w+_foo/'],
1385 username => {required => 1},
1386 password => {required => 1},
1387 'm/\w+_foo/' => {required => 1},
1388 somethingelse => {required => 1},
1391 =item Do nothing - use sorted order.
1393 # order will be ('m/\w+_foo/', password, somethingelse, username)
1395 'group title' => "User Information",
1396 username => {required => 1},
1397 password => {required => 1},
1398 'm/\w+_foo/' => {required => 1},
1399 somethingelse => {required => 1},
1404 Each of the individual field validation hashrefs should contain
1405 the types listed in VALIDATION TYPES.
1407 Optionally the 'group fields' or the 'group order' may contain the word
1408 'OR' as a special keyword. If the item preceding 'OR' fails validation
1409 the item after 'OR' will be tested instead. If the item preceding 'OR'
1410 passes validation the item after 'OR' will not be tested.
1412 'group order' => [qw(zip OR postalcode state OR region)],
1414 Each individual validation hashref will operate on the field contained
1415 in the 'field' key. This key may also be a regular expression in the
1416 form of 'm/somepattern/'. If a regular expression is used, all keys
1417 matching that pattern will be validated.
1419 =head1 VALIDATION TYPES
1421 The following are the available validation types. Multiple instances of
1422 the same type may be used by adding a number to the type (ie match, match2,
1423 match232, match_94). Multiple instances are validated in sorted order.
1427 =item C<validate_if>
1429 If validate_if is specified, the field will only be validated
1430 if the conditions are met. Works in JS.
1432 validate_if => {field => 'name', required => 1, max_len => 30}
1433 # Will only validate if the field "name" is present and is less than 30 chars.
1435 validate_if => 'name',
1437 validate_if => {field => 'name', required => 1},
1439 validate_if => '! name',
1441 validate_if => {field => 'name', max_in_set => '0 of name'},
1443 validate_if => {field => 'country', compare => "eq US"},
1444 # only if country's value is equal to US
1446 validate_if => {field => 'country', compare => "ne US"},
1447 # if country doesn't equal US
1449 validate_if => {field => 'password', match => 'm/^md5\([a-z0-9]{20}\)$/'},
1450 # if password looks like md5(12345678901234567890)
1453 field => 'm/^(\w+)_pass/',
1454 validate_if => '$1_user',
1457 # will validate foo_pass only if foo_user was present.
1459 The validate_if may also contain an arrayref of validation items. So that
1460 multiple checks can be run. They will be run in order. validate_if will
1461 return true only if all options returned true.
1463 validate_if => ['email', 'phone', 'fax']
1465 Optionally, if validate_if is an arrayref, it may contain the word
1466 'OR' as a special keyword. If the item preceding 'OR' fails validation
1467 the item after 'OR' will be tested instead. If the item preceding 'OR'
1468 passes validation the item after 'OR' will not be tested.
1470 validate_if => [qw(zip OR postalcode)],
1472 =item C<required_if>
1474 Requires the form field if the condition is satisfied. The conditions
1475 available are the same as for validate_if. This is somewhat the same
1478 validate_if => 'some_condition',
1481 required_if => 'some_condition',
1484 field => 'm/^(\w+)_pass/',
1485 required_if => '$1_user',
1490 Requires the form field to have some value. If the field is not present,
1491 no other checks will be run.
1493 =item C<min_values> and C<max_values>
1495 Allows for specifying the maximum number of form elements passed.
1496 max_values defaults to 1 (You must explicitly set it higher
1497 to allow more than one item by any given name).
1499 =item C<min_in_set> and C<max_in_set>
1501 Somewhat like min_values and max_values except that you specify the
1502 fields that participate in the count. Also - entries that are not
1503 defined or do not have length are not counted. An optional "of" can
1504 be placed after the number for human readibility.
1506 min_in_set => "2 of foo bar baz",
1507 # two of the fields foo, bar or baz must be set
1509 min_in_set => "2 foo bar baz",
1511 min_in_set => "2 OF foo bar baz",
1513 validate_if => {field => 'whatever', max_in_set => '0 of whatever'},
1514 # only run validation if there were zero occurances of whatever
1518 Allows for checking whether an item matches a set of options. In perl
1519 the value may be passed as an arrayref. In the conf or in perl the
1520 value may be passed of the options joined with ||.
1523 field => 'password_type',
1524 enum => 'plaintext||crypt||md5', # OR enum => [qw(plaintext crypt md5)],
1529 Allows for comparison of two form elements. Can have an optional !.
1532 field => 'password',
1533 equals => 'password_verify',
1537 equals => '!domain2', # make sure the fields are not the same
1540 =item C<min_len and max_len>
1542 Allows for check on the length of fields
1552 Allows for regular expression comparison. Multiple matches may
1553 be concatenated with ||. Available in JS.
1557 match => 'm/^\d{1,3}(\.\d{1,3})3$/',
1558 match_2 => '!/^0\./ || !/^192\./',
1563 Allows for custom comparisons. Available types are
1564 >, <, >=, <=, !=, ==, gt, lt, ge, le, ne, and eq. Comparisons
1565 also work in the JS.
1568 field => 'my_number',
1569 match => 'm/^\d+$/',
1570 compare1 => '> 100',
1571 compare2 => '< 255',
1572 compare3 => '!= 150',
1577 SQL query based - not available in JS. The database handle will be looked
1578 for in the value $self->{dbhs}->{foo} if sql_db_type is set to 'foo',
1579 otherwise it will default to $self->{dbh}. If $self->{dbhs}->{foo} or
1580 $self->{dbh} is a coderef - they will be called and should return a dbh.
1583 field => 'username',
1584 sql => 'SELECT COUNT(*) FROM users WHERE username = ?',
1585 sql_error_if => 1, # default is 1 - set to 0 to negate result
1586 # sql_db_type => 'foo', # will look for a dbh under $self->{dbhs}->{foo}
1591 Custom value - not available in JS. Allows for extra programming types.
1592 May be either a boolean value predetermined before calling validate, or may be
1593 a coderef that will be called during validation. If coderef is called, it will
1594 be passed the field name, the form value for that name, and a reference to the
1595 field validation hash. If the custom type returns false the element fails
1596 validation and an error is added.
1599 field => 'username',
1601 my ($key, $val, $type, $field_val_hash) = @_;
1609 Custom value - only available in JS. Allows for extra programming types.
1610 May be either a boolean value predermined before calling validate, or may be
1611 section of javascript that will be eval'ed. The last value (return value) of
1612 the eval'ed javascript will determine if validation passed. A false value indicates
1613 the value did not pass validation. A true value indicates that it did. See
1614 the t/samples/js_validate_3.html page for a sample of usage.
1619 match => 'm|^\d\d\d\d/\d\d/\d\d$|',
1620 match_error => 'Please enter date in YYYY/MM/DD format',
1623 var y=t.getYear()+1900;
1624 var m=t.getMonth() + 1;
1626 if (m<10) m = '0'+m;
1627 if (d<10) d = '0'+d;
1628 (value > ''+y+'/'+m+'/'+d) ? 1 : 0;
1630 custom_js_error => 'The date was not greater than today.',
1635 Allows for more strict type checking. Many types will be added and
1636 will be available from javascript as well. Currently support types
1640 field => 'credit_card',
1646 =head1 SPECIAL VALIDATION TYPES
1652 Specify which field to work on. Key may be a regex in the form 'm/\w+_user/'.
1653 This key is required if 'group fields' is used or if validate_if or required_if
1654 are used. It can optionally be used with other types to specify a different form
1655 element to operate on. On errors, if a non-default error is found, $field
1656 will be swapped with the value found in field.
1658 The field name may also be a regular expression in the
1659 form of 'm/somepattern/'. If a regular expression is used, all keys
1660 matching that pattern will be validated.
1664 Name to use for errors. If a name is not specified, default errors will use
1665 "The field $field" as the name. If a non-default error is found, $name
1666 will be swapped with this name.
1668 =item C<delegate_error>
1670 This option allows for any errors generated on a field to delegate to
1671 a different field. If the field name was a regex, any patterns will
1672 be swapped into the delegate_error value. This option is generally only
1673 useful with the as_hash method of the error object (for inline errors).
1677 match => 'm/^\d{5}/',
1680 field => 'zip_plus4',
1681 match => 'm/^\d{4}/',
1682 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
1718 =item C<do_not_trim>
1720 By default, validate will trim leading and trailing whitespace
1721 from submitted values. Set do_not_trim to 1 to allow it to
1724 {field => 'foo', do_not_trim => 1}
1728 Pass a swap pattern to change the actual value of the form.
1729 Any perl regex can be passed.
1731 {field => 'foo', replace => 's/(\d{3})(\d{3})(\d{3})/($1) $2-$3/'}
1735 Set item to default value if there is no existing value (undefined
1736 or zero length string). Maybe someday well add default_if (but that
1737 would require some odd syntax for both the conditional and the default).
1739 {field => 'country', default => 'EN'}
1741 =item C<to_upper_case> and C<to_lower_case>
1743 Do what they say they do.
1747 Requires that the validated field has been also checked with
1748 an enum, equals, match, compare, custom, or type check. If the
1749 field has been checked and there are no errors - the field is "untainted."
1751 This is for use in conjunction with the -T switch.
1757 Failed validation results in an error object blessed into the class found in
1758 $ERROR_PACKAGE - which defaults to CGI::Ex::Validate::Error.
1760 The error object has several methods for determining what the errors were.
1766 Returns an array or arrayref (depending on scalar context) of errors that
1767 occurred in the order that they occured. Individual groups may have a heading
1768 and the entire validation will have a heading (the default heading can be changed
1769 via the 'as_array_title' general option). Each error that occured is a separate
1770 item and are prepended with 'as_array_prefix' (which is a general option - default
1771 is ' '). The as_array_ options may also be set via a hashref passed to as_array.
1772 as_array_title defaults to 'Please correct the following items:'.
1774 ### if this returns the following
1775 my $array = $err_obj->as_array;
1777 # ['Please correct the following items:', ' error1', ' error2']
1779 ### then this would return the following
1780 my $array = $err_obj->as_array({
1781 as_array_prefix => ' - ',
1782 as_array_title => 'Something went wrong:',
1785 # ['Something went wrong:', ' - error1', ' - error2']
1789 Returns values of as_array joined with a newline. This method is used as
1790 the stringification for the error object. Values of as_array are joined with
1791 'as_string_join' which defaults to "\n". If 'as_string_header' is set, it will
1792 be prepended onto the error string. If 'as_string_footer' is set, it will be
1793 postpended onto the error string.
1795 ### if this returns the following
1796 my $string = $err_obj->as_string;
1797 # $string looks like
1798 # "Please correct the following items:\n error1\n error2"
1800 ### then this would return the following
1801 my $string = $err_obj->as_string({
1802 as_array_prefix => ' - ',
1803 as_array_title => 'Something went wrong:',
1804 as_string_join => '<br />',
1805 as_string_header => '<span class="error">',
1806 as_string_footer => '</span>',
1808 # $string looks like
1809 # '<span class="error">Something went wrong:<br /> - error1<br /> - error2</span>'
1813 Returns a hash or hashref (depending on scalar context) of errors that
1814 occurred. Each key is the field name of the form that failed validation with
1815 'as_hash_suffix' added on as a suffix. as_hash_suffix is available as a general option
1816 and may also be passed in via a hashref as the only argument to as_hash.
1817 The default value is '_error'. The values of the hash are arrayrefs of errors
1818 that occured to that form element.
1820 By default as_hash will return the values of the hash as arrayrefs (a list of the errors
1821 that occured to that key). It is possible to also return the values as strings.
1822 Three options are available for formatting: 'as_hash_header' which will be prepended
1823 onto the error string, 'as_hash_footer' which will be postpended, and 'as_hash_join' which
1824 will be used to join the arrayref. The only argument required to force the
1825 stringification is 'as_hash_join'.
1827 ### if this returns the following
1828 my $hash = $err_obj->as_hash;
1830 # {key1_error => ['error1', 'error2']}
1832 ### then this would return the following
1833 my $hash = $err_obj->as_hash({
1834 as_hash_suffix => '_foo',
1835 as_hash_join => '<br />',
1836 as_hash_header => '<span class="error">'
1837 as_hash_footer => '</span>'
1840 # {key1_foo => '<span class="error">error1<br />error2</span>'}
1844 =head1 GROUP OPTIONS
1846 Any key in a validation hash matching the pattern m/^group\s+(\w+)$/
1847 is considered a group option. The current know options are:
1851 =item C<'group title'>
1853 Used as a group section heading when as_array or as_string is called
1854 by the error object.
1856 =item C<'group order'>
1858 Order in which to validate key/value pairs of group.
1860 =item C<'group fields'>
1862 Arrayref of validation items to validate.
1864 =item C<'group validate_if'>
1866 Conditions that will be checked to see if the group should be validated.
1867 If no validate_if option is found, the group will be validated.
1871 =head1 GENERAL OPTIONS
1873 Any key in a validation hash matching the pattern m/^general\s+(\w+)$/
1874 is considered a general option. General options will also be looked
1875 for in the Validate object ($self) and can be set when instantiating
1876 the object ($self->{raise_error} is equivalent to
1877 $valhash->{'general raise_error'}). The current know options are:
1879 General options may be set in any group using the syntax:
1881 'general general_option_name' => 'general_option_value'
1883 They will only be set if the group's validate_if is successful or
1884 if the group does not have a validate_if. It is also possible to set
1885 a "group general" option using the following syntax:
1887 'group general_option_name' => 'general_option_value'
1889 These items will only be set if the group fails validation.
1890 If a group has a validate_if block and passes validation, the group
1891 items will not be used. This is so that a failed section can have
1892 its own settings. Note though that the last option found will be
1893 used and that items set in $self override those set in the validation
1896 Options may also be set globally before calling validate by
1897 populating the %DEFAULT_OPTIONS global hash.
1901 =item C<'general raise_error'>
1903 If raise_error is true, any call to validate that fails validation
1904 will die with an error object as the value.
1906 =item C<'general no_extra_fields'>
1908 If no_extra_fields is true, validate will add errors for any field found
1909 in form that does not have a field_val hashref in the validation hash.
1910 Default is false. If no_extra_fields is set to 'used', it will check for
1911 any keys that were not in a group that was validated.
1913 An important exception to this is that field_val hashrefs or field names listed
1914 in a validate_if or required_if statement will not be included. You must
1915 have an explicit entry for each key.
1917 =item C<'general \w+_error'>
1919 These items allow for an override of the default errors.
1921 'general required_error' => '$name is really required',
1922 'general max_len_error' => '$name must be shorter than $value characters',
1924 my $self = CGI::Ex::Validate->new({
1925 max_len_error => '$name must be shorter than $value characters',
1928 =item C<'general as_array_title'>
1930 Used as the section title for all errors that occur, when as_array
1931 or as_string is called by the error object.
1933 =item C<'general as_array_prefix'>
1935 Used as prefix to individual errors that occur, when as_array
1936 or as_string is called by the error object. Each individual error
1937 will be prefixed with this string. Headings will not be prefixed.
1940 =item C<'general as_string_join'>
1942 When as_string is called, the values from as_array will be joined with
1943 as_string_join. Default value is "\n".
1945 =item C<'general as_string_header'>
1947 If set, will be prepended onto the string when as_string is called.
1949 =item C<'general as_string_footer'>
1951 If set, will be prepended onto the string when as_string is called.
1953 =item C<'general as_hash_suffix'>
1955 Added on to key names during the call to as_hash. Default is '_error'.
1957 =item C<'general as_hash_join'>
1959 By default, as_hash will return hashref values that are errors joined with
1960 the default as_hash_join value of <br />. It can also return values that are
1961 arrayrefs of the errors. This can be done by setting as_hash_join to a non-true value
1964 =item C<'general as_hash_header'>
1966 If as_hash_join has been set to a true value, as_hash_header may be set to
1967 a string that will be prepended on to the error string.
1969 =item C<'general as_hash_footer'>
1971 If as_hash_join has been set to a true value, as_hash_footer may be set to
1972 a string that will be postpended on to the error string.
1974 =item C<'general no_inline'>
1976 If set to true, the javascript validation will not attempt to generate inline
1977 errors. Default is true. Inline errors are independent of confirm and alert
1980 =item C<'general no_confirm'>
1982 If set to true, the javascript validation will try to use an alert instead
1983 of a confirm to inform the user of errors. Alert and confirm are independent
1984 or inline errors. Default is false.
1986 =item C<'general no_alert'>
1988 If set to true, the javascript validation will not show an alert box
1989 when errors occur. Default is false. This option only comes into
1990 play if no_confirm is also set. This option is independent of inline
1991 errors. Although it is possible to turn off all errors by setting
1992 no_inline, no_confirm, and no_alert all to 1, it is suggested that at
1993 least one of the error reporting facilities is left on.
1997 It is possible to have a group that contains nothing but general options.
2000 {'general error_title' => 'The following things went wrong',
2001 'general error_prefix' => ' - ',
2002 'general raise_error' => 1,
2003 'general name_suffix' => '_foo_error',
2004 'general required_error' => '$name is required',
2006 {'group title' => 'User Information',
2007 username => {required => 1},
2008 email => {required => 1},
2009 password => {required => 1},
2015 CGI::Ex::Validate provides for having duplicate validation on the
2016 client side as on the server side. Errors can be shown in any
2017 combination of inline and confirm, inline and alert, inline only,
2018 confirm only, alert only, and none. These combinations are controlled
2019 by the general options no_inline, no_confirm, and no_alert.
2020 Javascript validation can be generated for a page using the
2021 C<-E<gt>generate_js> Method of CGI::Ex::Validate. It is also possible
2022 to store the validation inline with the html. This can be done by
2023 giving each of the elements to be validated an attribute called
2024 "validation", or by setting a global javascript variable called
2025 "document.validation" or "var validation". An html file containing this
2026 validation will be read in using CGI::Ex::Conf::read_handler_html.
2028 All inline html validation must be written in yaml.
2030 It is anticipated that the html will contain something like either of the
2033 <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
2034 <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2036 // \n\ allows all browsers to view this as a single string
2037 document.validation = "\n\
2038 general no_confirm: 1\n\
2039 general no_alert: 1\n\
2040 group order: [username, password]\n\
2048 if (document.check_form) document.check_form('my_form_name');
2051 Alternately we can use element attributes:
2053 <form name="my_form_name">
2055 Username: <input type=text size=20 name=username validation="
2059 <span class=error id=username_error>[% username_error %]</span><br>
2061 Password: <input type=text size=20 name=password validation="
2065 <span class=error id=password_error>[% password_error %]</span><br>
2071 <script src="/cgi-bin/js/CGI/Ex/yaml_load.js"></script>
2072 <script src="/cgi-bin/js/CGI/Ex/validate.js"></script>
2074 if (document.check_form) document.check_form('my_form_name');
2077 The read_handler_html from CGI::Ex::Conf will find either of these
2078 types of validation.
2080 If inline errors are asked for, each error that occurs will attempt
2081 to find an html element with its name as the id. For example, if
2082 the field "username" failed validation and created a "username_error",
2083 the javascript would set the html of <span id="username_error"></span>
2084 to the error message.
2086 It is suggested to use something like the following so that you can
2087 have inline javascript validation as well as report validation errors
2088 from the server side as well.
2090 <span class=error id=password_error>[% password_error %]</span><br>
2092 If the javascript fails for some reason, the form should still be able
2093 to submit as normal (fail gracefully).
2095 If the confirm option is used, the errors will be displayed to the user.
2096 If they choose OK they will be able to try and fix the errors. If they
2097 choose cancel, the form will submit anyway and will rely on the server
2098 to do the validation. This is for fail safety to make sure that if the
2099 javascript didn't validate correctly, the user can still submit the data.
2107 This module may be distributed under the same terms as Perl itself.
This page took 0.176675 seconds and 4 git commands to generate.