package GO::Data_FormValidator_Results;
use strict;
# use lib '/Users/gwg/go/scratch/tools';

use base 'Data::FormValidator::Results';

### Various modules required
use Data::Dumper;
#use CGI::Carp qw(fatalsToBrowser);


=head2

Add a valid parameter, and remove an invalid or missing parameter

=cut

sub update_parameter {
	my $self = shift;
	my $param = shift;
	my $value = shift;
	my $value_to_be_replaced = shift;
	
	## add value to $param
	$self->valid($param, $value);

	## see if it's in the invalid or missing lists; delete if it is
	if ($self->invalid($param))
	{	# get rid of a specific value and replace it with the new one
		if ($value_to_be_replaced)
		{	if (ref($self->{invalid}{$param}) eq 'ARRAY')
			{	my @keepers = map { $_ ne $value_to_be_replaced } @{$self->{invalid}{$param}};
				$self->{invalid}{$param} = @keepers if scalar @keepers;
			}
			else
			{	delete $self->{invalid}{$param};
			}
		}
		# clean sweep, replacing the whole param
		else
		{	delete $self->{invalid}{$param};
		}
	}
	
	if ($self->missing($param))
	{	delete $self->{missing}{$param};
	}
}

=head2

Replace an invalid parameter with the default value

=cut

sub replace_invalid_with_default {
	my $self = shift;
	return if $self->success;  # no need to do anything

	my $test_list = shift || [ keys %{$self->{invalid}} ];

	return if (!$test_list || scalar(@$test_list) < 1);

	my $check_regexps;
	foreach (@$test_list)
	{	next if $self->valid($_);
		if ($self->{profile}{defaults}{$_})
		{	my $value = $self->{profile}{defaults}{$_};
			if (ref($value) && ref($value) eq "CODE") {
				$value = $value->($self);
			}
			$self->update_parameter($_, $value);
		}
		else
		{	push @$check_regexps, $_;
		}
	}

	if ($check_regexps && @$check_regexps)
	{	while ( my ($re,$value) = each %{$self->{profile}{defaults_regexp_map}} ) {
			# We only add defaults for fields in the test_list. 
			for (@$check_regexps) {
				next unless m/$re/;
				if (ref($value) && ref($value) eq "CODE") {
					$value = $value->($self);
				}
				$self->update_parameter($_, $value);
			}
		}
	}
}


# =head2 _constraint_check_match()
#
# ($value,$failed_href) = $self->_constraint_check_match($c,\@params,$untaint_this);
#
# This is the routine that actually, finally, checks if a constraint passes or fails.
#
# Input:
#   - $c,            a constraint hash, as returned by C<_constraint_hash_build()>.
#   - \@params,      params to pass to the constraint, as prepared by C<_constraint_input_build()>. 
#   - $untaint_this  bool if we untaint successful constraints. 
#
# Output:
#  - $value          the value if successful
#  - $failed_href    a hashref with the following keys:
#		- failed     bool for failure or not
#	    - name	     name of the failed constraint, if known. 

sub _constraint_check_match {
	my 	($self,$c,$params,$untaint_this) = @_;
	die "_constraint_check_match received wrong number of arguments" unless (scalar @_ == 4);

    # Store whether or not we want untainting in the object so that constraints
    # can do the right thing conditionally.
    $self->{__UNTAINT_THIS} = $untaint_this;

    my $match = $c->{constraint}->( @$params );

    # We need to make this distinction when untainting,
    # to allow untainting values that are defined but not true,
    # such as zero.
    my $success;
    if (defined $match) {
       $success =  ($untaint_this) ? length $match : $match;
    }

	my $failed = 1 unless $success;

	# new!
	my $return_h = { failed  => $failed,
		name  => $self->{__CURRENT_CONSTRAINT_NAME},
		value => $self->{__CURRENT_CONSTRAINT_VALUE},
		field => $self->{__CURRENT_CONSTRAINT_FIELD},
	};

#	print STDERR "match: $match\n";

	push @{$self->{all_invalid_data}{ $self->{__CURRENT_CONSTRAINT_FIELD} }}, $return_h if $failed;

	return (
		$match, $return_h
	);
}


