]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Validate.pm
1 package CGI
::Ex
::Validate
;
3 ###---------------------###
4 # See the perldoc in CGI/Ex/Validate.pod
5 # Copyright 2003-2012 - Paul Seamons
6 # Distributed under the Perl Artistic License without warranty
11 our $VERSION = '2.37';
12 our $QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/;
13 our @UNSUPPORTED_BROWSERS = (qr/MSIE\s+5.0\d/i);
15 our $JS_URI_PATH_VALIDATE;
18 my $class = shift || croak
"Usage: ".__PACKAGE__
."->new";
19 my $self = ref($_[0]) ? shift : {@_};
20 return bless $self, $class;
23 sub cgix
{ shift-
>{'cgix'} ||= do { require CGI
::Ex
; CGI
::Ex-
>new } }
26 my $self = (! ref($_[0])) ? shift-
>new # $class->validate
27 : UNIVERSAL
::isa
($_[0], __PACKAGE__
) ? shift # $self->validate
28 : __PACKAGE__-
>new; # CGI::Ex::Validate::validate
29 my ($form, $val_hash, $what_was_validated) = @_;
31 die "Invalid form hash or cgi object" if ! $form || ! ref $form;
32 $form = $self->cgix->get_form($form) if ref $form ne 'HASH';
34 my ($fields, $ARGS) = $self->get_ordered_fields($val_hash);
37 return if $ARGS->{'validate_if'} && ! $self->check_conditional($form, $ARGS->{'validate_if'});
39 # Finally we have our arrayref of hashrefs that each have their 'field' key
40 # now lets do the validation
41 $self->{'was_checked'} = {};
42 $self->{'was_valid'} = {};
43 $self->{'had_error'} = {};
46 my $hold_error; # hold the error for a moment - to allow for an "OR" operation
48 foreach (my $i = 0; $i < @$fields; $i++) {
49 my $ref = $fields->[$i];
50 if (! ref($ref) && $ref eq 'OR') {
51 $i++ if $found; # if found skip the OR altogether
56 my $field = $ref->{'field'} || die "Missing field key during normal validation";
57 if (! $checked{$field}++) {
58 $self->{'was_checked'}->{$field} = 1;
59 $self->{'was_valid'}->{$field} = 1;
60 $self->{'had_error'}->{$field} = 0;
62 local $ref->{'was_validated'} = 1;
63 my $err = $self->validate_buddy($form, $field, $ref);
64 if ($ref->{'was_validated'} && $what_was_validated) {
65 push @$what_was_validated, $ref;
67 $self->{'was_valid'}->{$field} = 0;
70 # test the error - if errors occur allow for OR - if OR fails use errors from first fail
72 $self->{'was_valid'}->{$field} = 0;
73 $self->{'had_error'}->{$field} = 0;
74 if ($i < $#$fields && ! ref($fields->[$i + 1]) && $fields->[$i + 1] eq 'OR') {
77 push @errors, $hold_error ? @$hold_error : @$err;
84 push(@errors, @$hold_error) if $hold_error; # allow for final OR to work
86 # optionally check for unused keys in the form
87 if ($ARGS->{no_extra_fields
} || $self->{no_extra_fields
}) {
88 my %keys = map { ($_->{'field'} => 1) } @$fields;
89 foreach my $key (sort keys %$form) {
91 push @errors, [$key, 'no_extra_fields', {}, undef];
96 my @copy = grep {/$QR_EXTRA/o} keys %$self;
97 @{ $ARGS }{@copy} = @{ $self }{@copy};
98 unshift @errors, $ARGS->{'title'} if $ARGS->{'title'};
99 my $err_obj = $self->new_error(\
@errors, $ARGS);
100 die $err_obj if $ARGS->{'raise_error'};
107 sub get_ordered_fields
{
108 my ($self, $val_hash) = @_;
110 die "Missing validation hash" if ! $val_hash;
111 if (ref $val_hash ne 'HASH') {
112 $val_hash = $self->get_validation($val_hash) if ref $val_hash ne 'SCALAR' || ! ref $val_hash;
113 die "Validation groups must be a hashref" if ref $val_hash ne 'HASH';
117 my @field_keys = grep { /^(?:group|general)\s+(\w+)/
118 ? do {$ARGS{$1} = $val_hash->{$_} ; 0}
119 : 1 } sort keys %$val_hash;
121 # Look first for items in 'group fields' or 'group order'
123 if (my $ref = $ARGS{'fields'} || $ARGS{'order'}) {
124 my $type = $ARGS{'fields'} ? 'group fields' : 'group order';
125 die "Validation '$type' must be an arrayref when passed" if ! UNIVERSAL
::isa
($ref, 'ARRAY');
126 foreach my $field (@$ref) {
127 die "Non-defined value in '$type'" if ! defined $field;
129 die "Found nonhashref value in '$type'" if ref($field) ne 'HASH';
130 die "Element missing \"field\" key/value in '$type'" if ! defined $field->{'field'};
131 push @$fields, $field;
132 } elsif ($field eq 'OR') {
135 die "No element found in '$type' for $field" if ! exists $val_hash->{$field};
136 die "Found nonhashref value in '$type'" if ref($val_hash->{$field}) ne 'HASH';
137 my $val = $val_hash->{$field};
138 $val = {%$val, field
=> $field} if ! $val->{'field'}; # copy the values to add the key
143 # limit the keys that need to be searched to those not in fields or order
144 my %found = map { ref($_) ? ($_->{'field'} => 1) : () } @$fields;
145 @field_keys = grep { ! $found{$_} } @field_keys;
148 # add any remaining field_vals from our original hash
149 # this is necessary for items that weren't in group fields or group order
150 foreach my $field (@field_keys) {
151 die "Found nonhashref value for field $field" if ref($val_hash->{$field}) ne 'HASH';
152 if (defined $val_hash->{$field}->{'field'}) {
153 push @$fields, $val_hash->{$field};
155 push @$fields, { %{$val_hash->{$field}}, field
=> $field };
159 return ($fields || [], \
%ARGS);
164 return CGI
::Ex
::Validate
::Error-
>new(@_);
167 ### allow for optional validation on groups and on individual items
168 sub check_conditional
{
169 my ($self, $form, $ifs, $ifs_match) = @_;
170 die "Need reference passed to check_conditional" if ! $ifs;
171 $ifs = [$ifs] if ! ref($ifs) || UNIVERSAL
::isa
($ifs,'HASH');
173 local $self->{'_check_conditional'} = 1;
175 # run the if options here
176 # multiple items can be passed - all are required unless OR is used to separate
178 foreach (my $i = 0; $i <= $#$ifs; $i ++) {
179 my $ref = $ifs->[$i];
182 $i ++ if $found; # if found skip the OR altogether
186 if ($ref =~ /^function\s*\(/) {
188 } elsif ($ref =~ /^(.*?)\s+(was_valid|had_error|was_checked)$/) {
189 $ref = {field
=> $1, $2 => 1};
190 } elsif ($ref =~ s/^\s*!\s*//) {
191 $ref = {field
=> $ref, max_in_set
=> "0 of $ref"};
193 $ref = {field
=> $ref, required
=> 1};
199 # get the field - allow for custom variables based upon a match
200 my $field = $ref->{'field'} || die "Missing field key during validate_if (possibly used a reference to a main hash *foo -> &foo)";
201 $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
203 my $errs = $self->validate_buddy($form, $field, $ref);
210 ### this is where the main checking goes on
212 my ($self, $form, $field, $field_val, $ifs_match) = @_;
213 local $self->{'_recurse'} = ($self->{'_recurse'} || 0) + 1;
214 die "Max dependency level reached 10" if $self->{'_recurse'} > 10;
217 if ($field_val->{'exclude_cgi'}) {
218 delete $field_val->{'was_validated'};
222 # allow for field names that contain regular expressions
223 if ($field =~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) {
224 my ($not,$pat,$opt) = ($1,$3,$4);
226 die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/;
227 foreach my $_field (sort keys %$form) {
228 next if ($not && $_field =~ m/(?$opt:$pat)/) || (! $not && $_field !~ m/(?$opt:$pat)/);
229 my @match = (undef, $1, $2, $3, $4, $5); # limit to the matches
230 my $errs = $self->validate_buddy($form, $_field, $field_val, \
@match);
231 push @errors, @$errs if $errs;
233 return @errors ? \
@errors : 0;
236 if ($field_val->{'was_valid'} && ! $self->{'was_valid'}->{$field}) { return [[$field, 'was_valid', $field_val, $ifs_match]]; }
237 if ($field_val->{'had_error'} && ! $self->{'had_error'}->{$field}) { return [[$field, 'had_error', $field_val, $ifs_match]]; }
238 if ($field_val->{'was_checked'} && ! $self->{'was_checked'}->{$field}) { return [[$field, 'was_checked', $field_val, $ifs_match]]; }
240 # allow for default value
241 if (defined($field_val->{'default'})
242 && (!defined($form->{$field})
243 || (UNIVERSAL
::isa
($form->{$field},'ARRAY') ? !@{ $form->{$field} } : !length($form->{$field})))) {
244 $form->{$field} = $field_val->{'default'};
247 my $values = UNIVERSAL
::isa
($form->{$field},'ARRAY') ? $form->{$field} : [$form->{$field}];
248 my $n_values = @$values;
250 # allow for a few form modifiers
252 foreach my $value (@$values) {
253 next if ! defined $value;
254 if (! $field_val->{'do_not_trim'}) { # whitespace
255 $modified = 1 if $value =~ s/( ^\s+ | \s+$ )//xg;
257 if ($field_val->{'trim_control_chars'}) {
258 $modified = 1 if $value =~ y/\t/ /;
259 $modified = 1 if $value =~ y/\x00-\x1F//d;
261 if ($field_val->{'to_upper_case'}) { # uppercase
264 } elsif ($field_val->{'to_lower_case'}) { # lowercase
271 foreach (sort keys %$field_val) {
272 push @{$types{$1}}, $_ if /^ (compare|custom|equals|match|max_in_set|min_in_set|replace|required_if|sql|type|validate_if) _?\d* $/x;
275 # allow for inline specified modifications (ie s/foo/bar/)
276 if ($types{'replace'}) { foreach my $type (@{ $types{'replace'} }) {
277 my $ref = UNIVERSAL
::isa
($field_val->{$type},'ARRAY') ? $field_val->{$type}
278 : [split(/\s*\|\|\s*/,$field_val->{$type})];
279 foreach my $rx (@$ref) {
280 if ($rx !~ m/^\s*s([^\s\w])(.+)\1(.*)\1([eigsmx]*)$/s) {
281 die "Not sure how to parse that replace ($rx)";
283 my ($pat, $swap, $opt) = ($2, $3, $4);
284 die "The e option cannot be used in swap on field $field" if $opt =~ /e/;
285 my $global = $opt =~ s/g//g;
287 my $expand = sub { # code similar to Template::Alloy::VMethod::vmethod_replace
288 my ($text, $start, $end) = @_;
290 $copy =~ s
{ \\(\\|\
$) | \
$ (\d
+) }{
292 : ($2 > $#$start || $2 == 0) ? ''
293 : substr($text, $start->[$2], $end->[$2] - $start->[$2]);
298 foreach my $value (@$values) {
299 if ($global) { $value =~ s{(?$opt:$pat)}{ $expand->($value, [@-], [@+]) }eg }
300 else { $value =~ s{(?$opt:$pat)}{ $expand->($value, [@-], [@+]) }e }
304 $form->{$field} = $values->[0] if $modified && $n_values == 1; # put them back into the form if we have modified it
306 # only continue if a validate_if is not present or passes test
309 if ($types{'validate_if'}) { foreach my $type (@{ $types{'validate_if'} }) {
311 my $ifs = $field_val->{$type};
312 my $ret = $self->check_conditional($form, $ifs, $ifs_match);
313 $needs_val++ if $ret;
315 if (! $needs_val && $n_vif) {
316 delete $field_val->{'was_validated'};
320 # check for simple existence
321 # optionally check only if another condition is met
322 my $is_required = $field_val->{'required'} ? 'required' : '';
323 if (! $is_required) {
324 if ($types{'required_if'}) { foreach my $type (@{ $types{'required_if'} }) {
325 my $ifs = $field_val->{$type};
326 next if ! $self->check_conditional($form, $ifs, $ifs_match);
327 $is_required = $type;
332 && ($n_values == 0 || ($n_values == 1 && (! defined($values->[0]) || ! length $values->[0])))) {
333 return [] if $self->{'_check_conditional'};
334 return [[$field, $is_required, $field_val, $ifs_match]];
337 my $n = exists($field_val->{'min_values'}) ? $field_val->{'min_values'} || 0 : 0;
338 if ($n_values < $n) {
339 return [] if $self->{'_check_conditional'};
340 return [[$field, 'min_values', $field_val, $ifs_match]];
343 $field_val->{'max_values'} = 1 if ! exists $field_val->{'max_values'};
344 $n = $field_val->{'max_values'} || 0;
345 if ($n_values > $n) {
346 return [] if $self->{'_check_conditional'};
347 return [[$field, 'max_values', $field_val, $ifs_match]];
350 foreach ([min
=> $types{'min_in_set'}],
351 [max
=> $types{'max_in_set'}]) {
352 my $keys = $_->[1] || next;
353 my $minmax = $_->[0];
354 foreach my $type (@$keys) {
355 $field_val->{$type} =~ m/^\s*(\d+)(?i:\s*of)?\s+(.+)\s*$/
356 || die "Invalid ${minmax}_in_set check $field_val->{$type}";
358 foreach my $_field (split /[\s,]+/, $2) {
359 my $ref = UNIVERSAL
::isa
($form->{$_field},'ARRAY') ? $form->{$_field} : [$form->{$_field}];
360 foreach my $_value (@$ref) {
361 $n -- if defined($_value) && length($_value);
364 if ( ($minmax eq 'min' && $n > 0)
365 || ($minmax eq 'max' && $n < 0)) {
366 return [] if $self->{'_check_conditional'};
367 return [[$field, $type, $field_val, $ifs_match]];
372 # at this point @errors should still be empty
373 my $content_checked; # allow later for possible untainting (only happens if content was checked)
375 OUTER
: foreach my $value (@$values) {
377 if (exists $field_val->{'enum'}) {
378 my $ref = ref($field_val->{'enum'}) ? $field_val->{'enum'} : [split(/\s*\|\|\s*/,$field_val->{'enum'})];
381 $found = 1 if defined($value) && $_ eq $value;
384 return [] if $self->{'_check_conditional'};
385 push @errors, [$field, 'enum', $field_val, $ifs_match];
388 $content_checked = 1;
391 # do specific type checks
392 if (exists $field_val->{'type'}) {
393 if (! $self->check_type($value, $field_val->{'type'}, $field, $form)){
394 return [] if $self->{'_check_conditional'};
395 push @errors, [$field, 'type', $field_val, $ifs_match];
398 $content_checked = 1;
401 # field equals another field
402 if ($types{'equals'}) { foreach my $type (@{ $types{'equals'} }) {
403 my $field2 = $field_val->{$type};
404 my $not = ($field2 =~ s/^!\s*//) ? 1 : 0;
406 if ($field2 =~ m/^([\"\'])(.*)\1$/) {
408 $success = (defined($value) && $value eq $test);
409 } elsif (exists($form->{$field2}) && defined($form->{$field2})) {
410 $success = (defined($value) && $value eq $form->{$field2});
411 } elsif (! defined($value)) {
412 $success = 1; # occurs if they are both undefined
414 if ($not ? $success : ! $success) {
415 return [] if $self->{'_check_conditional'};
416 push @errors, [$field, $type, $field_val, $ifs_match];
419 $content_checked = 1;
422 if (exists $field_val->{'min_len'}) {
423 my $n = $field_val->{'min_len'};
424 if (! defined($value) || length($value) < $n) {
425 return [] if $self->{'_check_conditional'};
426 push @errors, [$field, 'min_len', $field_val, $ifs_match];
430 if (exists $field_val->{'max_len'}) {
431 my $n = $field_val->{'max_len'};
432 if (defined($value) && length($value) > $n) {
433 return [] if $self->{'_check_conditional'};
434 push @errors, [$field, 'max_len', $field_val, $ifs_match];
439 if ($types{'match'}) { foreach my $type (@{ $types{'match'} }) {
440 my $ref = UNIVERSAL
::isa
($field_val->{$type},'ARRAY') ? $field_val->{$type}
441 : UNIVERSAL
::isa
($field_val->{$type}, 'Regexp') ? [$field_val->{$type}]
442 : [split(/\s*\|\|\s*/,$field_val->{$type})];
443 foreach my $rx (@$ref) {
444 if (UNIVERSAL
::isa
($rx,'Regexp')) {
445 if (! defined($value) || $value !~ $rx) {
446 push @errors, [$field, $type, $field_val, $ifs_match];
449 if ($rx !~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) {
450 die "Not sure how to parse that match ($rx)";
452 my ($not, $pat, $opt) = ($1, $3, $4);
454 die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/;
455 if ( ( $not && ( defined($value) && $value =~ m/(?$opt:$pat)/))
456 || (! $not && (! defined($value) || $value !~ m/(?$opt:$pat)/)) ) {
457 return [] if $self->{'_check_conditional'};
458 push @errors, [$field, $type, $field_val, $ifs_match];
462 $content_checked = 1;
465 # allow for comparison checks
466 if ($types{'compare'}) { foreach my $type (@{ $types{'compare'} }) {
467 my $ref = UNIVERSAL
::isa
($field_val->{$type},'ARRAY') ? $field_val->{$type}
468 : [split(/\s*\|\|\s*/,$field_val->{$type})];
469 foreach my $comp (@$ref) {
472 if ($comp =~ /^\s*(>|<|[><!=]=)\s*([\d\.\-]+)\s*$/) {
473 my $val = $value || 0;
475 if ($1 eq '>' ) { $test = ($val > $2) }
476 elsif ($1 eq '<' ) { $test = ($val < $2) }
477 elsif ($1 eq '>=') { $test = ($val >= $2) }
478 elsif ($1 eq '<=') { $test = ($val <= $2) }
479 elsif ($1 eq '!=') { $test = ($val != $2) }
480 elsif ($1 eq '==') { $test = ($val == $2) }
482 } elsif ($comp =~ /^\s*(eq|ne|gt|ge|lt|le)\s+(.+?)\s*$/) {
483 my $val = defined($value) ? $value : '';
484 my ($op, $value2) = ($1, $2);
485 $value2 =~ s/^([\"\'])(.*)\1$/$2/;
486 if ($op eq 'gt') { $test = ($val gt $value2) }
487 elsif ($op eq 'lt') { $test = ($val lt $value2) }
488 elsif ($op eq 'ge') { $test = ($val ge $value2) }
489 elsif ($op eq 'le') { $test = ($val le $value2) }
490 elsif ($op eq 'ne') { $test = ($val ne $value2) }
491 elsif ($op eq 'eq') { $test = ($val eq $value2) }
494 die "Not sure how to compare \"$comp\"";
497 return [] if $self->{'_check_conditional'};
498 push @errors, [$field, $type, $field_val, $ifs_match];
501 $content_checked = 1;
504 # server side sql type
505 if ($types{'sql'}) { foreach my $type (@{ $types{'sql'} }) {
506 my $db_type = $field_val->{"${type}_db_type"};
507 my $dbh = ($db_type) ? $self->{dbhs
}->{$db_type} : $self->{dbh
};
509 die "Missing dbh for $type type on field $field" . ($db_type ? " and db_type $db_type" : "");
510 } elsif (UNIVERSAL
::isa
($dbh,'CODE')) {
511 $dbh = &$dbh($field, $self) || die "SQL Coderef did not return a dbh";
513 my $sql = $field_val->{$type};
514 my @args = ($value) x
$sql =~ tr/?//;
515 my $return = $dbh->selectrow_array($sql, {}, @args); # is this right - copied from O::FORMS
516 $field_val->{"${type}_error_if"} = 1 if ! defined $field_val->{"${type}_error_if"};
517 if ( (! $return && $field_val->{"${type}_error_if"})
518 || ($return && ! $field_val->{"${type}_error_if"}) ) {
519 return [] if $self->{'_check_conditional'};
520 push @errors, [$field, $type, $field_val, $ifs_match];
522 $content_checked = 1;
525 # server side custom type
526 if ($types{'custom'}) { foreach my $type (@{ $types{'custom'} }) {
527 my $check = $field_val->{$type};
529 if (UNIVERSAL
::isa
($check, 'CODE')) {
531 $err = "$@" if ! eval { $ok = $check->($field, $value, $field_val, $type, $form); 1 };
533 chomp($err) if !ref($@) && defined($err);
537 return [] if $self->{'_check_conditional'};
538 push @errors, [$field, $type, $field_val, $ifs_match, (defined($err) ? $err : ())];
539 $content_checked = 1;
544 # allow for the data to be "untainted"
545 # this is only allowable if the user ran some other check for the datatype
546 if ($field_val->{'untaint'} && $#errors == -1) {
547 if (! $content_checked) {
548 push @errors, [$field, 'untaint', $field_val, $ifs_match];
550 # generic untainter - assuming the other required content_checks did good validation
551 $_ = /(.*)/ ? $1 : die "Couldn't match?" foreach @$values;
552 if ($n_values == 1) {
553 $form->{$field} = $values->[0];
558 # all done - time to return
559 return @errors ? \
@errors : 0;
562 ###---------------------###
564 ### used to validate specific types
566 my ($self, $value, $type) = @_;
568 if ($type eq 'email') {
569 return 0 if ! $value;
570 my ($local_p,$dom) = ($value =~ /^(.+)\@(.+?)$/) ? ($1,$2) : return 0;
571 return 0 if length($local_p) > 60;
572 return 0 if length($dom) > 100;
573 return 0 if ! $self->check_type($dom,'domain') && ! $self->check_type($dom,'ip');
574 return 0 if ! $self->check_type($local_p,'local_part');
576 # the "username" portion of an email address - sort of arbitrary
577 } elsif ($type eq 'local_part') {
578 return 0 if ! defined($value) || ! length($value);
579 # ignoring all valid quoted string local parts
580 return 0 if $value =~ m/[^\w.~!\#\$%\^&*\-=+?]/;
582 # standard IP address
583 } elsif ($type eq 'ip') {
584 return 0 if ! $value;
585 return (4 == grep {!/\D/ && $_ < 256} split /\./, $value, 4);
587 # domain name - including tld and subdomains (which are all domains)
588 } elsif ($type eq 'domain') {
589 return 0 if ! $value || length($value) > 255;
590 return 0 if $value !~ /^([a-z0-9][a-z0-9\-]{0,62} \.)+ [a-z]{1,63}$/ix
591 || $value =~ m/(\.\-|\-\.|\.\.)/;
594 } elsif ($type eq 'url') {
595 return 0 if ! $value;
596 $value =~ s
|^https
?://([^/]+)||i
|| return 0;
598 return 0 if ! $self->check_type($dom,'domain') && ! $self->check_type($dom,'ip');
599 return 0 if $value && ! $self->check_type($value,'uri');
601 # validate a uri - the path portion of a request
602 } elsif ($type eq 'uri') {
603 return 0 if ! $value;
604 return 0 if $value =~ m/\s+/;
606 } elsif ($type eq 'int') {
607 return 0 if $value !~ /^-? (?: 0 | [1-9]\d*) $/x;
608 return 0 if ($value < 0) ? $value < -2**31 : $value > 2**31-1;
609 } elsif ($type eq 'uint') {
610 return 0 if $value !~ /^ (?: 0 | [1-9]\d*) $/x;
611 return 0 if $value > 2**32-1;
612 } elsif ($type eq 'num') {
613 return 0 if $value !~ /^-? (?: 0 | [1-9]\d* (?:\.\d+)? | 0?\.\d+) $/x;
615 } elsif ($type eq 'cc') {
616 return 0 if ! $value;
617 return 0 if $value =~ /[^\d\-\ ]/;
619 return 0 if length($value) > 16 || length($value) < 13;
624 foreach my $digit (reverse split //, $value) {
625 $switch = 1 if ++$switch > 2;
626 my $y = $digit * $switch;
630 return 0 if $sum % 10;
637 ###---------------------###
640 my ($self, $val) = @_;
641 require CGI
::Ex
::Conf
;
642 return CGI
::Ex
::Conf
::conf_read
($val, {html_key
=> 'validation', default_ext
=> 'val'});
645 ### returns all keys from all groups - even if group has validate_if
646 sub get_validation_keys
{
647 my ($self, $val_hash, $form) = @_; # with optional form - will only return keys in validated groups
650 die "Invalid form hash or cgi object" if ! ref $form;
651 $form = $self->cgix->get_form($form) if ref $form ne 'HASH';
654 my ($fields, $ARGS) = $self->get_ordered_fields($val_hash);
655 return {} if ! @$fields;
656 return {} if $form && $ARGS->{'validate_if'} && ! $self->check_conditional($form, $ARGS->{'validate_if'});
657 return {map { $_->{'field'} = $_->{'name'} || 1 } @$fields};
660 ###---------------------###
665 return "<!-- JS validation not supported in this browser $_ -->"
666 if $self->cgix->env->{'HTTP_USER_AGENT'} && grep {$self->cgix->env->{'HTTP_USER_AGENT'} =~ $_} @UNSUPPORTED_BROWSERS;
668 my $val_hash = shift || croak
"Missing validation hash";
669 if (ref $val_hash ne 'HASH') {
670 $val_hash = $self->get_validation($val_hash) if ref $val_hash ne 'SCALAR' || ! ref $val_hash;
671 croak
"Validation groups must be a hashref" if ref $val_hash ne 'HASH';
674 my ($args, $form_name, $js_uri_path);
675 croak
"Missing args or form_name" if ! $_[0];
676 if (ref($_[0]) eq 'HASH') {
679 ($args, $form_name, $js_uri_path) = ({}, @_);
682 $form_name ||= $args->{'form_name'} || croak
'Missing form_name';
683 $js_uri_path ||= $args->{'js_uri_path'};
685 my $js_uri_path_validate = $JS_URI_PATH_VALIDATE || do {
686 croak
'Missing js_uri_path' if ! $js_uri_path;
687 "$js_uri_path/CGI/Ex/validate.js";
690 require CGI
::Ex
::JSONDump
;
691 my $json = CGI
::Ex
::JSONDump-
>new({pretty
=> 1})->dump($val_hash);
692 return qq{<script src="$js_uri_path_validate"></script>
694 document.validation = $json;
695 if (document.check_form) document.check_form("$form_name");
701 my ($self, $val_hash, $form_name, $args) = @_;
702 ($args, $form_name) = ($form_name, undef) if ref($form_name) eq 'HASH';
704 my ($fields, $ARGS) = $self->get_ordered_fields($val_hash);
705 $args = {%{ $ARGS->{'form_args'} || {}}, %{ $args || {} }};
707 my $cols = ($args->{'no_inline_error'} || ! $args->{'columns'} || $args->{'columns'} != 3) ? 2 : 3;
708 $args->{'div'} ||= "<div class=\"form_div\">\n";
709 $args->{'open'} ||= "<form name=\"\$form_name\" id=\"\$form_name\" method=\"\$method\" action=\"\$action\"\$extra_form_attrs>\n";
710 $args->{'form_name'} ||= $form_name || 'the_form_'.int(rand * 1000);
711 $args->{'action'} ||= '';
712 $args->{'method'} ||= 'POST';
713 $args->{'submit'} ||= "<input type=\"submit\" value=\"".($args->{'submit_name'} || 'Submit')."\">";
714 $args->{'header'} ||= "<table class=\"form_table\">\n";
715 $args->{'header'} .= " <tr class=\"header\"><th colspan=\"$cols\">\$title</th></tr>\n" if $args->{'title'};
716 $args->{'footer'} ||= " <tr class=\"submit_row\"><th colspan=\"2\">\$submit</th></tr>\n</table>\n";
717 $args->{'row_template'} ||= " <tr class=\"\$oddeven\" id=\"\$field_row\">\n"
718 ." <td class=\"field\">\$name</td>\n"
719 ." <td class=\"input\">\$input"
721 ? ($args->{'no_inline_error'} ? '' : "<br /><span class=\"error\" id=\"\$field_error\">[% \$field_error %]</span></td>\n")
722 : "</td>\n <td class=\"error\" id=\"\$field_error\">[% \$field_error %]</td>\n")
725 my $js = ! defined($args->{'use_js_validation'}) || $args->{'use_js_validation'};
727 $args->{'css'} = ".odd { background: #eee }\n"
728 . ".form_div { width: 40em; }\n"
729 . ".form_div td { padding:.5ex;}\n"
730 . ".form_div label { width: 10em }\n"
731 . ".form_div .error { color: darkred }\n"
732 . "table { border-spacing: 0px }\n"
733 . ".submit_row { text-align: right }\n"
734 if ! defined $args->{'css'};
736 my $txt = ($args->{'css'} ? "<style>\n$args->{'css'}\n</style>\n" : '') . $args->{'div'} . $args->{'open'} . $args->{'header'};
737 s/\$(form_name|title|method|action|submit|extra_form_attrs)/$args->{$1}/g foreach $txt, $args->{'footer'};
739 foreach my $field (@$fields) {
741 my $type = $field->{'htype'} ? $field->{'htype'} : $field->{'field'} =~ /^pass(?:|wd|word|\d+|_\w+)$/i ? 'password' : 'text';
742 if ($type eq 'hidden') {
745 } elsif ($type eq 'textarea' || $field->{'rows'} || $field->{'cols'}) {
746 my $r = $field->{'rows'} ? " rows=\"$field->{'rows'}\"" : '';
747 my $c = $field->{'cols'} ? " cols=\"$field->{'cols'}\"" : '';
748 my $w = $field->{'wrap'} ? " wrap=\"$field->{'wrap'}\"" : '';
749 $input = "<textarea name=\"$field->{'field'}\" id=\"$field->{'field'}\"$r$c$w></textarea>";
750 } elsif ($type eq 'radio' || $type eq 'checkbox') {
751 my $e = $field->{'enum'} || [];
752 my $l = $field->{'label'} || $e;
753 my $I = @$e > @$l ? $#$e : $#$l;
754 for (my $i = 0; $i <= $I; $i++) {
756 $_e =~ s/\"/"/g;
757 $input .= "<div class=\"option\"><input type=\"$type\" name=\"$field->{'field'}\" id=\"$field->{'field'}_$i\" value=\"$_e\">"
758 .(defined($l->[$i]) ? $l->[$i] : '')."</div>\n";
760 } elsif ($type eq 'select' || $field->{'enum'} || $field->{'label'}) {
761 $input = "<select name=\"$field->{'field'}\" id=\"$field->{'field'}\">\n";
762 my $e = $field->{'enum'} || [];
763 my $l = $field->{'label'} || $e;
764 my $I = @$e > @$l ? $#$e : $#$l;
765 for (my $i = 0; $i <= $I; $i++) {
766 $input .= " <option".(defined($e->[$i]) ? " value=\"".do { my $_e = $e->[$i]; $_e =~ s/\"/"/g; $_e }.'"' : '').">"
767 .(defined($l->[$i]) ? $l->[$i] : '')."</option>\n";
769 $input .= "</select>\n";
771 my $s = $field->{'size'} ? " size=\"$field->{'size'}\"" : '';
772 my $m = $field->{'maxlength'} || $field->{'max_len'}; $m = $m ? " maxlength=\"$m\"" : '';
773 $input = "<input type=\"$type\" name=\"$field->{'field'}\" id=\"$field->{'field'}\"$s$m value=\"\" />";
777 my $copy = $args->{'row_template'};
778 my $name = $field->{'field'};
779 $name = $field->{'name'} || do { $name =~ tr/_/ /; $name =~ s/\b(\w)/\u$1/g; $name };
780 $name = "<label for=\"$field->{'field'}\">$name</label>";
781 $copy =~ s/\$field/$field->{'field'}/g;
782 $copy =~ s/\$name/$name/g;
783 $copy =~ s/\$input/$input/g;
784 $copy =~ s/\$oddeven/$n % 2 ? 'odd' : 'even'/eg;
787 $txt .= $args->{'footer'} . ($args->{'close'} || "</form>\n") . ($args->{'div_close'} || "</div>\n");
789 local @{ $val_hash }{('general form_args', 'group form_args')};
790 delete @{ $val_hash }{('general form_args', 'group form_args')};
791 $txt .= $self->generate_js($val_hash, $args);
796 ###---------------------###
797 ### How to handle errors
799 package CGI
::Ex
::Validate
::Error
;
802 use overload
'""' => \
&as_string
;
805 my ($class, $errors, $extra) = @_;
806 die "Missing or invalid errors arrayref" if ref $errors ne 'ARRAY';
807 die "Missing or invalid extra hashref" if ref $extra ne 'HASH';
808 return bless {errors
=> $errors, extra
=> $extra}, $class;
813 my $extra = $self->{extra
} || {};
814 my $extra2 = shift || {};
816 # allow for formatting
817 my $join = defined($extra2->{as_string_join
}) ? $extra2->{as_string_join
}
818 : defined($extra->{as_string_join
}) ? $extra->{as_string_join
}
820 my $header = defined($extra2->{as_string_header
}) ? $extra2->{as_string_header
}
821 : defined($extra->{as_string_header
}) ? $extra->{as_string_header
} : "";
822 my $footer = defined($extra2->{as_string_footer
}) ? $extra2->{as_string_footer
}
823 : defined($extra->{as_string_footer
}) ? $extra->{as_string_footer
} : "";
825 return $header . join($join, @{ $self->as_array($extra2) }) . $footer;
830 my $errors = $self->{errors
} || die "Missing errors";
831 my $extra = $self->{extra
} || {};
832 my $extra2 = shift || {};
834 my $title = defined($extra2->{as_array_title
}) ? $extra2->{as_array_title
}
835 : defined($extra->{as_array_title
}) ? $extra->{as_array_title
}
836 : "Please correct the following items:";
838 # if there are heading items then we may end up needing a prefix
850 my $prefix = defined($extra2->{as_array_prefix
}) ? $extra2->{as_array_prefix
}
851 : defined($extra->{as_array_prefix
}) ? $extra->{as_array_prefix
}
852 : $has_headings ? ' ' : '';
854 # get the array ready
856 push @array, $title if length $title;
860 foreach my $err (@$errors) {
865 my $text = $self->get_error_text($err);
866 next if $found{$text};
868 push @array, "$prefix$text";
877 my $errors = $self->{errors
} || die "Missing errors";
878 my $extra = $self->{extra
} || {};
879 my $extra2 = shift || {};
881 my $suffix = defined($extra2->{as_hash_suffix
}) ? $extra2->{as_hash_suffix
}
882 : defined($extra->{as_hash_suffix
}) ? $extra->{as_hash_suffix
} : '_error';
883 my $join = defined($extra2->{as_hash_join
}) ? $extra2->{as_hash_join
}
884 : defined($extra->{as_hash_join
}) ? $extra->{as_hash_join
} : '<br />';
888 foreach my $err (@$errors) {
891 my ($field, $type, $field_val, $ifs_match) = @$err;
892 die "Missing field name" if ! $field;
893 if ($field_val->{delegate_error
}) {
894 $field = $field_val->{delegate_error
};
895 $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
898 my $text = $self->get_error_text($err);
899 next if $found{$field}->{$text};
900 $found{$field}->{$text} = 1;
903 push @{ $return{$field} }, $text;
907 my $header = defined($extra2->{as_hash_header
}) ? $extra2->{as_hash_header
}
908 : defined($extra->{as_hash_header
}) ? $extra->{as_hash_header
} : "";
909 my $footer = defined($extra2->{as_hash_footer
}) ? $extra2->{as_hash_footer
}
910 : defined($extra->{as_hash_footer
}) ? $extra->{as_hash_footer
} : "";
911 foreach my $key (keys %return) {
912 $return{$key} = $header . join($join,@{ $return{$key} }) . $footer;
919 ### return a user friendly error message
923 my $extra = $self->{extra
} || {};
924 my ($field, $type, $field_val, $ifs_match, $custom_err) = @$err;
925 return $custom_err if defined($custom_err) && length($custom_err);
926 my $dig = ($type =~ s/(_?\d+)$//) ? $1 : '';
927 my $type_lc = lc($type);
929 # allow for delegated field names - only used for defaults
930 if ($field_val->{delegate_error
}) {
931 $field = $field_val->{delegate_error
};
932 $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
935 # the the name of this thing
936 my $name = $field_val->{'name'};
937 $name = "The field $field" if ! $name && ($field =~ /\W/ || ($field =~ /\d/ && $field =~ /\D/));
941 $name =~ s/\b(\w)/\u$1/g;
943 $name =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
945 # type can look like "required" or "required2" or "required100023"
946 # allow for fallback from required100023_error through required_error
948 # look in the passed hash or self first
950 foreach my $key ((length($dig) ? "${type}${dig}_error" : ()), "${type}_error", 'error') {
951 $return = $field_val->{$key} || $extra->{$key} || next;
952 $return =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
953 $return =~ s/\$field/$field/g;
954 $return =~ s/\$name/$name/g;
955 if (my $value = $field_val->{"$type$dig"}) {
956 $return =~ s/\$value/$value/g if ! ref $value;
961 # set default messages
963 if ($type eq 'required' || $type eq 'required_if') {
964 $return = "$name is required.";
966 } elsif ($type eq 'min_values') {
967 my $n = $field_val->{"min_values${dig}"};
968 my $values = ($n == 1) ? 'value' : 'values';
969 $return = "$name had less than $n $values.";
971 } elsif ($type eq 'max_values') {
972 my $n = $field_val->{"max_values${dig}"};
973 my $values = ($n == 1) ? 'value' : 'values';
974 $return = "$name had more than $n $values.";
976 } elsif ($type eq 'enum') {
977 $return = "$name is not in the given list.";
979 } elsif ($type eq 'equals') {
980 my $field2 = $field_val->{"equals${dig}"};
981 my $name2 = $field_val->{"equals${dig}_name"} || "the field $field2";
982 $name2 =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match;
983 $return = "$name did not equal $name2.";
985 } elsif ($type eq 'min_len') {
986 my $n = $field_val->{"min_len${dig}"};
987 my $char = ($n == 1) ? 'character' : 'characters';
988 $return = "$name was less than $n $char.";
990 } elsif ($type eq 'max_len') {
991 my $n = $field_val->{"max_len${dig}"};
992 my $char = ($n == 1) ? 'character' : 'characters';
993 $return = "$name was more than $n $char.";
995 } elsif ($type eq 'max_in_set') {
996 my $set = $field_val->{"max_in_set${dig}"};
997 $return = "Too many fields were chosen from the set ($set)";
999 } elsif ($type eq 'min_in_set') {
1000 my $set = $field_val->{"min_in_set${dig}"};
1001 $return = "Not enough fields were chosen from the set ($set)";
1003 } elsif ($type eq 'match') {
1004 $return = "$name contains invalid characters.";
1006 } elsif ($type eq 'compare') {
1007 $return = "$name did not fit comparison.";
1009 } elsif ($type eq 'sql') {
1010 $return = "$name did not match sql test.";
1012 } elsif ($type eq 'custom') {
1013 $return = "$name did not match custom test.";
1015 } elsif ($type eq 'type') {
1016 my $_type = $field_val->{"type${dig}"};
1017 $return = "$name did not match type $_type.";
1019 } elsif ($type eq 'untaint') {
1020 $return = "$name cannot be untainted without one of the following checks: enum, equals, match, compare, sql, type, custom";
1022 } elsif ($type eq 'no_extra_fields') {
1023 $return = "$name should not be passed to validate.";
1027 die "Missing error on field $field for type $type$dig" if ! $return;
1034 ### See the perldoc in CGI/Ex/Validate.pod
This page took 0.131288 seconds and 5 git commands to generate.