X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FCGI%2FEx%2FValidate.pm;h=45c26f8c914dd86bec1a2cc9f7f4e23c011205df;hb=HEAD;hp=2749642b763de75bc73a7a2dd412727195af2379;hpb=d2b7c937e86e6e8c4b4193e9f4a8da075919b4fd;p=chaz%2Fp5-CGI-Ex diff --git a/lib/CGI/Ex/Validate.pm b/lib/CGI/Ex/Validate.pm index 2749642..45c26f8 100644 --- a/lib/CGI/Ex/Validate.pm +++ b/lib/CGI/Ex/Validate.pm @@ -1,204 +1,162 @@ package CGI::Ex::Validate; -=head1 NAME +###---------------------### +# See the perldoc in CGI/Ex/Validate.pod +# Copyright 2003-2012 - Paul Seamons +# Distributed under the Perl Artistic License without warranty -CGI::Ex::Validate - another form validator - but it does javascript in parallel +use strict; +use Carp qw(croak); -=cut +our $VERSION = '2.37'; +our $QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/; +our @UNSUPPORTED_BROWSERS = (qr/MSIE\s+5.0\d/i); +our $JS_URI_PATH; +our $JS_URI_PATH_VALIDATE; -###----------------------------------------------------------------### -# Copyright 2006 - Paul Seamons # -# Distributed under the Perl Artistic License without warranty # -###----------------------------------------------------------------### +sub new { + my $class = shift || croak "Usage: ".__PACKAGE__."->new"; + my $self = ref($_[0]) ? shift : {@_}; + return bless $self, $class; +} -use strict; -use vars qw($VERSION - $DEFAULT_EXT - %DEFAULT_OPTIONS - $JS_URI_PATH - $JS_URI_PATH_YAML - $JS_URI_PATH_VALIDATE - $QR_EXTRA - @UNSUPPORTED_BROWSERS - ); +sub cgix { shift->{'cgix'} ||= do { require CGI::Ex; CGI::Ex->new } } -$VERSION = '2.03'; +sub validate { + my $self = (! ref($_[0])) ? shift->new # $class->validate + : UNIVERSAL::isa($_[0], __PACKAGE__) ? shift # $self->validate + : __PACKAGE__->new; # CGI::Ex::Validate::validate + my ($form, $val_hash, $what_was_validated) = @_; -$DEFAULT_EXT = 'val'; -$QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/; -@UNSUPPORTED_BROWSERS = (qr/MSIE\s+5.0\d/i); + die "Invalid form hash or cgi object" if ! $form || ! ref $form; + $form = $self->cgix->get_form($form) if ref $form ne 'HASH'; -use CGI::Ex::Conf (); + my ($fields, $ARGS) = $self->get_ordered_fields($val_hash); + return if ! @$fields; -###----------------------------------------------------------------### + return if $ARGS->{'validate_if'} && ! $self->check_conditional($form, $ARGS->{'validate_if'}); -sub new { - my $class = shift || __PACKAGE__; - my $self = (@_ && ref($_[0])) ? shift : {@_}; + # Finally we have our arrayref of hashrefs that each have their 'field' key + # now lets do the validation + $self->{'was_checked'} = {}; + $self->{'was_valid'} = {}; + $self->{'had_error'} = {}; + my $found = 1; + my @errors; + my $hold_error; # hold the error for a moment - to allow for an "OR" operation + my %checked; + foreach (my $i = 0; $i < @$fields; $i++) { + my $ref = $fields->[$i]; + if (! ref($ref) && $ref eq 'OR') { + $i++ if $found; # if found skip the OR altogether + $found = 1; # reset + next; + } + $found = 1; + my $field = $ref->{'field'} || die "Missing field key during normal validation"; + if (! $checked{$field}++) { + $self->{'was_checked'}->{$field} = 1; + $self->{'was_valid'}->{$field} = 1; + $self->{'had_error'}->{$field} = 0; + } + local $ref->{'was_validated'} = 1; + my $err = $self->validate_buddy($form, $field, $ref); + if ($ref->{'was_validated'} && $what_was_validated) { + push @$what_was_validated, $ref; + } else { + $self->{'was_valid'}->{$field} = 0; + } - ### allow for global defaults - foreach (keys %DEFAULT_OPTIONS) { - $self->{$_} = $DEFAULT_OPTIONS{$_} if ! exists $self->{$_}; - } + # test the error - if errors occur allow for OR - if OR fails use errors from first fail + if ($err) { + $self->{'was_valid'}->{$field} = 0; + $self->{'had_error'}->{$field} = 0; + if ($i < $#$fields && ! ref($fields->[$i + 1]) && $fields->[$i + 1] eq 'OR') { + $hold_error = $err; + } else { + push @errors, $hold_error ? @$hold_error : @$err; + $hold_error = undef; + } + } else { + $hold_error = undef; + } + } + push(@errors, @$hold_error) if $hold_error; # allow for final OR to work - return bless $self, $class; -} + # optionally check for unused keys in the form + if ($ARGS->{no_extra_fields} || $self->{no_extra_fields}) { + my %keys = map { ($_->{'field'} => 1) } @$fields; + foreach my $key (sort keys %$form) { + next if $keys{$key}; + push @errors, [$key, 'no_extra_fields', {}, undef]; + } + } -###----------------------------------------------------------------### + if (@errors) { + my @copy = grep {/$QR_EXTRA/o} keys %$self; + @{ $ARGS }{@copy} = @{ $self }{@copy}; + unshift @errors, $ARGS->{'title'} if $ARGS->{'title'}; + my $err_obj = $self->new_error(\@errors, $ARGS); + die $err_obj if $ARGS->{'raise_error'}; + return $err_obj; + } -sub cgix { - my $self = shift; - return $self->{cgix} ||= do { - require CGI::Ex; - CGI::Ex->new; - }; + return; # success } -### the main validation routine -sub validate { - my $self = (! ref($_[0])) ? shift->new # $class->validate - : UNIVERSAL::isa($_[0], __PACKAGE__) ? shift # $self->validate - : __PACKAGE__->new; # &validate - my $form = shift || die "Missing form hash"; - my $val_hash = shift || die "Missing validation hash"; - my $what_was_validated = shift; # allow for extra arrayref that stores what was validated - - ### turn the form into a form if it is really a CGI object - if (! ref($form)) { - die "Invalid form hash or cgi object"; - } elsif(! UNIVERSAL::isa($form,'HASH')) { - local $self->{cgi_object} = $form; - $form = $self->cgix->get_form($form); - } - - ### get the validation - let get_validation deal with types - ### if a ref is not passed - assume it is a filename - $val_hash = $self->get_validation($val_hash); - - ### allow for validation passed as single group hash, single group array, - ### or array of group hashes or group arrays - my @ERRORS = (); - my %EXTRA = (); - my @USED_GROUPS = (); - my $group_order = UNIVERSAL::isa($val_hash,'HASH') ? [$val_hash] : $val_hash; - foreach my $group_val (@$group_order) { - die "Validation groups must be a hashref" if ! UNIVERSAL::isa($group_val,'HASH'); - my $title = $group_val->{'group title'}; - my $validate_if = $group_val->{'group validate_if'}; - - ### only validate this group if it is supposed to be checked - next if $validate_if && ! $self->check_conditional($form, $validate_if); - push @USED_GROUPS, $group_val; - - ### If the validation items were not passed as an arrayref. - ### Look for a group order and then fail back to the keys of the group. - ### We will keep track of what was added using %found - the keys will - ### be the hash signatures of the field_val hashes (ignore the hash internals). - my @field_keys; - my @group_keys; - foreach (sort keys %$group_val) { - /^(group|general)\s+(\w+)/ ? push(@group_keys, [$1, $2, $_]) : push(@field_keys, $_); +sub get_ordered_fields { + my ($self, $val_hash) = @_; + + die "Missing validation hash" if ! $val_hash; + if (ref $val_hash ne 'HASH') { + $val_hash = $self->get_validation($val_hash) if ref $val_hash ne 'SCALAR' || ! ref $val_hash; + die "Validation groups must be a hashref" if ref $val_hash ne 'HASH'; } - my $fields = $group_val->{'group fields'}; - if ($fields) { # if I passed group fields array - use it - die "'group fields' must be an arrayref" if ! UNIVERSAL::isa($fields,'ARRAY'); - } else { # other wise - create our own array - my @fields = (); - if (my $order = $group_val->{'group order'} || \@field_keys) { - die "Validation 'group order' must be an arrayref" if ! UNIVERSAL::isa($order,'ARRAY'); - foreach my $field (@$order) { - my $field_val = exists($group_val->{$field}) ? $group_val->{$field} - : ($field eq 'OR') ? 'OR' : die "No element found in group for $field"; - if (ref $field_val && ! $field_val->{'field'}) { - $field_val = { %$field_val, 'field' => $field }; # copy the values to add the key - } - push @fields, $field_val; + + my %ARGS; + my @field_keys = grep { /^(?:group|general)\s+(\w+)/ + ? do {$ARGS{$1} = $val_hash->{$_} ; 0} + : 1 } sort keys %$val_hash; + + # Look first for items in 'group fields' or 'group order' + my $fields; + if (my $ref = $ARGS{'fields'} || $ARGS{'order'}) { + my $type = $ARGS{'fields'} ? 'group fields' : 'group order'; + die "Validation '$type' must be an arrayref when passed" if ! UNIVERSAL::isa($ref, 'ARRAY'); + foreach my $field (@$ref) { + die "Non-defined value in '$type'" if ! defined $field; + if (ref $field) { + die "Found nonhashref value in '$type'" if ref($field) ne 'HASH'; + die "Element missing \"field\" key/value in '$type'" if ! defined $field->{'field'}; + push @$fields, $field; + } elsif ($field eq 'OR') { + push @$fields, 'OR'; + } else { + die "No element found in '$type' for $field" if ! exists $val_hash->{$field}; + die "Found nonhashref value in '$type'" if ref($val_hash->{$field}) ne 'HASH'; + my $val = $val_hash->{$field}; + $val = {%$val, field => $field} if ! $val->{'field'}; # copy the values to add the key + push @$fields, $val; + } } - } - $fields = \@fields; - } - ### double check which field_vals have been used so far - ### add any remaining field_vals from the order - ### this is necessary for items that weren't in group fields or group order - my %found = map {$_->{'field'} => 1} @$fields; - foreach my $field (@field_keys) { - next if $found{$field}; - my $field_val = $group_val->{$field}; - die "Found a nonhashref value on field $field" if ! UNIVERSAL::isa($field_val, 'HASH'); - push @$fields, $field_val; + # limit the keys that need to be searched to those not in fields or order + my %found = map { ref($_) ? ($_->{'field'} => 1) : () } @$fields; + @field_keys = grep { ! $found{$_} } @field_keys; } - ### Finally we have our arrayref of hashrefs that each have their 'field' key - ### now lets do the validation - my $found = 1; - my @errors = (); - my $hold_error; # hold the error for a moment - to allow for an "Or" operation - foreach (my $i = 0; $i <= $#$fields; $i ++) { - my $ref = $fields->[$i]; - if (! ref($ref) && $ref eq 'OR') { - $i ++ if $found; # if found skip the OR altogether - $found = 1; # reset - next; - } - $found = 1; - die "Missing field key during normal validation" if ! $ref->{'field'}; - local $ref->{'was_validated'} = 1; - my @err = $self->validate_buddy($form, $ref->{'field'}, $ref); - if (delete($ref->{'was_validated'}) && $what_was_validated) { - push @$what_was_validated, $ref; - } - - ### test the error - if errors occur allow for OR - if OR fails use errors from first fail - if (scalar @err) { - if ($i < $#$fields && ! ref($fields->[$i + 1]) && $fields->[$i + 1] eq 'OR') { - $hold_error = \@err; + # add any remaining field_vals from our original hash + # this is necessary for items that weren't in group fields or group order + foreach my $field (@field_keys) { + die "Found nonhashref value for field $field" if ref($val_hash->{$field}) ne 'HASH'; + if (defined $val_hash->{$field}->{'field'}) { + push @$fields, $val_hash->{$field}; } else { - push @errors, $hold_error ? @$hold_error : @err; - $hold_error = undef; + push @$fields, { %{$val_hash->{$field}}, field => $field }; } - } else { - $hold_error = undef; - } - } - push(@errors, @$hold_error) if $hold_error; # allow for final OR to work - - ### add on errors as requested - if ($#errors != -1) { - push @ERRORS, $title if $title; - push @ERRORS, @errors; } - ### add on general options, and group options if errors in group occurred - foreach (@group_keys) { - my ($type, $short_key, $full_key) = @$_; - next if $type eq 'group' && ($#errors == -1 || $short_key =~ /^(field|order|title)$/); - $EXTRA{$short_key} = $group_val->{$full_key}; - } - } - - ### store any extra items from self - $EXTRA{$_} = $self->{$_} for grep {/$QR_EXTRA/o} keys %$self; - - ### allow for checking for unused keys - if ($EXTRA{no_extra_fields}) { - my $which = ($EXTRA{no_extra_fields} =~ /used/i) ? 'used' : 'all'; - my $ref = ($which eq 'all') ? $val_hash : \@USED_GROUPS; - my $keys = $self->get_validation_keys($ref); - foreach my $key (sort keys %$form) { - next if $keys->{$key}; - push @ERRORS, [$key, 'no_extra_fields', {}, undef]; - } - } - - ### return what they want - if ($#ERRORS != -1) { - my $err_obj = $self->new_error(\@ERRORS, \%EXTRA); - die $err_obj if $EXTRA{'raise_error'}; - return $err_obj; - } else { - return wantarray ? () : undef; - } + return ($fields || [], \%ARGS); } sub new_error { @@ -208,630 +166,634 @@ sub new_error { ### allow for optional validation on groups and on individual items sub check_conditional { - my ($self, $form, $ifs, $N_level, $ifs_match) = @_; - - $N_level ||= 0; - $N_level ++; # prevent too many recursive checks - - ### can pass a single hash - or an array ref of hashes - if (! $ifs) { - die "Need reference passed to check_conditional"; - } elsif (! ref($ifs)) { - $ifs = [$ifs]; - } elsif (UNIVERSAL::isa($ifs,'HASH')) { - $ifs = [$ifs]; - } - - ### run the if options here - ### multiple items can be passed - all are required unless OR is used to separate - my $found = 1; - foreach (my $i = 0; $i <= $#$ifs; $i ++) { - my $ref = $ifs->[$i]; - if (! ref $ref) { - if ($ref eq 'OR') { - $i ++ if $found; # if found skip the OR altogether - $found = 1; # reset - next; - } else { - if ($ref =~ s/^\s*!\s*//) { - $ref = {field => $ref, max_in_set => "0 of $ref"}; - } else { - $ref = {field => $ref, required => 1}; + my ($self, $form, $ifs, $ifs_match) = @_; + die "Need reference passed to check_conditional" if ! $ifs; + $ifs = [$ifs] if ! ref($ifs) || UNIVERSAL::isa($ifs,'HASH'); + + local $self->{'_check_conditional'} = 1; + + # run the if options here + # multiple items can be passed - all are required unless OR is used to separate + my $found = 1; + foreach (my $i = 0; $i <= $#$ifs; $i ++) { + my $ref = $ifs->[$i]; + if (! ref $ref) { + if ($ref eq 'OR') { + $i ++ if $found; # if found skip the OR altogether + $found = 1; # reset + next; + } else { + if ($ref =~ /^function\s*\(/) { + next; + } elsif ($ref =~ /^(.*?)\s+(was_valid|had_error|was_checked)$/) { + $ref = {field => $1, $2 => 1}; + } elsif ($ref =~ s/^\s*!\s*//) { + $ref = {field => $ref, max_in_set => "0 of $ref"}; + } else { + $ref = {field => $ref, required => 1}; + } + } } - } - } - last if ! $found; + last if ! $found; - ### get the field - allow for custom variables based upon a match - my $field = $ref->{'field'} || die "Missing field key during validate_if (possibly used a reference to a main hash *foo -> &foo)"; - $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match; + # get the field - allow for custom variables based upon a match + my $field = $ref->{'field'} || die "Missing field key during validate_if (possibly used a reference to a main hash *foo -> &foo)"; + $field =~ s/\$(\d+)/defined($ifs_match->[$1]) ? $ifs_match->[$1] : ''/eg if $ifs_match; - my @err = $self->validate_buddy($form, $field, $ref, $N_level); - $found = 0 if scalar @err; - } - return $found; + my $errs = $self->validate_buddy($form, $field, $ref); + $found = 0 if $errs; + } + return $found; } ### this is where the main checking goes on sub validate_buddy { - my $self = shift; - my ($form, $field, $field_val, $N_level, $ifs_match) = @_; - $N_level ||= 0; - $N_level ++; # prevent too many recursive checks - die "Max dependency level reached $N_level" if $N_level > 10; - - my @errors = (); - my $types = [sort keys %$field_val]; - - ### allow for not running some tests in the cgi - if ($field_val->{'exclude_cgi'}) { - delete $field_val->{'was_validated'}; - return wantarray ? @errors : $#errors + 1; - } - - ### allow for field names that contain regular expressions - if ($field =~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) { - my ($not,$pat,$opt) = ($1,$3,$4); - $opt =~ tr/g//d; - die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/; - foreach my $_field (sort keys %$form) { - next if ($not && $_field =~ m/(?$opt:$pat)/) || (! $not && $_field !~ m/(?$opt:$pat)/); - my @match = (undef, $1, $2, $3, $4, $5); # limit to the matches - push @errors, $self->validate_buddy($form, $_field, $field_val, $N_level, \@match); - } - return wantarray ? @errors : $#errors + 1; - } + my ($self, $form, $field, $field_val, $ifs_match) = @_; + local $self->{'_recurse'} = ($self->{'_recurse'} || 0) + 1; + die "Max dependency level reached 10" if $self->{'_recurse'} > 10; + my @errors; - my $values = UNIVERSAL::isa($form->{$field},'ARRAY') ? $form->{$field} : [$form->{$field}]; - my $n_values = $#$values + 1; - - ### allow for default value - if (exists $field_val->{'default'}) { - if ($n_values == 0 || ($n_values == 1 && (! defined($values->[0]) || ! length($values->[0])))) { - $form->{$field} = $values->[0] = $field_val->{'default'}; + if ($field_val->{'exclude_cgi'}) { + delete $field_val->{'was_validated'}; + return 0; } - } - - ### allow for a few form modifiers - my $modified = 0; - foreach my $value (@$values) { - next if ! defined $value; - if (! $field_val->{'do_not_trim'}) { # whitespace - $value =~ s/^\s+//; - $value =~ s/\s+$//; - $modified = 1; + + # allow for field names that contain regular expressions + if ($field =~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) { + my ($not,$pat,$opt) = ($1,$3,$4); + $opt =~ tr/g//d; + die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/; + foreach my $_field (sort keys %$form) { + next if ($not && $_field =~ m/(?$opt:$pat)/) || (! $not && $_field !~ m/(?$opt:$pat)/); + my @match = (undef, $1, $2, $3, $4, $5); # limit to the matches + my $errs = $self->validate_buddy($form, $_field, $field_val, \@match); + push @errors, @$errs if $errs; + } + return @errors ? \@errors : 0; } - if ($field_val->{'to_upper_case'}) { # uppercase - $value = uc($value); - $modified = 1; - } elsif ($field_val->{'to_lower_case'}) { # lowercase - $value = lc($value); - $modified = 1; + + if ($field_val->{'was_valid'} && ! $self->{'was_valid'}->{$field}) { return [[$field, 'was_valid', $field_val, $ifs_match]]; } + if ($field_val->{'had_error'} && ! $self->{'had_error'}->{$field}) { return [[$field, 'had_error', $field_val, $ifs_match]]; } + if ($field_val->{'was_checked'} && ! $self->{'was_checked'}->{$field}) { return [[$field, 'was_checked', $field_val, $ifs_match]]; } + + # allow for default value + if (defined($field_val->{'default'}) + && (!defined($form->{$field}) + || (UNIVERSAL::isa($form->{$field},'ARRAY') ? !@{ $form->{$field} } : !length($form->{$field})))) { + $form->{$field} = $field_val->{'default'}; } - } - # allow for inline specified modifications (ie s/foo/bar/) - foreach my $type (grep {/^replace_?\d*$/} @$types) { - my $ref = UNIVERSAL::isa($field_val->{$type},'ARRAY') ? $field_val->{$type} - : [split(/\s*\|\|\s*/,$field_val->{$type})]; - foreach my $rx (@$ref) { - if ($rx !~ m/^\s*s([^\s\w])(.+)\1(.*)\1([eigsmx]*)$/s) { - die "Not sure how to parse that replace ($rx)"; - } - my ($pat, $swap, $opt) = ($2, $3, $4); - die "The e option cannot be used in swap on field $field" if $opt =~ /e/; - my $global = $opt =~ s/g//g; - $swap =~ s/\\n/\n/g; - if ($global) { - foreach my $value (@$values) { - $value =~ s{(?$opt:$pat)}{ - my @match = (undef, $1, $2, $3, $4, $5, $6); # limit on the number of matches - my $copy = $swap; - $copy =~ s/\$(\d+)/defined($match[$1]) ? $match[$1] : ""/ge; - $modified = 1; - $copy; # return of the swap - }eg; + + my $values = UNIVERSAL::isa($form->{$field},'ARRAY') ? $form->{$field} : [$form->{$field}]; + my $n_values = @$values; + + # allow for a few form modifiers + my $modified = 0; + foreach my $value (@$values) { + next if ! defined $value; + if (! $field_val->{'do_not_trim'}) { # whitespace + $modified = 1 if $value =~ s/( ^\s+ | \s+$ )//xg; } - }else{ - foreach my $value (@$values) { - $value =~ s{(?$opt:$pat)}{ - my @match = (undef, $1, $2, $3, $4, $5, $6); # limit on the number of matches - my $copy = $swap; - $copy =~ s/\$(\d+)/defined($match[$1]) ? $match[$1] : ""/ge; + if ($field_val->{'trim_control_chars'}) { + $modified = 1 if $value =~ y/\t/ /; + $modified = 1 if $value =~ y/\x00-\x1F//d; + } + if ($field_val->{'to_upper_case'}) { # uppercase + $value = uc $value; + $modified = 1; + } elsif ($field_val->{'to_lower_case'}) { # lowercase + $value = lc $value; $modified = 1; - $copy; # return of the swap - }e; } - } - } - } - ### put them back into the form if we have modified it - if ($modified) { - if ($n_values == 1) { - $form->{$field} = $values->[0]; - $self->{cgi_object}->param(-name => $field, -value => $values->[0]) - if $self->{cgi_object}; - } else { - ### values in @{ $form->{$field} } were modified directly - $self->{cgi_object}->param(-name => $field, -value => $values) - if $self->{cgi_object}; } - } - - ### only continue if a validate_if is not present or passes test - my $needs_val = 0; - my $n_vif = 0; - foreach my $type (grep {/^validate_if_?\d*$/} @$types) { - $n_vif ++; - my $ifs = $field_val->{$type}; - my $ret = $self->check_conditional($form, $ifs, $N_level, $ifs_match); - $needs_val ++ if $ret; - } - if (! $needs_val && $n_vif) { - delete $field_val->{'was_validated'}; - return wantarray ? @errors : $#errors + 1; - } - - ### check for simple existence - ### optionally check only if another condition is met - my $is_required = $field_val->{'required'} ? 'required' : ''; - if (! $is_required) { - foreach my $type (grep {/^required_if_?\d*$/} @$types) { - my $ifs = $field_val->{$type}; - next if ! $self->check_conditional($form, $ifs, $N_level, $ifs_match); - $is_required = $type; - last; + + my %types; + foreach (sort keys %$field_val) { + push @{$types{$1}}, $_ if /^ (compare|custom|equals|match|max_in_set|min_in_set|replace|required_if|sql|type|validate_if) _?\d* $/x; } - } - if ($is_required - && ($n_values == 0 || ($n_values == 1 && (! defined($values->[0]) || ! length $values->[0])))) { - return 1 if ! wantarray; - push @errors, [$field, $is_required, $field_val, $ifs_match]; - return @errors; - } - - ### min values check - my $n = exists($field_val->{'min_values'}) ? $field_val->{'min_values'} || 0 : 0; - if ($n_values < $n) { - return 1 if ! wantarray; - push @errors, [$field, 'min_values', $field_val, $ifs_match]; - return @errors; - } - - ### max values check - $field_val->{'max_values'} = 1 if ! exists $field_val->{'max_values'}; - $n = $field_val->{'max_values'} || 0; - if ($n_values > $n) { - return 1 if ! wantarray; - push @errors, [$field, 'max_values', $field_val, $ifs_match]; - return @errors; - } - - ### max_in_set and min_in_set checks - my @min = grep {/^min_in_set_?\d*$/} @$types; - my @max = grep {/^max_in_set_?\d*$/} @$types; - foreach ([min => \@min], - [max => \@max]) { - my ($minmax, $keys) = @$_; - foreach my $type (@$keys) { - $field_val->{$type} =~ m/^\s*(\d+)(?i:\s*of)?\s+(.+)\s*$/ - || die "Invalid in_set check $field_val->{$type}"; - my $n = $1; - foreach my $_field (split /[\s,]+/, $2) { - my $ref = UNIVERSAL::isa($form->{$_field},'ARRAY') ? $form->{$_field} : [$form->{$_field}]; - foreach my $_value (@$ref) { - $n -- if defined($_value) && length($_value); + + # allow for inline specified modifications (ie s/foo/bar/) + if ($types{'replace'}) { foreach my $type (@{ $types{'replace'} }) { + my $ref = UNIVERSAL::isa($field_val->{$type},'ARRAY') ? $field_val->{$type} + : [split(/\s*\|\|\s*/,$field_val->{$type})]; + foreach my $rx (@$ref) { + if ($rx !~ m/^\s*s([^\s\w])(.+)\1(.*)\1([eigsmx]*)$/s) { + die "Not sure how to parse that replace ($rx)"; + } + my ($pat, $swap, $opt) = ($2, $3, $4); + die "The e option cannot be used in swap on field $field" if $opt =~ /e/; + my $global = $opt =~ s/g//g; + $swap =~ s/\\n/\n/g; + my $expand = sub { # code similar to Template::Alloy::VMethod::vmethod_replace + my ($text, $start, $end) = @_; + my $copy = $swap; + $copy =~ s{ \\(\\|\$) | \$ (\d+) }{ + $1 ? $1 + : ($2 > $#$start || $2 == 0) ? '' + : substr($text, $start->[$2], $end->[$2] - $start->[$2]); + }exg; + $modified = 1; + $copy; + }; + foreach my $value (@$values) { + if ($global) { $value =~ s{(?$opt:$pat)}{ $expand->($value, [@-], [@+]) }eg } + else { $value =~ s{(?$opt:$pat)}{ $expand->($value, [@-], [@+]) }e } + } } - } - if ( ($minmax eq 'min' && $n > 0) - || ($minmax eq 'max' && $n < 0)) { - return 1 if ! wantarray; - push @errors, [$field, $type, $field_val, $ifs_match]; - return @errors; - } - } - } - - ### at this point @errors should still be empty - my $content_checked; # allow later for possible untainting (only happens if content was checked) - - ### loop on values of field - foreach my $value (@$values) { - - ### allow for enum types - if (exists $field_val->{'enum'}) { - my $ref = ref($field_val->{'enum'}) ? $field_val->{'enum'} : [split(/\s*\|\|\s*/,$field_val->{'enum'})]; - my $found = 0; - foreach (@$ref) { - $found = 1 if defined($value) && $_ eq $value; - } - if (! $found) { - return 1 if ! wantarray; - push @errors, [$field, 'enum', $field_val, $ifs_match]; - } - $content_checked = 1; + } } + $form->{$field} = $values->[0] if $modified && $n_values == 1; # put them back into the form if we have modified it + + # only continue if a validate_if is not present or passes test + my $needs_val = 0; + my $n_vif = 0; + if ($types{'validate_if'}) { foreach my $type (@{ $types{'validate_if'} }) { + $n_vif++; + my $ifs = $field_val->{$type}; + my $ret = $self->check_conditional($form, $ifs, $ifs_match); + $needs_val++ if $ret; + } } + if (! $needs_val && $n_vif) { + delete $field_val->{'was_validated'}; + return 0; } - ### field equality test - foreach my $type (grep {/^equals_?\d*$/} @$types) { - my $field2 = $field_val->{$type}; - my $not = ($field2 =~ s/^!\s*//) ? 1 : 0; - my $success = 0; - if ($field2 =~ m/^([\"\'])(.*)\1$/) { - my $test = $2; - $success = (defined($value) && $value eq $test); - } elsif (exists($form->{$field2}) && defined($form->{$field2})) { - $success = (defined($value) && $value eq $form->{$field2}); - } elsif (! defined($value)) { - $success = 1; # occurs if they are both undefined - } - if ($not ? $success : ! $success) { - return 1 if ! wantarray; - push @errors, [$field, $type, $field_val, $ifs_match]; - } - $content_checked = 1; + # check for simple existence + # optionally check only if another condition is met + my $is_required = $field_val->{'required'} ? 'required' : ''; + if (! $is_required) { + if ($types{'required_if'}) { foreach my $type (@{ $types{'required_if'} }) { + my $ifs = $field_val->{$type}; + next if ! $self->check_conditional($form, $ifs, $ifs_match); + $is_required = $type; + last; + } } + } + if ($is_required + && ($n_values == 0 || ($n_values == 1 && (! defined($values->[0]) || ! length $values->[0])))) { + return [] if $self->{'_check_conditional'}; + return [[$field, $is_required, $field_val, $ifs_match]]; } - ### length min check - if (exists $field_val->{'min_len'}) { - my $n = $field_val->{'min_len'}; - if (! defined($value) || length($value) < $n) { - return 1 if ! wantarray; - push @errors, [$field, 'min_len', $field_val, $ifs_match]; - } + my $n = exists($field_val->{'min_values'}) ? $field_val->{'min_values'} || 0 : 0; + if ($n_values < $n) { + return [] if $self->{'_check_conditional'}; + return [[$field, 'min_values', $field_val, $ifs_match]]; } - ### length max check - if (exists $field_val->{'max_len'}) { - my $n = $field_val->{'max_len'}; - if (defined($value) && length($value) > $n) { - return 1 if ! wantarray; - push @errors, [$field, 'max_len', $field_val, $ifs_match]; - } + $field_val->{'max_values'} = 1 if ! exists $field_val->{'max_values'}; + $n = $field_val->{'max_values'} || 0; + if ($n_values > $n) { + return [] if $self->{'_check_conditional'}; + return [[$field, 'max_values', $field_val, $ifs_match]]; } - ### now do match types - foreach my $type (grep {/^match_?\d*$/} @$types) { - my $ref = UNIVERSAL::isa($field_val->{$type},'ARRAY') ? $field_val->{$type} - : UNIVERSAL::isa($field_val->{$type}, 'Regexp') ? [$field_val->{$type}] - : [split(/\s*\|\|\s*/,$field_val->{$type})]; - foreach my $rx (@$ref) { - if (UNIVERSAL::isa($rx,'Regexp')) { - if (! defined($value) || $value !~ $rx) { - push @errors, [$field, $type, $field_val, $ifs_match]; - } - } else { - if ($rx !~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) { - die "Not sure how to parse that match ($rx)"; - } - my ($not,$pat,$opt) = ($1,$3,$4); - $opt =~ tr/g//d; - die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/; - if ( ( $not && ( defined($value) && $value =~ m/(?$opt:$pat)/)) - || (! $not && (! defined($value) || $value !~ m/(?$opt:$pat)/)) - ) { - return 1 if ! wantarray; - push @errors, [$field, $type, $field_val, $ifs_match]; - } + foreach ([min => $types{'min_in_set'}], + [max => $types{'max_in_set'}]) { + my $keys = $_->[1] || next; + my $minmax = $_->[0]; + foreach my $type (@$keys) { + $field_val->{$type} =~ m/^\s*(\d+)(?i:\s*of)?\s+(.+)\s*$/ + || die "Invalid ${minmax}_in_set check $field_val->{$type}"; + my $n = $1; + foreach my $_field (split /[\s,]+/, $2) { + my $ref = UNIVERSAL::isa($form->{$_field},'ARRAY') ? $form->{$_field} : [$form->{$_field}]; + foreach my $_value (@$ref) { + $n -- if defined($_value) && length($_value); + } + } + if ( ($minmax eq 'min' && $n > 0) + || ($minmax eq 'max' && $n < 0)) { + return [] if $self->{'_check_conditional'}; + return [[$field, $type, $field_val, $ifs_match]]; + } } - } - $content_checked = 1; } - ### allow for comparison checks - foreach my $type (grep {/^compare_?\d*$/} @$types) { - my $ref = UNIVERSAL::isa($field_val->{$type},'ARRAY') ? $field_val->{$type} - : [split(/\s*\|\|\s*/,$field_val->{$type})]; - foreach my $comp (@$ref) { - next if ! $comp; - my $test = 0; - if ($comp =~ /^\s*(>|<|[>' ) { $test = ($val > $2) } - elsif ($1 eq '<' ) { $test = ($val < $2) } - elsif ($1 eq '>=') { $test = ($val >= $2) } - elsif ($1 eq '<=') { $test = ($val <= $2) } - elsif ($1 eq '!=') { $test = ($val != $2) } - elsif ($1 eq '==') { $test = ($val == $2) } - - } elsif ($comp =~ /^\s*(eq|ne|gt|ge|lt|le)\s+(.+?)\s*$/) { - my $val = defined($value) ? $value : ''; - my ($op, $value2) = ($1, $2); - $value2 =~ s/^([\"\'])(.*)\1$/$2/; - if ($op eq 'gt') { $test = ($val gt $value2) } - elsif ($op eq 'lt') { $test = ($val lt $value2) } - elsif ($op eq 'ge') { $test = ($val ge $value2) } - elsif ($op eq 'le') { $test = ($val le $value2) } - elsif ($op eq 'ne') { $test = ($val ne $value2) } - elsif ($op eq 'eq') { $test = ($val eq $value2) } + # at this point @errors should still be empty + my $content_checked; # allow later for possible untainting (only happens if content was checked) + + OUTER: foreach my $value (@$values) { + + if (exists $field_val->{'enum'}) { + my $ref = ref($field_val->{'enum'}) ? $field_val->{'enum'} : [split(/\s*\|\|\s*/,$field_val->{'enum'})]; + my $found = 0; + foreach (@$ref) { + $found = 1 if defined($value) && $_ eq $value; + } + if (! $found) { + return [] if $self->{'_check_conditional'}; + push @errors, [$field, 'enum', $field_val, $ifs_match]; + next OUTER; + } + $content_checked = 1; + } - } else { - die "Not sure how to compare \"$comp\""; + # do specific type checks + if (exists $field_val->{'type'}) { + if (! $self->check_type($value, $field_val->{'type'}, $field, $form)){ + return [] if $self->{'_check_conditional'}; + push @errors, [$field, 'type', $field_val, $ifs_match]; + next OUTER; + } + $content_checked = 1; } - if (! $test) { - return 1 if ! wantarray; - push @errors, [$field, $type, $field_val, $ifs_match]; + + # field equals another field + if ($types{'equals'}) { foreach my $type (@{ $types{'equals'} }) { + my $field2 = $field_val->{$type}; + my $not = ($field2 =~ s/^!\s*//) ? 1 : 0; + my $success = 0; + if ($field2 =~ m/^([\"\'])(.*)\1$/) { + my $test = $2; + $success = (defined($value) && $value eq $test); + } elsif (exists($form->{$field2}) && defined($form->{$field2})) { + $success = (defined($value) && $value eq $form->{$field2}); + } elsif (! defined($value)) { + $success = 1; # occurs if they are both undefined + } + if ($not ? $success : ! $success) { + return [] if $self->{'_check_conditional'}; + push @errors, [$field, $type, $field_val, $ifs_match]; + next OUTER; + } + $content_checked = 1; + } } + + if (exists $field_val->{'min_len'}) { + my $n = $field_val->{'min_len'}; + if (! defined($value) || length($value) < $n) { + return [] if $self->{'_check_conditional'}; + push @errors, [$field, 'min_len', $field_val, $ifs_match]; + } } - } - $content_checked = 1; - } - ### server side sql type - foreach my $type (grep {/^sql_?\d*$/} @$types) { - my $db_type = $field_val->{"${type}_db_type"}; - my $dbh = ($db_type) ? $self->{dbhs}->{$db_type} : $self->{dbh}; - if (! $dbh) { - die "Missing dbh for $type type on field $field" . ($db_type ? " and db_type $db_type" : ""); - } elsif (UNIVERSAL::isa($dbh,'CODE')) { - $dbh = &$dbh($field, $self) || die "SQL Coderef did not return a dbh"; - } - my $sql = $field_val->{$type}; - my @args = ($value) x $sql =~ tr/?//; - my $return = $dbh->selectrow_array($sql, {}, @args); # is this right - copied from O::FORMS - $field_val->{"${type}_error_if"} = 1 if ! defined $field_val->{"${type}_error_if"}; - if ( (! $return && $field_val->{"${type}_error_if"}) - || ($return && ! $field_val->{"${type}_error_if"}) ) { - return 1 if ! wantarray; - push @errors, [$field, $type, $field_val, $ifs_match]; - } - $content_checked = 1; - } + if (exists $field_val->{'max_len'}) { + my $n = $field_val->{'max_len'}; + if (defined($value) && length($value) > $n) { + return [] if $self->{'_check_conditional'}; + push @errors, [$field, 'max_len', $field_val, $ifs_match]; + } + } - ### server side custom type - foreach my $type (grep {/^custom_?\d*$/} @$types) { - my $check = $field_val->{$type}; - next if UNIVERSAL::isa($check, 'CODE') ? &$check($field, $value, $field_val, $type) : $check; - return 1 if ! wantarray; - push @errors, [$field, $type, $field_val, $ifs_match]; - $content_checked = 1; - } + # now do match types + if ($types{'match'}) { foreach my $type (@{ $types{'match'} }) { + my $ref = UNIVERSAL::isa($field_val->{$type},'ARRAY') ? $field_val->{$type} + : UNIVERSAL::isa($field_val->{$type}, 'Regexp') ? [$field_val->{$type}] + : [split(/\s*\|\|\s*/,$field_val->{$type})]; + foreach my $rx (@$ref) { + if (UNIVERSAL::isa($rx,'Regexp')) { + if (! defined($value) || $value !~ $rx) { + push @errors, [$field, $type, $field_val, $ifs_match]; + } + } else { + if ($rx !~ m/^(!\s*|)m([^\s\w])(.*)\2([eigsmx]*)$/s) { + die "Not sure how to parse that match ($rx)"; + } + my ($not, $pat, $opt) = ($1, $3, $4); + $opt =~ tr/g//d; + die "The e option cannot be used on validation keys on field $field" if $opt =~ /e/; + if ( ( $not && ( defined($value) && $value =~ m/(?$opt:$pat)/)) + || (! $not && (! defined($value) || $value !~ m/(?$opt:$pat)/)) ) { + return [] if $self->{'_check_conditional'}; + push @errors, [$field, $type, $field_val, $ifs_match]; + } + } + } + $content_checked = 1; + } } + + # allow for comparison checks + if ($types{'compare'}) { foreach my $type (@{ $types{'compare'} }) { + my $ref = UNIVERSAL::isa($field_val->{$type},'ARRAY') ? $field_val->{$type} + : [split(/\s*\|\|\s*/,$field_val->{$type})]; + foreach my $comp (@$ref) { + next if ! $comp; + my $test = 0; + if ($comp =~ /^\s*(>|<|[>' ) { $test = ($val > $2) } + elsif ($1 eq '<' ) { $test = ($val < $2) } + elsif ($1 eq '>=') { $test = ($val >= $2) } + elsif ($1 eq '<=') { $test = ($val <= $2) } + elsif ($1 eq '!=') { $test = ($val != $2) } + elsif ($1 eq '==') { $test = ($val == $2) } + + } elsif ($comp =~ /^\s*(eq|ne|gt|ge|lt|le)\s+(.+?)\s*$/) { + my $val = defined($value) ? $value : ''; + my ($op, $value2) = ($1, $2); + $value2 =~ s/^([\"\'])(.*)\1$/$2/; + if ($op eq 'gt') { $test = ($val gt $value2) } + elsif ($op eq 'lt') { $test = ($val lt $value2) } + elsif ($op eq 'ge') { $test = ($val ge $value2) } + elsif ($op eq 'le') { $test = ($val le $value2) } + elsif ($op eq 'ne') { $test = ($val ne $value2) } + elsif ($op eq 'eq') { $test = ($val eq $value2) } + + } else { + die "Not sure how to compare \"$comp\""; + } + if (! $test) { + return [] if $self->{'_check_conditional'}; + push @errors, [$field, $type, $field_val, $ifs_match]; + } + } + $content_checked = 1; + } } + + # server side sql type + if ($types{'sql'}) { foreach my $type (@{ $types{'sql'} }) { + my $db_type = $field_val->{"${type}_db_type"}; + my $dbh = ($db_type) ? $self->{dbhs}->{$db_type} : $self->{dbh}; + if (! $dbh) { + die "Missing dbh for $type type on field $field" . ($db_type ? " and db_type $db_type" : ""); + } elsif (UNIVERSAL::isa($dbh,'CODE')) { + $dbh = &$dbh($field, $self) || die "SQL Coderef did not return a dbh"; + } + my $sql = $field_val->{$type}; + my @args = ($value) x $sql =~ tr/?//; + my $return = $dbh->selectrow_array($sql, {}, @args); # is this right - copied from O::FORMS + $field_val->{"${type}_error_if"} = 1 if ! defined $field_val->{"${type}_error_if"}; + if ( (! $return && $field_val->{"${type}_error_if"}) + || ($return && ! $field_val->{"${type}_error_if"}) ) { + return [] if $self->{'_check_conditional'}; + push @errors, [$field, $type, $field_val, $ifs_match]; + } + $content_checked = 1; + } } + + # server side custom type + if ($types{'custom'}) { foreach my $type (@{ $types{'custom'} }) { + my $check = $field_val->{$type}; + my $err; + if (UNIVERSAL::isa($check, 'CODE')) { + my $ok; + $err = "$@" if ! eval { $ok = $check->($field, $value, $field_val, $type, $form); 1 }; + next if $ok; + chomp($err) if !ref($@) && defined($err); + } else { + next if $check; + } + return [] if $self->{'_check_conditional'}; + push @errors, [$field, $type, $field_val, $ifs_match, (defined($err) ? $err : ())]; + $content_checked = 1; + } } - ### do specific type checks - foreach my $type (grep {/^type_?\d*$/} @$types) { - if (! $self->check_type($value,$field_val->{'type'},$field,$form)){ - return 1 if ! wantarray; - push @errors, [$field, $type, $field_val, $ifs_match]; - } - $content_checked = 1; } - } - ### allow for the data to be "untainted" - ### this is only allowable if the user ran some other check for the datatype - if ($field_val->{'untaint'} && $#errors == -1) { - if (! $content_checked) { - push @errors, [$field, 'untaint', $field_val, $ifs_match]; - } else { - ### generic untainter - assuming the other required content_checks did good validation - $_ = /(.*)/ ? $1 : die "Couldn't match?" foreach @$values; - if ($n_values == 1) { - $form->{$field} = $values->[0]; - $self->{cgi_object}->param(-name => $field, -value => $values->[0]) - if $self->{cgi_object}; - } else { - ### values in @{ $form->{$field} } were modified directly - $self->{cgi_object}->param(-name => $field, -value => $values) - if $self->{cgi_object}; - } + # allow for the data to be "untainted" + # this is only allowable if the user ran some other check for the datatype + if ($field_val->{'untaint'} && $#errors == -1) { + if (! $content_checked) { + push @errors, [$field, 'untaint', $field_val, $ifs_match]; + } else { + # generic untainter - assuming the other required content_checks did good validation + $_ = /(.*)/ ? $1 : die "Couldn't match?" foreach @$values; + if ($n_values == 1) { + $form->{$field} = $values->[0]; + } + } } - } - ### all done - time to return - return wantarray ? @errors : $#errors + 1; + # all done - time to return + return @errors ? \@errors : 0; } -###----------------------------------------------------------------### +###---------------------### ### used to validate specific types sub check_type { - my $self = shift; - my $value = shift; - my $type = uc(shift); - - ### do valid email address for our system - if ($type eq 'EMAIL') { - return 0 if ! $value; - my($local_p,$dom) = ($value =~ /^(.+)\@(.+?)$/) ? ($1,$2) : return 0; - - return 0 if length($local_p) > 60; - return 0 if length($dom) > 100; - return 0 if ! $self->check_type($dom,'DOMAIN') && ! $self->check_type($dom,'IP'); - return 0 if ! $self->check_type($local_p,'LOCAL_PART'); - - ### the "username" portion of an email address - } elsif ($type eq 'LOCAL_PART') { - return 0 if ! defined($value) || ! length($value); - return 0 if $value =~ m/[^a-z0-9.\-!&+]/; - return 0 if $value =~ m/^[\.\-]/; - return 0 if $value =~ m/[\.\-\&]$/; - return 0 if $value =~ m/(\.\-|\-\.|\.\.)/; - - ### standard IP address - } elsif ($type eq 'IP') { - return 0 if ! $value; - return (4 == grep {!/\D/ && $_ < 256} split /\./, $value, 4); - - ### domain name - including tld and subdomains (which are all domains) - } elsif ($type eq 'DOMAIN') { - return 0 if ! $value; - return 0 if $value =~ m/[^a-z0-9.\-]/; - return 0 if $value =~ m/^[\.\-]/; - return 0 if $value =~ m/(\.\-|\-\.|\.\.)/; - return 0 if length($value) > 255; - return 0 if $value !~ s/\.([a-z]+)$//; - - my $ext = $1; - if ($ext eq 'name') { # .name domains - return 0 if $value !~ /^[a-z0-9][a-z0-9\-]{0,62} \. [a-z0-9][a-z0-9\-]{0,62}$/x; - } else { # any other domains - return 0 if $value !~ /^([a-z0-9][a-z0-9\-]{0,62} \.)* [a-z0-9][a-z0-9\-]{0,62}$/x; - } + my ($self, $value, $type) = @_; + $type = lc $type; + if ($type eq 'email') { + return 0 if ! $value; + my ($local_p,$dom) = ($value =~ /^(.+)\@(.+?)$/) ? ($1,$2) : return 0; + return 0 if length($local_p) > 60; + return 0 if length($dom) > 100; + return 0 if ! $self->check_type($dom,'domain') && ! $self->check_type($dom,'ip'); + return 0 if ! $self->check_type($local_p,'local_part'); + + # the "username" portion of an email address - sort of arbitrary + } elsif ($type eq 'local_part') { + return 0 if ! defined($value) || ! length($value); + # ignoring all valid quoted string local parts + return 0 if $value =~ m/[^\w.~!\#\$%\^&*\-=+?]/; + + # standard IP address + } elsif ($type eq 'ip') { + return 0 if ! $value; + return (4 == grep {!/\D/ && $_ < 256} split /\./, $value, 4); + + # domain name - including tld and subdomains (which are all domains) + } elsif ($type eq 'domain') { + return 0 if ! $value || length($value) > 255; + return 0 if $value !~ /^([a-z0-9][a-z0-9\-]{0,62} \.)+ [a-z]{1,63}$/ix + || $value =~ m/(\.\-|\-\.|\.\.)/; + + # validate a url + } elsif ($type eq 'url') { + return 0 if ! $value; + $value =~ s|^https?://([^/]+)||i || return 0; + my $dom = $1; + return 0 if ! $self->check_type($dom,'domain') && ! $self->check_type($dom,'ip'); + return 0 if $value && ! $self->check_type($value,'uri'); + + # validate a uri - the path portion of a request + } elsif ($type eq 'uri') { + return 0 if ! $value; + return 0 if $value =~ m/\s+/; + + } elsif ($type eq 'int') { + return 0 if $value !~ /^-? (?: 0 | [1-9]\d*) $/x; + return 0 if ($value < 0) ? $value < -2**31 : $value > 2**31-1; + } elsif ($type eq 'uint') { + return 0 if $value !~ /^ (?: 0 | [1-9]\d*) $/x; + return 0 if $value > 2**32-1; + } elsif ($type eq 'num') { + return 0 if $value !~ /^-? (?: 0 | [1-9]\d* (?:\.\d+)? | 0?\.\d+) $/x; + + } elsif ($type eq 'cc') { + return 0 if ! $value; + return 0 if $value =~ /[^\d\-\ ]/; + $value =~ s/\D//g; + return 0 if length($value) > 16 || length($value) < 13; + + # simple mod10 check + my $sum = 0; + my $switch = 0; + foreach my $digit (reverse split //, $value) { + $switch = 1 if ++$switch > 2; + my $y = $digit * $switch; + $y -= 9 if $y > 9; + $sum += $y; + } + return 0 if $sum % 10; - ### validate a url - } elsif ($type eq 'URL') { - return 0 if ! $value; - $value =~ s|^https?://([^/]+)||i || return 0; - my $dom = $1; - return 0 if ! $self->check_type($dom,'DOMAIN') && ! $self->check_type($dom,'IP'); - return 0 if $value && ! $self->check_type($value,'URI'); - - ### validate a uri - the path portion of a request - } elsif ($type eq 'URI') { - return 0 if ! $value; - return 0 if $value =~ m/\s+/; - - } elsif ($type eq 'CC') { - return 0 if ! $value; - ### validate the number - return 0 if $value =~ /[^\d\-\ ]/ - || length($value) > 16 - || length($value) < 13; - - ### simple mod10 check - $value =~ s/\D//g; - my $sum = 0; - my $switch = 0; - foreach my $digit ( reverse split //, $value ){ - $switch = 1 if ++ $switch > 2; - my $y = $digit * $switch; - $y -= 9 if $y > 9; - $sum += $y; } - return 0 if $sum % 10; - - } - return 1; + return 1; } -###----------------------------------------------------------------### +###---------------------### sub get_validation { - my $self = shift; - my $val = shift; - return CGI::Ex::Conf::conf_read($val, {html_key => 'validation', default_ext => $DEFAULT_EXT}); + my ($self, $val) = @_; + require CGI::Ex::Conf; + return CGI::Ex::Conf::conf_read($val, {html_key => 'validation', default_ext => 'val'}); } ### returns all keys from all groups - even if group has validate_if sub get_validation_keys { - my $self = shift; - my $val_hash = shift; - my $form = shift; # with optional form - will only return keys in validated groups - my %keys = (); - - ### if a form was passed - make sure it is a hashref - if ($form) { - if (! ref($form)) { - die "Invalid form hash or cgi object"; - } elsif(! UNIVERSAL::isa($form,'HASH')) { - require CGI::Ex; - $form = CGI::Ex->new->get_form($form); - } - } - - my $refs = $self->get_validation($val_hash); - $refs = [$refs] if ! UNIVERSAL::isa($refs,'ARRAY'); - foreach my $group_val (@$refs) { - die "Group found that was not a hashref" if ! UNIVERSAL::isa($group_val, 'HASH'); + my ($self, $val_hash, $form) = @_; # with optional form - will only return keys in validated groups - ### if form is passed, check to see if the group passed validation if ($form) { - my $validate_if = $group_val->{'group validate_if'}; - next if $validate_if && ! $self->check_conditional($form, $validate_if); - } - - if ($group_val->{"group fields"}) { - die "Group fields must be an arrayref" if ! UNIVERSAL::isa($group_val->{"group fields"}, 'ARRAY'); - foreach my $field_val (@{ $group_val->{"group fields"} }) { - next if ! ref($field_val) && $field_val eq 'OR'; - die "Field_val must be a hashref" if ! UNIVERSAL::isa($field_val, 'HASH'); - my $key = $field_val->{'field'} || die "Missing field key in field_val hashref"; - $keys{$key} = $field_val->{'name'} || 1; - } - } elsif ($group_val->{"group order"}) { - die "Group order must be an arrayref" if ! UNIVERSAL::isa($group_val->{"group order"}, 'ARRAY'); - foreach my $key (@{ $group_val->{"group order"} }) { - my $field_val = $group_val->{$key}; - next if ! $field_val && $key eq 'OR'; - die "Field_val for $key must be a hashref" if ! UNIVERSAL::isa($field_val, 'HASH'); - $key = $field_val->{'field'} if $field_val->{'field'}; - $keys{$key} = $field_val->{'name'} || 1; - } - } - - ### get all others - foreach my $key (keys %$group_val) { - next if $key =~ /^(general|group)\s/; - my $field_val = $group_val->{$key}; - next if ! UNIVERSAL::isa($field_val, 'HASH'); - $keys{$key} = $field_val->{'name'} || 1; + die "Invalid form hash or cgi object" if ! ref $form; + $form = $self->cgix->get_form($form) if ref $form ne 'HASH'; } - } - return \%keys; + my ($fields, $ARGS) = $self->get_ordered_fields($val_hash); + return {} if ! @$fields; + return {} if $form && $ARGS->{'validate_if'} && ! $self->check_conditional($form, $ARGS->{'validate_if'}); + return {map { $_->{'field'} = $_->{'name'} || 1 } @$fields}; } -###----------------------------------------------------------------### +###---------------------### -### spit out a chunk that will do the validation sub generate_js { - ### allow for some browsers to not receive the validation js + my $self = shift; + return "" - if $ENV{'HTTP_USER_AGENT'} && grep {$ENV{'HTTP_USER_AGENT'} =~ $_} @UNSUPPORTED_BROWSERS; + if $self->cgix->env->{'HTTP_USER_AGENT'} && grep {$self->cgix->env->{'HTTP_USER_AGENT'} =~ $_} @UNSUPPORTED_BROWSERS; + + my $val_hash = shift || croak "Missing validation hash"; + if (ref $val_hash ne 'HASH') { + $val_hash = $self->get_validation($val_hash) if ref $val_hash ne 'SCALAR' || ! ref $val_hash; + croak "Validation groups must be a hashref" if ref $val_hash ne 'HASH'; + } - my $self = shift; - my $val_hash = shift || die "Missing validation"; - my $form_name = shift || die "Missing form name"; - my $js_uri_path = shift || $JS_URI_PATH; - $val_hash = $self->get_validation($val_hash); + my ($args, $form_name, $js_uri_path); + croak "Missing args or form_name" if ! $_[0]; + if (ref($_[0]) eq 'HASH') { + $args = shift; + } else { + ($args, $form_name, $js_uri_path) = ({}, @_); + } - ### store any extra items from self - my %EXTRA = (); - $EXTRA{"general $_"} = $self->{$_} for grep {/$QR_EXTRA/o} keys %$self; # add 'general' to be used in javascript + $form_name ||= $args->{'form_name'} || croak 'Missing form_name'; + $js_uri_path ||= $args->{'js_uri_path'}; my $js_uri_path_validate = $JS_URI_PATH_VALIDATE || do { - die "Missing \$js_uri_path" if ! $js_uri_path; + croak 'Missing js_uri_path' if ! $js_uri_path; "$js_uri_path/CGI/Ex/validate.js"; }; - if (eval { require JSON }) { - my $json = JSON->new(pretty => 1)->objToJson($val_hash); - - return qq{ + require CGI::Ex::JSONDump; + my $json = CGI::Ex::JSONDump->new({pretty => 1})->dump($val_hash); + return qq{ }; +} - } elsif (eval { require YAML }) { - - my $str = YAML::Dump((scalar keys %EXTRA) ? (\%EXTRA) : () , $val_hash); - $str =~ s/(?get_ordered_fields($val_hash); + $args = {%{ $ARGS->{'form_args'} || {}}, %{ $args || {} }}; + + my $cols = ($args->{'no_inline_error'} || ! $args->{'columns'} || $args->{'columns'} != 3) ? 2 : 3; + $args->{'div'} ||= "