# =head2 _check_constraints()
#
# $self->_check_constraints(
#	$profile->{constraint_methods},
#	\%valid, 
#	$untaint_all
#	\%untaint_hash
#	$force_method_p
#);
#
# Input:
#  - 'constraints' or 'constraint_methods' hashref
#  - hashref of valid data
#  - bool to try to untaint everything
#  - hashref of things to untaint
#  - bool if all constraints should be treated as methods. 
	
sub _check_constraints {
	my ($self, 
	    $constraint_href, 
		$valid, 
		$untaint_all,
		$untaint_href,
		$force_method_p) = @_; 

	my $printme;
	while ( my ($field,$constraint_list) = each %$constraint_href ) {

	if ($field eq 'feature')
	{	$printme = 1;
	}
	else
	{	undef $printme;
	}

#	print STDERR "\nlooking at field $field; constraint list is $constraint_list,\n".Dumper($constraint_list) if $printme;
	print STDERR "Skipping $field!\n" && next unless exists $valid->{$field};

		my $is_constraint_list = 1 if (ref $constraint_list eq 'ARRAY');
		my $untaint_this = ($untaint_all || $untaint_href->{$field} || 0);

		my @invalid_list;
        # used to insure we only bother recording each failed constraint once
		my %constraints_seen;


		for my $constraint_spec (Data::FormValidator::_arrayify($constraint_list)) {

#			print STDERR "constraint: ".Dumper($constraint_spec) if $printme;
			# set current constraint field for use by get_current_constraint_field
			$self->{__CURRENT_CONSTRAINT_FIELD} = $field;

			# Initialize the current constraint name to undef, to prevent it
			# from being accidently shared
			$self->{__CURRENT_CONSTRAINT_NAME} = undef;

			my $c = $self->_constraint_hash_build($constraint_spec,$untaint_this, $force_method_p);
			$c->{is_method} = 1 if $force_method_p;

#			print STDERR "valid->{field}: ".Dumper($valid->{$field}) if $printme;

			my $is_value_list = 1 if (ref $valid->{$field} eq 'ARRAY');
			my %param_data = ( $self->_get_input_as_hash($self->get_input_data) , %$valid );


			if ($is_value_list) {
				for (my $i = 0; $i < scalar @{ $valid->{$field}} ; $i++) {
#					print STDERR "starting loop! i = $i\n" if $printme;
					if( !exists $constraints_seen{\$c} ) {

							my @params = $self->_constraint_input_build($c,$valid->{$field}->[$i],\%param_data);

							# set current constraint field for use by get_current_constraint_value
							$self->{__CURRENT_CONSTRAINT_VALUE} = $valid->{$field}->[$i];
#					print STDERR "__CURRENT_CONSTRAINT_VALUE: ".$valid->{$field}->[$i]."\n" if $printme;

							my ($match,$failed) = $self->_constraint_check_match($c,\@params,$untaint_this);
							if ($failed->{failed}) {
								push @invalid_list, $failed;
								$constraints_seen{\$c} = 1;
							}
							else {
								$valid->{$field}->[$i] = $match if $untaint_this;
							}
					}
				}
			}
			else {
				my @params = $self->_constraint_input_build($c,$valid->{$field},\%param_data);

				# set current constraint field for use by get_current_constraint_value
				$self->{__CURRENT_CONSTRAINT_VALUE} = $valid->{$field};
#				print STDERR "__CURRENT_CONSTRAINT_VALUE: ".$valid->{$field}."\n" if $printme;

				my ($match,$failed) = $self->_constraint_check_match($c,\@params,$untaint_this);
				if ($failed->{failed}) {
					push @invalid_list, $failed
				}
				else {
					$valid->{$field} = $match if $untaint_this;
				}
			}
#			print STDERR "valid: ".Dumper($valid->{$field}) if $printme;
	   }


		if (@invalid_list) {
#			print STDERR "invalid_list: ".Dumper([@invalid_list]) if $printme;
			my @failed = map { $_->{name} } @invalid_list;
			push @{ $self->{invalid}{$field}  }, @failed;
            # the older interface to validate returned things differently
			push @{ $self->{validate_invalid} }, $is_constraint_list ? [$field, @failed] : $field;
		}
	}

#	print STDERR "self at the end of _check_constraints: ".Dumper($self)."\n\n";

}



1;