Parent Directory
| 
Revision Log
Revision 173 - (view) (download) (as text)
| 1 : | sam | 2 | ########################################################################## |
| 2 : | ## AnswerHash Package | ||
| 3 : | ## | ||
| 4 : | ## Provides a data structure for answer hashes. Currently just a wrapper | ||
| 5 : | ## for the hash, but that might change | ||
| 6 : | |||
| 7 : | =pod | ||
| 8 : | |||
| 9 : | For the most part AnswerHash is an object which contains data. It has only a few methods. | ||
| 10 : | The data which is automatically initiallized by the constructor new is given here: | ||
| 11 : | |||
| 12 : | $new_answer_hash = { 'score' => 0, | ||
| 13 : | 'correct_ans' => "No correct answer specified", | ||
| 14 : | 'student_ans' => undef, | ||
| 15 : | 'original_student_ans', => undef, | ||
| 16 : | 'type' => 'Undefined answer evaluator type', | ||
| 17 : | 'ans_message' => '', | ||
| 18 : | |||
| 19 : | 'preview_text_string' => undef, | ||
| 20 : | 'preview_latex_string' => undef, | ||
| 21 : | 'error_flag' => undef, | ||
| 22 : | 'error_message' => '', | ||
| 23 : | |||
| 24 : | }; | ||
| 25 : | |||
| 26 : | |||
| 27 : | |||
| 28 : | Methods: | ||
| 29 : | new | ||
| 30 : | |||
| 31 : | setKeys $rh_ans->setKeys{score=>1}; Sets elements in the AnswerHash. | ||
| 32 : | There is a check to make sure that the | ||
| 33 : | key is one of the values listed above. | ||
| 34 : | |||
| 35 : | $rh_ans->{non_standard_value} = 'oops'; | ||
| 36 : | Add an element to the AnswerHash. | ||
| 37 : | No checks are made. Can be used (cautiously) | ||
| 38 : | to customize and extend the AnswerHash type. | ||
| 39 : | |||
| 40 : | OR | ||
| 41 : | |||
| 42 : | AND | ||
| 43 : | |||
| 44 : | =cut | ||
| 45 : | |||
| 46 : | BEGIN { | ||
| 47 : | be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. | ||
| 48 : | |||
| 49 : | } | ||
| 50 : | |||
| 51 : | package AnswerHash; | ||
| 52 : | # initialization fields | ||
| 53 : | my %fields = ( 'score' => undef, | ||
| 54 : | 'correct_ans' => undef, | ||
| 55 : | 'student_ans' => undef, | ||
| 56 : | 'ans_message' => undef, | ||
| 57 : | 'type' => undef, | ||
| 58 : | 'preview_text_string' => undef, | ||
| 59 : | 'preview_latex_string' => undef, | ||
| 60 : | 'original_student_ans' => undef | ||
| 61 : | ); | ||
| 62 : | |||
| 63 : | ## Initializing constructor | ||
| 64 : | sub new { | ||
| 65 : | my $class = shift @_; | ||
| 66 : | |||
| 67 : | my $self = { 'score' => 0, | ||
| 68 : | 'correct_ans' => 'No correct answer specified', | ||
| 69 : | 'student_ans' => undef, | ||
| 70 : | 'ans_message' => '', | ||
| 71 : | 'type' => 'Undefined answer evaluator type', | ||
| 72 : | 'preview_text_string' => undef, | ||
| 73 : | 'preview_latex_string' => undef, | ||
| 74 : | 'original_student_ans' => undef, | ||
| 75 : | 'error_flag' => undef, | ||
| 76 : | 'error_message' => '', | ||
| 77 : | |||
| 78 : | }; # return a reference to a hash. | ||
| 79 : | |||
| 80 : | bless $self, $class; | ||
| 81 : | $self -> setKeys(@_); | ||
| 82 : | |||
| 83 : | return $self; | ||
| 84 : | } | ||
| 85 : | |||
| 86 : | ## IN: a hash | ||
| 87 : | ## Checks to make sure that the keys are valid, | ||
| 88 : | ## then sets their value | ||
| 89 : | sub setKeys { | ||
| 90 : | my $self = shift; | ||
| 91 : | my %inits = @_; | ||
| 92 : | foreach my $item (keys %inits) { | ||
| 93 : | if ( exists $fields{$item} ) { | ||
| 94 : | $self -> {$item} = $inits{$item}; | ||
| 95 : | } | ||
| 96 : | else { | ||
| 97 : | warn "AnswerHash cannot automatically initialize an item named $item"; | ||
| 98 : | } | ||
| 99 : | } | ||
| 100 : | } | ||
| 101 : | |||
| 102 : | # access methods | ||
| 103 : | sub data { #$rh_ans->data('foo') is a synonym for $rh_ans->{student_ans}='foo' | ||
| 104 : | my $self = shift; | ||
| 105 : | $self->input(@_); | ||
| 106 : | } | ||
| 107 : | |||
| 108 : | sub input { #$rh_ans->input('foo') is a synonym for $rh_ans->{student_ans}='foo' | ||
| 109 : | my $self = shift; | ||
| 110 : | my $input = shift; | ||
| 111 : | $self->{student_ans} = $input if defined($input); | ||
| 112 : | $self->{student_ans} | ||
| 113 : | } | ||
| 114 : | sub score { | ||
| 115 : | my $self = shift; | ||
| 116 : | my $score = shift; | ||
| 117 : | $self->{score} = $score if defined($score); | ||
| 118 : | $self->{score} | ||
| 119 : | } | ||
| 120 : | |||
| 121 : | # error methods | ||
| 122 : | sub throw_error { | ||
| 123 : | my $self = shift; | ||
| 124 : | my $flag = shift; | ||
| 125 : | my $message = shift; | ||
| 126 : | $self->{error_message} .= " $message " if defined($message); | ||
| 127 : | $self->{error_flag} = $flag if defined($flag); | ||
| 128 : | $self->{error_flag} | ||
| 129 : | } | ||
| 130 : | sub catch_error { | ||
| 131 : | my $self = shift; | ||
| 132 : | my $flag = shift; | ||
| 133 : | return('') unless defined($self->{error_flag}); | ||
| 134 : | return $self->{error_flag} unless $flag; # empty input catches all errors. | ||
| 135 : | return $self->{error_flag} if $self->{error_flag} eq $flag; | ||
| 136 : | return ''; # nothing to catch | ||
| 137 : | } | ||
| 138 : | sub clear_error { | ||
| 139 : | my $self = shift; | ||
| 140 : | my $flag = shift; | ||
| 141 : | if (defined($flag) and $flag =~/\S/ and defined($self->{error_flag}) and $flag eq $self->{error_flag}) { | ||
| 142 : | $self->{error_flag} = undef; | ||
| 143 : | $self->{error_message} = undef; | ||
| 144 : | } | ||
| 145 : | $self; | ||
| 146 : | } | ||
| 147 : | sub error_flag { | ||
| 148 : | my $self = shift; | ||
| 149 : | my $flag = shift; | ||
| 150 : | $self->{error_flag} = $flag if defined($flag); | ||
| 151 : | $self->{error_flag} | ||
| 152 : | } | ||
| 153 : | sub error_message { | ||
| 154 : | my $self = shift; | ||
| 155 : | my $message = shift; | ||
| 156 : | $self->{error_message} = $message if defined($message); | ||
| 157 : | $self->{error_message} | ||
| 158 : | } | ||
| 159 : | |||
| 160 : | # error print out method | ||
| 161 : | |||
| 162 : | sub pretty_print { | ||
| 163 : | my $r_input = shift; | ||
| 164 : | my $out = ''; | ||
| 165 : | if ( not ref($r_input) ) { | ||
| 166 : | $out = $r_input; # not a reference | ||
| 167 : | } elsif (ref($r_input) =~/hash/i) { | ||
| 168 : | local($^W) = 0; | ||
| 169 : | $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">"; | ||
| 170 : | foreach my $key (sort keys %$r_input ) { | ||
| 171 : | $out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print($r_input->{$key}) . "</td></tr>"; | ||
| 172 : | } | ||
| 173 : | $out .="</table>"; | ||
| 174 : | } elsif (ref($r_input) eq 'ARRAY' ) { | ||
| 175 : | my @array = @$r_input; | ||
| 176 : | $out .= "( " ; | ||
| 177 : | while (@array) { | ||
| 178 : | $out .= pretty_print(shift @array) . " , "; | ||
| 179 : | } | ||
| 180 : | $out .= " )"; | ||
| 181 : | } elsif (ref($r_input) eq 'CODE') { | ||
| 182 : | $out = "$r_input"; | ||
| 183 : | } else { | ||
| 184 : | $out = $r_input; | ||
| 185 : | } | ||
| 186 : | $out; | ||
| 187 : | } | ||
| 188 : | |||
| 189 : | # action methods | ||
| 190 : | sub OR { | ||
| 191 : | my $self = shift; | ||
| 192 : | |||
| 193 : | my $rh_ans2 = shift; | ||
| 194 : | my %options = @_; | ||
| 195 : | return($self) unless defined($rh_ans2) and ref($rh_ans2) eq 'AnswerHash'; | ||
| 196 : | |||
| 197 : | my $out_hash = new AnswerHash; | ||
| 198 : | # score is the maximum of the two scores | ||
| 199 : | $out_hash->{score} = ( $self->{score} < $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score}; | ||
| 200 : | $out_hash->{correct_ans} = join(" OR ", $self->{correct_ans}, $rh_ans2->{correct_ans} ); | ||
| 201 : | $out_hash->{student_ans} = $self->{student_ans}; | ||
| 202 : | $out_hash->{type} = join(" OR ", $self->{type}, $rh_ans2->{type} ); | ||
| 203 : | $out_hash->{preview_text_string} = join(" ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} ); | ||
| 204 : | $out_hash->{original_student_ans} = $self->{original_student_ans}; | ||
| 205 : | $out_hash; | ||
| 206 : | } | ||
| 207 : | |||
| 208 : | sub AND { | ||
| 209 : | my $self = shift; | ||
| 210 : | my $rh_ans2 = shift; | ||
| 211 : | my %options = @_; | ||
| 212 : | my $out_hash = new AnswerHash; | ||
| 213 : | # score is the minimum of the two scores | ||
| 214 : | $out_hash->{score} = ( $self->{score} > $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score}; | ||
| 215 : | $out_hash->{correct_ans} = join(" AND ", $self->{correct_ans}, $rh_ans2->{correct_ans} ); | ||
| 216 : | $out_hash->{student_ans} = $self->{student_ans}; | ||
| 217 : | $out_hash->{type} = join(" AND ", $self->{type}, $rh_ans2->{type} ); | ||
| 218 : | $out_hash->{preview_text_string} = join(" ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} ); | ||
| 219 : | $out_hash->{original_student_ans} = $self->{original_student_ans}; | ||
| 220 : | $out_hash; | ||
| 221 : | } | ||
| 222 : | |||
| 223 : | package AnswerEvaluator; | ||
| 224 : | |||
| 225 : | |||
| 226 : | |||
| 227 : | |||
| 228 : | sub new { | ||
| 229 : | my $class = shift @_; | ||
| 230 : | |||
| 231 : | my $self = { pre_filters => [ [\&blank_prefilter] ], | ||
| 232 : | evaluators => [], | ||
| 233 : | post_filters => [ [\&blank_postfilter] ], | ||
| 234 : | gage | 5 | debug => 0, |
| 235 : | sam | 2 | rh_ans => new AnswerHash, |
| 236 : | |||
| 237 : | }; | ||
| 238 : | |||
| 239 : | bless $self, $class; | ||
| 240 : | $self->rh_ans(@_); #initialize answer hash | ||
| 241 : | return $self; | ||
| 242 : | } | ||
| 243 : | |||
| 244 : | # dereference_array_ans pretty prints an answer which is stored as an anonymous array. | ||
| 245 : | sub dereference_array_ans { | ||
| 246 : | my $self = shift; | ||
| 247 : | my $rh_ans = shift; | ||
| 248 : | if (defined($rh_ans->{student_ans}) and ref($rh_ans->{student_ans}) eq 'ARRAY' ) { | ||
| 249 : | $rh_ans->{student_ans} = "( ". join(" , ",@{$rh_ans->{student_ans}} ) . " ) "; | ||
| 250 : | } | ||
| 251 : | $rh_ans; | ||
| 252 : | } | ||
| 253 : | gage | 109 | |
| 254 : | sam | 2 | sub get_student_answer { |
| 255 : | my $self = shift; | ||
| 256 : | my $input = shift; | ||
| 257 : | gage | 109 | if (ref($input) =~/AnswerHash/) { |
| 258 : | # in this case nothing needs to be done, since the student's answer is already in an answerhash. | ||
| 259 : | # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator. | ||
| 260 : | } elsif ($input =~ /\0/ ) { | ||
| 261 : | sam | 2 | my @input = split(/\0/,$input); |
| 262 : | $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) "; | ||
| 263 : | $input = \@input; | ||
| 264 : | $self-> {rh_ans} -> {student_ans} = $input; | ||
| 265 : | } else { | ||
| 266 : | $input = '' unless defined($input); | ||
| 267 : | $self-> {rh_ans} -> {original_student_ans} = $input; | ||
| 268 : | $self-> {rh_ans} -> {student_ans} = $input; | ||
| 269 : | } | ||
| 270 : | |||
| 271 : | |||
| 272 : | $input; | ||
| 273 : | } | ||
| 274 : | |||
| 275 : | sub evaluate { | ||
| 276 : | my $self = shift; | ||
| 277 : | $self->get_student_answer(shift @_); | ||
| 278 : | my $rh_ans = $self ->{rh_ans}; | ||
| 279 : | gage | 173 | warn "<H3> Answer evaluator information: </H3>\n" if defined($self->{debug}) and $self->{debug}>0; |
| 280 : | sam | 2 | my @prefilters = @{$self -> {pre_filters}}; |
| 281 : | my $count = -1; # the blank filter is counted as filter 0 | ||
| 282 : | foreach my $i (@prefilters) { | ||
| 283 : | last if defined( $self->{rh_ans}->{error_flag} ); | ||
| 284 : | my @array = @$i; | ||
| 285 : | my $filter = shift(@array); # the array now contains the options for the filter | ||
| 286 : | gage | 109 | my %options = @array; |
| 287 : | sam | 2 | if (defined($self->{debug}) and $self->{debug}>0) { |
| 288 : | gage | 109 | |
| 289 : | sam | 2 | $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information |
| 290 : | warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print(); | ||
| 291 : | } | ||
| 292 : | $rh_ans = &$filter($rh_ans,@array); | ||
| 293 : | gage | 173 | warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" |
| 294 : | if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name}); | ||
| 295 : | gage | 109 | $rh_ans->{_filter_name} = undef; |
| 296 : | sam | 2 | } |
| 297 : | my @evaluators = @{$self -> {evaluators} }; | ||
| 298 : | $count = 0; | ||
| 299 : | foreach my $i ( @evaluators ) { | ||
| 300 : | last if defined($self->{rh_ans}->{error_flag}); | ||
| 301 : | my @array = @$i; | ||
| 302 : | my $evaluator = shift(@array); # the array now contains the options for the filter | ||
| 303 : | gage | 109 | my %options = @array; |
| 304 : | sam | 2 | if (defined($self->{debug}) and $self->{debug}>0) { |
| 305 : | $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information | ||
| 306 : | warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print(); | ||
| 307 : | } | ||
| 308 : | $rh_ans = &$evaluator($rh_ans,@array); | ||
| 309 : | gage | 173 | warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name}); |
| 310 : | gage | 109 | $rh_ans->{_filter_name} = undef; |
| 311 : | sam | 2 | } |
| 312 : | my @post_filters = @{$self -> {post_filters} }; | ||
| 313 : | $count = -1; # blank filter catcher is filter 0 | ||
| 314 : | foreach my $i ( @post_filters ) { | ||
| 315 : | last if defined($rh_ans->{done}) and $rh_ans->{done} == 1; # no further action needed | ||
| 316 : | my @array = @$i; | ||
| 317 : | gage | 109 | |
| 318 : | sam | 2 | my $filter = shift(@array); # the array now contains the options for the filter |
| 319 : | gage | 109 | my %options = @array; |
| 320 : | sam | 2 | if (defined($self->{debug}) and $self->{debug}>0) { |
| 321 : | $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information | ||
| 322 : | gage | 109 | warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print(),"\n"; |
| 323 : | sam | 2 | } |
| 324 : | |||
| 325 : | $rh_ans = &$filter($rh_ans,@array); | ||
| 326 : | gage | 173 | warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name}); |
| 327 : | gage | 109 | $rh_ans->{_filter_name} = undef; |
| 328 : | sam | 2 | } |
| 329 : | $rh_ans = $self->dereference_array_ans($rh_ans); | ||
| 330 : | # make sure that the student answer is not an array so that it is reported correctly in answer section. | ||
| 331 : | gage | 109 | warn "<h4>final result: </h4>", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; |
| 332 : | sam | 2 | $self ->{rh_ans} = $rh_ans; |
| 333 : | $rh_ans; | ||
| 334 : | } | ||
| 335 : | gage | 109 | # This next subroutine is for checking the instructor's answer and is not yet in use. |
| 336 : | sam | 2 | sub correct_answer_evaluate { |
| 337 : | my $self = shift; | ||
| 338 : | $self-> {rh_ans} -> {correct_ans} = shift @_; | ||
| 339 : | gage | 109 | my $rh_ans = $self ->{rh_ans}; |
| 340 : | sam | 2 | my @prefilters = @{$self -> {correct_answer_pre_filters}}; |
| 341 : | my $count = -1; # the blank filter is counted as filter 0 | ||
| 342 : | foreach my $i (@prefilters) { | ||
| 343 : | last if defined( $self->{rh_ans}->{error_flag} ); | ||
| 344 : | my @array = @$i; | ||
| 345 : | my $filter = shift(@array); # the array now contains the options for the filter | ||
| 346 : | warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; | ||
| 347 : | $rh_ans = &$filter($rh_ans,@array); | ||
| 348 : | gage | 109 | warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}) |
| 349 : | sam | 2 | } |
| 350 : | my @evaluators = @{$self -> {correct_answer_evaluators} }; | ||
| 351 : | $count = 0; | ||
| 352 : | foreach my $i ( @evaluators ) { | ||
| 353 : | last if defined($self->{rh_ans}->{error_flag}); | ||
| 354 : | my @array = @$i; | ||
| 355 : | my $evaluator = shift(@array); # the array now contains the options for the filter | ||
| 356 : | warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; | ||
| 357 : | $rh_ans = &$evaluator($rh_ans,@array); | ||
| 358 : | } | ||
| 359 : | my @post_filters = @{$self -> {correct_answer_post_filters} }; | ||
| 360 : | $count = -1; # blank filter catcher is filter 0 | ||
| 361 : | foreach my $i ( @post_filters ) { | ||
| 362 : | last if defined($rh_ans->{done}) and $rh_ans->{done} == 1; # no further action needed | ||
| 363 : | my @array = @$i; | ||
| 364 : | my $filter = shift(@array); # the array now contains the options for the filter | ||
| 365 : | warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; | ||
| 366 : | $rh_ans = &$filter($rh_ans,@array); | ||
| 367 : | gage | 109 | warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}) |
| 368 : | sam | 2 | } |
| 369 : | $rh_ans = $self->dereference_array_ans($rh_ans); | ||
| 370 : | # make sure that the student answer is not an array so that it is reported correctly in answer section. | ||
| 371 : | warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; | ||
| 372 : | $self ->{rh_ans} = $rh_ans; | ||
| 373 : | $rh_ans; | ||
| 374 : | } | ||
| 375 : | |||
| 376 : | sub install_pre_filter { | ||
| 377 : | my $self = shift; | ||
| 378 : | if (@_ == 0) { | ||
| 379 : | # do nothing if input is empty | ||
| 380 : | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { | ||
| 381 : | $self->{pre_filters} = []; | ||
| 382 : | } else { | ||
| 383 : | push(@{$self->{pre_filters}},[ @_ ]) if @_; #install pre_filter and it's options | ||
| 384 : | } | ||
| 385 : | @{$self->{pre_filters}}; # return array of all pre_filters | ||
| 386 : | } | ||
| 387 : | |||
| 388 : | sub install_evaluator { | ||
| 389 : | my $self = shift; | ||
| 390 : | if (@_ == 0) { | ||
| 391 : | # do nothing if input is empty | ||
| 392 : | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { | ||
| 393 : | $self->{evaluators} = []; | ||
| 394 : | } else { | ||
| 395 : | push(@{$self->{evaluators}},[ @_ ]) if @_; #install evaluator and it's options | ||
| 396 : | } | ||
| 397 : | @{$self->{'evaluators'}}; # return array of all evaluators | ||
| 398 : | } | ||
| 399 : | |||
| 400 : | sub install_post_filter { | ||
| 401 : | my $self = shift; | ||
| 402 : | if (@_ == 0) { | ||
| 403 : | # do nothing if input is empty | ||
| 404 : | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { | ||
| 405 : | $self->{post_filters} = []; | ||
| 406 : | } else { | ||
| 407 : | push(@{$self->{post_filters}}, [ @_ ]) if @_; #install post_filter and it's options | ||
| 408 : | } | ||
| 409 : | @{$self->{post_filters}}; # return array of all post_filters | ||
| 410 : | } | ||
| 411 : | |||
| 412 : | ## filters for checking the correctAnswer | ||
| 413 : | sub install_correct_answer_pre_filter { | ||
| 414 : | my $self = shift; | ||
| 415 : | if (@_ == 0) { | ||
| 416 : | # do nothing if input is empty | ||
| 417 : | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { | ||
| 418 : | $self->{correct_answer_pre_filters} = []; | ||
| 419 : | } else { | ||
| 420 : | push(@{$self->{correct_answer_pre_filters}},[ @_ ]) if @_; #install correct_answer_pre_filter and it's options | ||
| 421 : | } | ||
| 422 : | @{$self->{correct_answer_pre_filters}}; # return array of all correct_answer_pre_filters | ||
| 423 : | } | ||
| 424 : | |||
| 425 : | sub install_correct_answer_evaluator { | ||
| 426 : | my $self = shift; | ||
| 427 : | if (@_ == 0) { | ||
| 428 : | # do nothing if input is empty | ||
| 429 : | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { | ||
| 430 : | $self->{correct_answer_evaluators} = []; | ||
| 431 : | } else { | ||
| 432 : | push(@{$self->{correct_answer_evaluators}},[ @_ ]) if @_; #install evaluator and it's options | ||
| 433 : | } | ||
| 434 : | @{$self->{correct_answer_evaluators}}; # return array of all evaluators | ||
| 435 : | } | ||
| 436 : | |||
| 437 : | sub install_correct_answer_post_filter { | ||
| 438 : | my $self = shift; | ||
| 439 : | if (@_ == 0) { | ||
| 440 : | # do nothing if input is empty | ||
| 441 : | } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { | ||
| 442 : | $self->{correct_answer_post_filters} = []; | ||
| 443 : | } else { | ||
| 444 : | push(@{$self->{correct_answer_post_filters}}, [ @_ ]) if @_; #install post_filter and it's options | ||
| 445 : | } | ||
| 446 : | @{$self->{correct_answer_post_filters}}; # return array of all post_filters | ||
| 447 : | } | ||
| 448 : | |||
| 449 : | sub ans_hash { #alias for rh_ans | ||
| 450 : | my $self = shift; | ||
| 451 : | $self->rh_ans(@_); | ||
| 452 : | } | ||
| 453 : | sub rh_ans { | ||
| 454 : | my $self = shift; | ||
| 455 : | my %in_hash = @_; | ||
| 456 : | foreach my $key (keys %in_hash) { | ||
| 457 : | $self->{rh_ans}->{$key} = $in_hash{$key}; | ||
| 458 : | } | ||
| 459 : | $self->{rh_ans}; | ||
| 460 : | } | ||
| 461 : | ###################################################### | ||
| 462 : | # | ||
| 463 : | # Built in Filters | ||
| 464 : | # | ||
| 465 : | ###################################################### | ||
| 466 : | |||
| 467 : | |||
| 468 : | sub blank_prefilter { # check for blanks | ||
| 469 : | my $rh_ans = shift; | ||
| 470 : | # undefined answers are BLANKS | ||
| 471 : | ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank'); | ||
| 472 : | return($rh_ans);}; | ||
| 473 : | # answers which are arrays or hashes or some other object reference are NOT blanks | ||
| 474 : | ( ref($rh_ans->{student_ans} ) ) && do { return( $rh_ans ) }; | ||
| 475 : | # if the answer is a true variable consisting only of white space it is a BLANK | ||
| 476 : | ( ($rh_ans->{student_ans}) !~ /\S/ ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank'); | ||
| 477 : | return($rh_ans);}; | ||
| 478 : | # If we get to here, we assume that the answer is not a blank. It is defined, not a reference | ||
| 479 : | # and contains something other than whitespaces. | ||
| 480 : | $rh_ans; | ||
| 481 : | }; | ||
| 482 : | |||
| 483 : | sub blank_postfilter { | ||
| 484 : | my $rh_ans=shift; | ||
| 485 : | return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK'; | ||
| 486 : | $rh_ans->{error_flag} = undef; | ||
| 487 : | $rh_ans->{error_message} = ''; | ||
| 488 : | $rh_ans->{done} =1; # no further checking is needed. | ||
| 489 : | $rh_ans; | ||
| 490 : | }; | ||
| 491 : | |||
| 492 : | 1; | ||
| 493 : | #package AnswerEvaluatorMaker; | ||
| 494 : |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |