##########################################################################
## AnswerHash Package
##
## Provides a data structure for answer hashes. Currently just a wrapper
## for the hash, but that might change

=pod

For the most part AnswerHash is an object which contains data.  It has only a few methods.
The data which is automatically initiallized by the constructor new is given here:

		$new_answer_hash       =        { 	'score'					=>	0,
											'correct_ans'			=>	"No correct answer specified",
											'student_ans'			=>	undef,
											'original_student_ans',	=>	undef,
											'type'					=>	'Undefined answer evaluator type',
											'ans_message'			=>	'',
											
											'preview_text_string'	=>	undef,
											'preview_latex_string'	=>  undef,
											'error_flag'			=>  undef,
											'error_message'		    =>  '',

										};
											


Methods:
				new
				
				setKeys				$rh_ans->setKeys{score=>1};  Sets elements in the AnswerHash.
				                                                   There is a check to make sure that the 
				                                                   key is one of the values listed above.
				                                                   
				                    $rh_ans->{non_standard_value} = 'oops';  
				                    								Add an element to the AnswerHash.
				                    								No checks are made. Can be used (cautiously)
				                    								to customize and extend the AnswerHash type.
				
				OR
				
				AND

=cut

BEGIN {
	be_strict(); # an alias for use strict.  This means that all global variable must contain main:: as a prefix.
    
}

package AnswerHash;
# initialization fields
my %fields = (		'score'					=>	undef,
					'correct_ans'			=>	undef,
					'student_ans'			=>	undef,
					'ans_message'			=>	undef,
					'type'					=>	undef,
					'preview_text_string'	=>	undef,
					'preview_latex_string'	=>	undef,
					'original_student_ans' 	=>	undef
			);

## Initializing constructor
sub new {
	my $class = shift @_;
	
	my $self  = {	'score'					=>	0,
					'correct_ans'			=>	'No correct answer specified',
					'student_ans'			=>	undef,
					'ans_message'			=>	'',
					'type'					=>	'Undefined answer evaluator type',
					'preview_text_string'	=>	undef,
					'preview_latex_string'	=>	undef,
					'original_student_ans'	=>	undef,
					'error_flag'			=>  undef,
					'error_message'		    =>  '',

	};	# return a reference to	a hash.
	
	bless $self, $class;
	$self -> setKeys(@_);
	
	return $self;
}

## IN: a hash
## Checks to make sure that the keys are valid,
## then sets their value
sub setKeys {
    my $self = shift;
	my %inits = @_;
	foreach my $item (keys %inits) {
		if ( exists $fields{$item} ) { 
			$self -> {$item} = $inits{$item};
		}
		else {
			warn "AnswerHash cannot automatically initialize an item named $item";
		}
	}
}

# access methods
sub data {    #$rh_ans->data('foo') is a synonym for $rh_ans->{student_ans}='foo'
	my $self = shift;
	$self->input(@_);
}

sub input {     #$rh_ans->input('foo') is a synonym for $rh_ans->{student_ans}='foo'
	my $self = shift;
    my $input = shift;
    $self->{student_ans} = $input if defined($input);
	$self->{student_ans}
}
sub score {     
	my $self = shift;
    my $score = shift;
    $self->{score} = $score if defined($score);
	$self->{score}
}

# error methods
sub throw_error {
	my $self = shift;
    my $flag = shift;
    my $message = shift;
    $self->{error_message} .= " $message " if defined($message);
    $self->{error_flag} = $flag if defined($flag);
	$self->{error_flag}
}
sub catch_error {
	my $self = shift;
    my $flag = shift;
    return('')  unless defined($self->{error_flag});
    return $self->{error_flag} unless $flag;    # empty input catches all errors.
    return $self->{error_flag} if $self->{error_flag} eq $flag;
	return '';   # nothing to catch
}
sub clear_error {
	my $self = shift;
	my $flag = shift;
	if (defined($flag) and $flag =~/\S/ and defined($self->{error_flag})  and $flag eq $self->{error_flag}) {
		$self->{error_flag} = undef;
		$self->{error_message} = undef;
	}
	$self;
}
sub error_flag {
	my $self = shift;
    my $flag = shift;
    $self->{error_flag} = $flag if defined($flag);
	$self->{error_flag}
}
sub error_message {
	my $self = shift;
    my $message = shift;
    $self->{error_message} = $message if defined($message);
	$self->{error_message}
}

# error print out method

sub pretty_print {
    my $r_input = shift;
    my $out = '';
    if ( not ref($r_input) ) {
    	$out = $r_input;    # not a reference
    } elsif (ref($r_input) =~/hash/i) {
	    local($^W) = 0;
		$out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
		foreach my $key (sort keys %$r_input ) {
			$out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print($r_input->{$key}) . "</td></tr>";
		}
		$out .="</table>";
	} elsif (ref($r_input) eq 'ARRAY' ) {
		my @array = @$r_input;
		$out .= "( " ;
		while (@array) {
			$out .= pretty_print(shift @array) . " , ";
		}
		$out .= " )"; 
	} elsif (ref($r_input) eq 'CODE') {
		$out = "$r_input";
	} else {
		$out = $r_input;
	}
		$out;
}

