X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FCGI%2FEx%2FValidate.pm;h=45c26f8c914dd86bec1a2cc9f7f4e23c011205df;hb=HEAD;hp=651b3c903e5f7ffc3ffa1e231554e52a80c2ce56;hpb=a2f50b1efd2bc986617e1de5f5a0bfd8a2953b0e;p=chaz%2Fp5-CGI-Ex diff --git a/lib/CGI/Ex/Validate.pm b/lib/CGI/Ex/Validate.pm index 651b3c9..45c26f8 100644 --- a/lib/CGI/Ex/Validate.pm +++ b/lib/CGI/Ex/Validate.pm @@ -1,132 +1,50 @@ package CGI::Ex::Validate; -=head1 NAME - -CGI::Ex::Validate - another form validator - but it does javascript in parallel - -=cut - -###----------------------------------------------------------------### -# Copyright 2007 - Paul Seamons # -# Distributed under the Perl Artistic License without warranty # -###----------------------------------------------------------------### +###---------------------### +# See the perldoc in CGI/Ex/Validate.pod +# Copyright 2003-2012 - Paul Seamons +# Distributed under the Perl Artistic License without warranty 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 - ); - -$VERSION = '2.19'; +use Carp qw(croak); -$DEFAULT_EXT = 'val'; -$QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/; -@UNSUPPORTED_BROWSERS = (qr/MSIE\s+5.0\d/i); - -###----------------------------------------------------------------### +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; sub new { - my $class = shift; - my $self = ref($_[0]) ? shift : {@_}; - - $self = {%DEFAULT_OPTIONS, %$self} if scalar keys %DEFAULT_OPTIONS; - - return bless $self, $class; + my $class = shift || croak "Usage: ".__PACKAGE__."->new"; + my $self = ref($_[0]) ? shift : {@_}; + return bless $self, $class; } -###----------------------------------------------------------------### - -sub cgix { - my $self = shift; - return $self->{'cgix'} ||= do { - require CGI::Ex; - CGI::Ex->new; - }; -} +sub cgix { shift->{'cgix'} ||= do { require CGI::Ex; CGI::Ex->new } } -### 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 hash if doesn't look like one already - die "Invalid form hash or cgi object" if ! ref $form; - if (ref $form ne 'HASH') { - local $self->{cgi_object} = $form; - $form = $self->cgix->get_form($form); - } + 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) = @_; - ### make sure the validation is a hashref - ### get_validation handle odd types - 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'; - } - - ### parse keys that are group arguments - and those that are keys to validate - my %ARGS; - my @field_keys = grep { /^(?:group|general)\s+(\w+)/ - ? do {$ARGS{$1} = $val_hash->{$_} ; 0} - : 1 } - sort keys %$val_hash; - - ### only validate this group if it is supposed to be checked - return if $ARGS{'validate_if'} && ! $self->check_conditional($form, $ARGS{'validate_if'}); - - ### Look first for items in 'group fields' or 'group order' - my $fields; - if ($fields = $ARGS{'fields'} || $ARGS{'order'}) { - my $type = $ARGS{'fields'} ? 'group fields' : 'group order'; - die "Validation '$type' must be an arrayref when passed" - if ! UNIVERSAL::isa($fields, 'ARRAY'); - my @temp; - foreach my $field (@$fields) { - 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 @temp, $field; - } elsif ($field eq 'OR') { - push @temp, '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'; - push @temp, { %{ $val_hash->{$field} }, field => $field }; # copy the values to add the key - } - } - $fields = \@temp; + die "Invalid form hash or cgi object" if ! $form || ! ref $form; + $form = $self->cgix->get_form($form) if ref $form ne 'HASH'; - ### limit the keys that need to be searched to those not in fields or order - my %found = map { $_->{'field'} => 1 } @temp; - @field_keys = grep { ! $found{$_} } @field_keys; - } + my ($fields, $ARGS) = $self->get_ordered_fields($val_hash); + return if ! @$fields; - ### 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}->{'field'}; - } else { - push @$fields, { %{$val_hash->{$field}}, field => $field }; - } - } - return if ! $fields; + return if $ARGS->{'validate_if'} && ! $self->check_conditional($form, $ARGS->{'validate_if'}); - ### Finally we have our arrayref of hashrefs that each have their 'field' key - ### now lets do the validation + # 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') { @@ -135,15 +53,24 @@ sub validate { next; } $found = 1; - die "Missing field key during normal validation" if ! $ref->{'field'}; + 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, $ref->{'field'}, $ref); + 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; } - ### test the error - if errors occur allow for OR - if OR fails use errors from first fail + # 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 { @@ -156,27 +83,80 @@ sub validate { } push(@errors, @$hold_error) if $hold_error; # allow for final OR to work - - ### optionally check for unused keys in the form - if ($ARGS{no_extra_fields} || $self->{no_extra_fields}) { - my %keys = map { ($_->{'field'} => 1) } @$fields; # %{ $self->get_validation_keys($val_hash) }; + # 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]; } } - ### return what they want 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'}; + @{ $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; - } else { - return; } + + return; # success +} + +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 %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; + } + } + + # 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; + } + + # 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 @$fields, { %{$val_hash->{$field}}, field => $field }; + } + } + + return ($fields || [], \%ARGS); } sub new_error { @@ -186,651 +166,634 @@ sub new_error { ### allow for optional validation on groups and on individual items sub check_conditional { - my ($self, $form, $ifs, $ifs_match) = @_; - - ### 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]; - } - - 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 =~ 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 $errs = $self->validate_buddy($form, $field, $ref); - $found = 0 if $errs; - } - 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, $ifs_match) = @_; - - local $self->{'_recurse'} = ($self->{'_recurse'} || 0) + 1; - die "Max dependency level reached 10" if $self->{'_recurse'} > 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 0; - } - - ### 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; - } - - my $values = UNIVERSAL::isa($form->{$field},'ARRAY') ? $form->{$field} : [$form->{$field}]; - my $n_values = $#$values + 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; - ### 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'}; - } - } - - ### 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; + if ($field_val->{'exclude_cgi'}) { + delete $field_val->{'was_validated'}; + return 0; } - if ($field_val->{'trim_control_chars'}) { - $value =~ y/\t/ /; - $value =~ y/\x00-\x1F//d; - $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; + } + if ($field_val->{'trim_control_chars'}) { + $modified = 1 if $value =~ y/\t/ /; + $modified = 1 if $value =~ y/\x00-\x1F//d; } - }else{ - foreach my $value (@$values) { - next if ! defined $value; - $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->{'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, $ifs_match); - $needs_val ++ if $ret; - } - if (! $needs_val && $n_vif) { - delete $field_val->{'was_validated'}; - return 0; - } - - ### 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, $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 [] if $self->{'_check_conditional'}; - return [[$field, $is_required, $field_val, $ifs_match]]; - } - - ### min values check - 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]]; - } - - ### 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 [] if $self->{'_check_conditional'}; - return [[$field, 'max_values', $field_val, $ifs_match]]; - } - - ### 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 [] if $self->{'_check_conditional'}; - return [[$field, $type, $field_val, $ifs_match]]; - } - } - } - - ### 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 [] if $self->{'_check_conditional'}; - 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) { + # 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'}; - push @errors, [$field, $type, $field_val, $ifs_match]; - } - $content_checked = 1; + 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) { + my $n = exists($field_val->{'min_values'}) ? $field_val->{'min_values'} || 0 : 0; + if ($n_values < $n) { return [] if $self->{'_check_conditional'}; - push @errors, [$field, 'min_len', $field_val, $ifs_match]; - } + 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) { + $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'}; - push @errors, [$field, 'max_len', $field_val, $ifs_match]; - } + 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 [] if $self->{'_check_conditional'}; - 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) - } else { - die "Not sure how to compare \"$comp\""; + 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; } - if (! $test) { - return [] if $self->{'_check_conditional'}; - push @errors, [$field, $type, $field_val, $ifs_match]; + + # 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; } - } - $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 [] if $self->{'_check_conditional'}; - push @errors, [$field, $type, $field_val, $ifs_match]; - } - $content_checked = 1; - } + # 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]; + } + } - ### 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 [] if $self->{'_check_conditional'}; - 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]; + } + } + + # 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 [] if $self->{'_check_conditional'}; - 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 @errors ? \@errors : 0; + # 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; + my ($self, $val) = @_; require CGI::Ex::Conf; - return CGI::Ex::Conf::conf_read($val, {html_key => 'validation', default_ext => $DEFAULT_EXT}); + 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 - - ### turn the form into a form hash if doesn't look like one already - if ($form) { - die "Invalid form hash or cgi object" if ! ref $form; - if (ref $form ne 'HASH') { - local $self->{cgi_object} = $form; - $form = $self->cgix->get_form($form); - } - } - - ### make sure the validation is a hashref - ### get_validation handle odd types - 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'; - } - - ### parse keys that are group arguments - and those that are keys to validate - my %ARGS; - my @field_keys = grep { /^(?:group|general)\s+(\w+)/ - ? do {$ARGS{$1} = $val_hash->{$_} ; 0} - : 1 } - sort keys %$val_hash; - - ### only validate this group if it is supposed to be checked - return if $form && $ARGS{'validate_if'} && ! $self->check_conditional($form, $ARGS{'validate_if'}); - - ### Look first for items in 'group fields' or 'group order' - my %keys; - if (my $fields = $ARGS{'fields'} || $ARGS{'order'}) { - my $type = $ARGS{'fields'} ? 'group fields' : 'group order'; - die "Validation '$type' must be an arrayref when passed" - if ! UNIVERSAL::isa($fields, 'ARRAY'); - foreach my $field (@$fields) { - 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'}; - $keys{$field->{'field'}} = $field->{'name'} || 1; - } elsif ($field eq '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'; - $keys{$field} = $val_hash->{$field}->{'name'} || 1; - } + my ($self, $val_hash, $form) = @_; # with optional form - will only return keys in validated groups + + if ($form) { + die "Invalid form hash or cgi object" if ! ref $form; + $form = $self->cgix->get_form($form) if ref $form ne 'HASH'; } - } - - ### 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) { - next if $keys{$field}; - die "Found nonhashref value for field $field" if ref($val_hash->{$field}) ne 'HASH'; - if (defined $val_hash->{$field}->{'field'}) { - $keys{$val_hash->{$field}->{'field'}} = $val_hash->{$field}->{'name'} || 1; - } else { - $keys{$field} = $val_hash->{$field}->{'name'} || 1; - } - } - - 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 (! $self->{'no_jsondump'} && eval { require CGI::Ex::JSONDump }) { - my $json = CGI::Ex::JSONDump->new({pretty => 1})->dump($val_hash); - return qq{ + require CGI::Ex::JSONDump; + my $json = CGI::Ex::JSONDump->new({pretty => 1})->dump($val_hash); + return qq{ }; +} - } elsif (! $self->{'no_json'} && eval { require JSON }) { - my $json = JSON->new(pretty => 1)->objToJson($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'} ||= "