# action methods	
sub OR {
	my $self = shift;
	
	my $rh_ans2 = shift;
	my %options = @_;
	return($self) unless defined($rh_ans2) and ref($rh_ans2) eq 'AnswerHash';
	
	my $out_hash = new AnswerHash;
	# score is the maximum of the two scores
	$out_hash->{score} = ( $self->{score}  <  $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score};
	$out_hash->{correct_ans} = join(" OR ", $self->{correct_ans}, $rh_ans2->{correct_ans} );
	$out_hash->{student_ans} = $self->{student_ans};
	$out_hash->{type} = join(" OR ", $self->{type}, $rh_ans2->{type} );
	$out_hash->{preview_text_string} = join("   ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} );
	$out_hash->{original_student_ans} = $self->{original_student_ans};
	$out_hash;
}

sub AND {
	my $self = shift;
	my $rh_ans2 = shift;
	my %options = @_;
	my $out_hash = new AnswerHash;
	# score is the minimum of the two scores
	$out_hash->{score} = ( $self->{score}  >  $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score};
	$out_hash->{correct_ans} = join(" AND ", $self->{correct_ans}, $rh_ans2->{correct_ans} );
	$out_hash->{student_ans} = $self->{student_ans};
	$out_hash->{type} = join(" AND ", $self->{type}, $rh_ans2->{type} );
	$out_hash->{preview_text_string} = join("   ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} );
	$out_hash->{original_student_ans} = $self->{original_student_ans};
	$out_hash;
}

package AnswerEvaluator;




sub new {
	my $class = shift @_;
	
	my $self  = {	pre_filters 	=>	[ [\&blank_prefilter] ],
					evaluators		=>	[],
					post_filters	=>  [ [\&blank_postfilter] ],
					debug			=>  0,
					rh_ans		=>	new AnswerHash,
					
	};
	
	bless $self, $class;
	$self->rh_ans(@_);    #initialize answer hash	
	return $self;
}

# dereference_array_ans pretty prints an answer which is stored as an anonymous array.
sub dereference_array_ans {
	my $self = shift;
	my $rh_ans = shift;
	if (defined($rh_ans->{student_ans}) and ref($rh_ans->{student_ans}) eq 'ARRAY'  ) {
		$rh_ans->{student_ans} = "( ". join(" , ",@{$rh_ans->{student_ans}} ) . " ) ";
	}
	$rh_ans;
}
		
sub get_student_answer {
	my $self 	= shift;
	my $input   = shift; 
	
	if ($input =~ /\0/ ) {
	   	my @input = split(/\0/,$input);
	   	$self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
		$input = \@input;
		$self-> {rh_ans} -> {student_ans} = $input;
	} else {
	    $input = '' unless defined($input);
		$self-> {rh_ans} -> {original_student_ans} = $input;
		$self-> {rh_ans} -> {student_ans} = $input;
	}
	
	
	$input;
}

sub evaluate {
	my $self 		= 	shift;
	$self->get_student_answer(shift @_);
	my $rh_ans    =   $self ->{rh_ans};
    
	my @prefilters	= @{$self -> {pre_filters}};
	my $count = -1;  # the blank filter is counted as filter 0
	foreach my $i	(@prefilters) {
	    last if defined( $self->{rh_ans}->{error_flag} );
	    my @array = @$i;
	    my $filter = shift(@array);      # the array now contains the options for the filter
	    if (defined($self->{debug}) and $self->{debug}>0) {
	    	my %options = @array;
	    	$self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
	    	warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print();
	    }
	    $rh_ans 	= &$filter($rh_ans,@array);
	}
	my @evaluators = @{$self -> {evaluators} };
	$count = 0;
	foreach my $i ( @evaluators )   {
	    last if defined($self->{rh_ans}->{error_flag});
		my @array = @$i;
	    my $evaluator = shift(@array);   # the array now contains the options for the filter
	    if (defined($self->{debug}) and $self->{debug}>0) {
	    	my %options = @array;
	    	$self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
	    	warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print();
	    }
		$rh_ans 	= &$evaluator($rh_ans,@array);
	}
	my @post_filters = @{$self -> {post_filters} };
	$count = -1;  # blank filter catcher is filter 0
	foreach my $i ( @post_filters ) {
	    last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
		my @array = @$i;
	    my $filter = shift(@array);      # the array now contains the options for the filter
	    if (defined($self->{debug}) and $self->{debug}>0) {
	    	my %options = @array;
	    	$self->{rh_ans}->{rh_options} = \%options;  #include the options in the debug information
	    	warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print();
	    }
	   
		$rh_ans 	= &$filter($rh_ans,@array);
	}
	$rh_ans = $self->dereference_array_ans($rh_ans);   
	# make sure that the student answer is not an array so that it is reported correctly in answer section.
	warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
	$self ->{rh_ans} = $rh_ans;
	$rh_ans;
}

sub correct_answer_evaluate {
	my $self 		= 	shift;
	$self-> {rh_ans} -> {correct_ans} = shift @_;
	my $rh_ans    =   $self ->{rh_ans};
    
	my @prefilters	= @{$self -> {correct_answer_pre_filters}};
	my $count = -1;  # the blank filter is counted as filter 0
	foreach my $i	(@prefilters) {
	    last if defined( $self->{rh_ans}->{error_flag} );
	    my @array = @$i;
	    my $filter = shift(@array);      # the array now contains the options for the filter
	    warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
		$rh_ans 	= &$filter($rh_ans,@array);
	}
	my @evaluators = @{$self -> {correct_answer_evaluators} };
	$count = 0;
	foreach my $i ( @evaluators )   {
	    last if defined($self->{rh_ans}->{error_flag});
		my @array = @$i;
	    my $evaluator = shift(@array);   # the array now contains the options for the filter
	    warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
		$rh_ans 	= &$evaluator($rh_ans,@array);
	}
	my @post_filters = @{$self -> {correct_answer_post_filters} };
	$count = -1;  # blank filter catcher is filter 0
	foreach my $i ( @post_filters ) {
	    last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
		my @array = @$i;
	    my $filter = shift(@array);      # the array now contains the options for the filter
	    warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
		$rh_ans 	= &$filter($rh_ans,@array);
	}
	$rh_ans = $self->dereference_array_ans($rh_ans);   
	# make sure that the student answer is not an array so that it is reported correctly in answer section.
	warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
	$self ->{rh_ans} = $rh_ans;
	$rh_ans;
}

sub install_pre_filter {
	my $self =	shift;
	if (@_ == 0) {
		# do nothing if input is empty
	} elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
		$self->{pre_filters} = [];
	} else {
		push(@{$self->{pre_filters}},[ @_ ]) if @_;  #install pre_filter and it's options
	}
	@{$self->{pre_filters}};  # return array of all pre_filters
}

sub install_evaluator {
	my $self =	shift;
	if (@_ == 0) {
		# do nothing if input is empty
	} elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
		$self->{evaluators} = [];
	} else {
		push(@{$self->{evaluators}},[ @_ ]) if @_; #install evaluator and it's options
	}
	@{$self->{'evaluators'}};  # return array of all evaluators
}

sub install_post_filter {
	my $self =	shift;
	if (@_ == 0) {
		# do nothing if input is empty
	} elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
		$self->{post_filters} = [];
	} else {
		push(@{$self->{post_filters}}, [ @_ ]) if @_; #install post_filter and it's options
	}
	@{$self->{post_filters}};  # return array of all post_filters
}

## filters for checking the correctAnswer
sub install_correct_answer_pre_filter {
	my $self =	shift;
	if (@_ == 0) {
		# do nothing if input is empty
	} elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
		$self->{correct_answer_pre_filters} = [];
	} else {
		push(@{$self->{correct_answer_pre_filters}},[ @_ ]) if @_;  #install correct_answer_pre_filter and it's options
	}
	@{$self->{correct_answer_pre_filters}};  # return array of all correct_answer_pre_filters
}

sub install_correct_answer_evaluator {
	my $self =	shift;
	if (@_ == 0) {
		# do nothing if input is empty
	} elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
		$self->{correct_answer_evaluators} = [];
	} else {
		push(@{$self->{correct_answer_evaluators}},[ @_ ]) if @_; #install evaluator and it's options
	}
	@{$self->{correct_answer_evaluators}};  # return array of all evaluators
}

sub install_correct_answer_post_filter {
	my $self =	shift;
	if (@_ == 0) {
		# do nothing if input is empty
	} elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) {
		$self->{correct_answer_post_filters} = [];
	} else {
		push(@{$self->{correct_answer_post_filters}}, [ @_ ]) if @_; #install post_filter and it's options
	}
	@{$self->{correct_answer_post_filters}};  # return array of all post_filters
}

sub ans_hash {  #alias for rh_ans
	my $self = shift;
	$self->rh_ans(@_);
}		
sub rh_ans {
	my $self = shift;
	my %in_hash = @_;
	foreach my $key (keys %in_hash) {
		$self->{rh_ans}->{$key} = $in_hash{$key};
	}
	$self->{rh_ans};
}
######################################################
#
# Built in Filters
#
######################################################


sub blank_prefilter  { # check for blanks
	my $rh_ans = shift;  
    # undefined answers are BLANKS
	( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
													  return($rh_ans);};
    # answers which are arrays or hashes or some other object reference  are NOT blanks
    ( ref($rh_ans->{student_ans} )        ) && do { return( $rh_ans ) };
    # if the answer is a true variable consisting only of white space it is a BLANK
    ( ($rh_ans->{student_ans}) !~ /\S/   )    && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
													  return($rh_ans);};
 	# If we get to here, we assume that the answer is not a blank. It is defined, not a reference
 	# and contains something other than whitespaces.
 	$rh_ans;
};

sub blank_postfilter  { 
	my $rh_ans=shift;
    return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK';
    $rh_ans->{error_flag} = undef;
    $rh_ans->{error_message} = '';
    $rh_ans->{done} =1;    # no further checking is needed.
    $rh_ans;
};

1;
#package AnswerEvaluatorMaker;