Parent Directory
| 
Revision Log
Added line which prints out the raw student answer when the debug flag is on. --Mike
1 ########################################################################## 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 # Copyright @ 1995-2002 WeBWorK Team 8 # All Rights Reserved 9 #################################################################### 10 #$Id$ 11 12 =head1 NAME 13 14 AnswerHash.pm -- located in the courseScripts directory 15 16 This file contains the packages/classes: 17 AnswerHash and AnswerEvaluator 18 19 =head1 SYNPOSIS 20 21 AnswerHash -- this class stores information related to the student's 22 answer. It is little more than a standard perl hash with 23 a special name, butit does have some access and 24 manipulation methods. More of these may be added as it 25 becomes necessary. 26 27 Useage: $rh_ans = new AnswerHash; 28 29 AnswerEvaluator -- this class organizes the construction of 30 answer evaluator subroutines which check the 31 student's answer. By plugging filters into the 32 answer evaluator class you can customize the way the 33 student's answer is normalized and checked. Our hope 34 is that with properly designed filters, it will be 35 possible to reuse the filters in different 36 combinations to obtain different answer evaluators, 37 thus greatly reducing the programming and maintenance 38 required for constructing answer evaluators. 39 40 Useage: $ans_eval = new AnswerEvaluator; 41 42 =cut 43 44 =head1 DESCRIPTION : AnswerHash 45 46 The answer hash class is guaranteed to contain the following instance variables: 47 48 score => $correctQ, 49 correct_ans => $originalCorrEqn, 50 student_ans => $modified_student_ans 51 original_student_ans => $original_student_answer, 52 ans_message => $PGanswerMessage, 53 type => 'typeString', 54 preview_text_string => $preview_text_string, 55 preview_latex_string => $preview_latex_string 56 57 58 $ans_hash->{score} -- a number between 0 and 1 indicating 59 whether the answer is correct. Fractions 60 allow the implementation of partial 61 credit for incorrect answers. 62 63 $ans_hash->{correct_ans} -- The correct answer, as supplied by the 64 instructor and then formatted. This can 65 be viewed by the student after the answer date. 66 67 $ans_hash->{student_ans} -- This is the student answer, after reformatting; 68 for example the answer might be forced 69 to capital letters for comparison with 70 the instructors answer. For a numerical 71 answer, it gives the evaluated answer. 72 This is displayed in the section reporting 73 the results of checking the student answers. 74 75 $ans_hash->{original_student_ans} -- This is the original student answer. 76 This is displayed on the preview page and may be used for 77 sticky answers. 78 79 $ans_hash->{ans_message} -- Any error message, or hint provided by 80 the answer evaluator. 81 This is also displayed in the section reporting 82 the results of checking the student answers. 83 84 $ans_hash->{type} -- A string indicating the type of answer evaluator. 85 This helps in preprocessing the student answer for errors. 86 Some examples: 87 'number_with_units' 88 'function' 89 'frac_number' 90 'arith_number' 91 92 93 $ans_hash->{preview_text_string} -- 94 This typically shows how the student answer was parsed. It is 95 displayed on the preview page. For a student answer of 2sin(3x) 96 this would be 2*sin(3*x). For string answers it is typically the 97 same as $ans_hash{student_ans}. 98 99 100 $ans_hash->{preview_latex_string} -- 101 THIS IS OPTIONAL. This is latex version of the student answer 102 which is used to show a typeset view on the answer on the preview 103 page. For a student answer of 2/3, this would be \frac{2}{3}. 104 105 'ans_message' => '', # null string 106 107 'preview_text_string' => undef, 108 'preview_latex_string' => undef, 109 'error_flag' => undef, 110 'error_message' => '', 111 112 113 =head3 AnswerHash Methods: 114 115 =cut 116 117 BEGIN { 118 be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix. 119 120 } 121 122 package AnswerHash; 123 # initialization fields 124 my %fields = ( 'score' => undef, 125 'correct_ans' => undef, 126 'student_ans' => undef, 127 'ans_message' => undef, 128 'type' => undef, 129 'preview_text_string' => undef, 130 'preview_latex_string' => undef, 131 'original_student_ans' => undef 132 ); 133 134 ## Initializing constructor 135 =head4 new 136 137 Useage $rh_anshash = new AnswerHash; 138 139 returns an object of type AnswerHash. 140 141 =cut 142 143 sub new { 144 my $class = shift @_; 145 146 my $self = { 'score' => 0, 147 'correct_ans' => 'No correct answer specified', 148 'student_ans' => undef, 149 'ans_message' => '', 150 'type' => 'Undefined answer evaluator type', 151 'preview_text_string' => undef, 152 'preview_latex_string' => undef, 153 'original_student_ans' => undef, 154 'error_flag' => undef, 155 'error_message' => '', 156 157 }; # return a reference to a hash. 158 159 bless $self, $class; 160 $self -> setKeys(@_); 161 162 return $self; 163 } 164 165 ## IN: a hash 166 ## Checks to make sure that the keys are valid, 167 ## then sets their value 168 169 =head4 setKeys 170 171 $rh_ans->setKeys(score=>1, student_answer => "yes"); 172 Sets standard elements in the AnswerHash (the ones defined 173 above). Will give error if one attempts to set non-standard keys. 174 175 To set a non-standard element in a hash use 176 177 $rh_ans->{non-standard-key} = newValue; 178 179 There are no safety checks when using this method. 180 181 =cut 182 183 184 sub setKeys { 185 my $self = shift; 186 my %inits = @_; 187 foreach my $item (keys %inits) { 188 if ( exists $fields{$item} ) { 189 $self -> {$item} = $inits{$item}; 190 } 191 else { 192 warn "AnswerHash cannot automatically initialize an item named $item"; 193 } 194 } 195 } 196 197 # access methods 198 199 =head4 data 200 201 Useage: $rh_ans->data('foo'); set $rh_ans->{student_ans} = 'foo'; 202 $student_input = $rh_ans->data(); retrieve value of $rh_ans->{student_ans} 203 204 synonym for input 205 206 =head4 input 207 208 Useage: $rh_ans->input('foo') sets $rh_ans->{student_ans} = 'foo'; 209 $student_input = $rh_ans->input(); 210 211 synonym for data 212 213 =cut 214 215 sub data { #$rh_ans->data('foo') is a synonym for $rh_ans->{student_ans}='foo' 216 my $self = shift; 217 $self->input(@_); 218 } 219 220 sub input { #$rh_ans->input('foo') is a synonym for $rh_ans->{student_ans}='foo' 221 my $self = shift; 222 my $input = shift; 223 $self->{student_ans} = $input if defined($input); 224 $self->{student_ans} 225 } 226 227 =head4 input 228 229 Useage: $rh_ans->score(1) 230 $score = $rh_ans->score(); 231 232 Retrieve or set $rh_ans->{score}, the student's score on the problem. 233 234 =cut 235 236 sub score { 237 my $self = shift; 238 my $score = shift; 239 $self->{score} = $score if defined($score); 240 $self->{score} 241 } 242 243 # error methods 244 245 =head4 throw_error 246 247 Useage: $rh_ans->throw_error("FLAG", "message"); 248 249 FLAG is a distinctive word that describes the type of error. 250 Examples are EVAL for an evaluation error or "SYNTAX" for a syntax error. 251 The entry $rh_ans->{error_flag} is set to "FLAG". 252 253 The catch_error and clear_error methods use 254 this entry. 255 256 message is a descriptive message for the end user, defining what error occured. 257 258 =head4 catch_error 259 260 Useage: $rh_ans->catch_error("FLAG2"); 261 262 Returns true (1) if $rh_ans->{error_flag} equals "FLAG2", otherwise it returns 263 false (empty string). 264 265 266 267 =head4 clear_error 268 269 Useage: $rh_ans->clear_error("FLAG2"); 270 271 If $rh_ans->{error_flag} equals "FLAG2" then the {error_flag} entry is set to 272 the empty string as is the entry {error_message} 273 274 =head4 error_flag 275 276 =head4 error_message 277 278 Useage: $flag = $rh_ans -> error_flag(); 279 280 $message = $rh_ans -> error_message(); 281 282 Retrieve or set the {error_flag} and {error_message} entries. 283 284 Use catch_error and throw_error where possible. 285 286 =cut 287 288 289 290 sub throw_error { 291 my $self = shift; 292 my $flag = shift; 293 my $message = shift; 294 $self->{error_message} .= " $message " if defined($message); 295 $self->{error_flag} = $flag if defined($flag); 296 $self->{error_flag} 297 } 298 sub catch_error { 299 my $self = shift; 300 my $flag = shift; 301 return('') unless defined($self->{error_flag}); 302 return $self->{error_flag} unless $flag; # empty input catches all errors. 303 return $self->{error_flag} if $self->{error_flag} eq $flag; 304 return ''; # nothing to catch 305 } 306 sub clear_error { 307 my $self = shift; 308 my $flag = shift; 309 if (defined($flag) and $flag =~/\S/ and defined($self->{error_flag}) and $flag eq $self->{error_flag}) { 310 $self->{error_flag} = undef; 311 $self->{error_message} = undef; 312 } 313 $self; 314 } 315 sub error_flag { 316 my $self = shift; 317 my $flag = shift; 318 $self->{error_flag} = $flag if defined($flag); 319 $self->{error_flag} 320 } 321 sub error_message { 322 my $self = shift; 323 my $message = shift; 324 $self->{error_message} = $message if defined($message); 325 $self->{error_message} 326 } 327 328 # error print out method 329 330 =head4 pretty_print 331 332 333 Useage: $rh_ans -> pretty_print(); 334 335 336 Returns a string containing a representation of the AnswerHash as an HTML table. 337 338 =cut 339 340 341 sub pretty_print { 342 my $r_input = shift; 343 my $out = ''; 344 if ( not ref($r_input) ) { 345 $out = $r_input; # not a reference 346 } elsif (ref($r_input) =~/hash/i) { 347 local($^W) = 0; 348 $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">"; 349 foreach my $key (sort keys %$r_input ) { 350 $out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print($r_input->{$key}) . "</td></tr>"; 351 } 352 $out .="</table>"; 353 } elsif (ref($r_input) eq 'ARRAY' ) { 354 my @array = @$r_input; 355 $out .= "( " ; 356 while (@array) { 357 $out .= pretty_print(shift @array) . " , "; 358 } 359 $out .= " )"; 360 } elsif (ref($r_input) eq 'CODE') { 361 $out = "$r_input"; 362 } else { 363 $out = $r_input; 364 } 365 $out; 366 } 367 368 # action methods 369 370 =head4 OR 371 372 Useage: $rh_ans->OR($rh_ans2); 373 374 Returns a new AnswerHash whose score is the maximum of the scores in $rh_ans and $rh_ans2. 375 The correct answers for the two hashes are combined with "OR". 376 The types are concatenated with "OR" as well. 377 Currently nothing is done with the error flags and messages. 378 379 380 381 =head4 AND 382 383 384 Useage: $rh_ans->AND($rh_ans2); 385 386 Returns a new AnswerHash whose score is the minimum of the scores in $rh_ans and $rh_ans2. 387 The correct answers for the two hashes are combined with "AND". 388 The types are concatenated with "AND" as well. 389 Currently nothing is done with the error flags and messages. 390 391 392 393 394 =cut 395 396 397 398 sub OR { 399 my $self = shift; 400 401 my $rh_ans2 = shift; 402 my %options = @_; 403 return($self) unless defined($rh_ans2) and ref($rh_ans2) eq 'AnswerHash'; 404 405 my $out_hash = new AnswerHash; 406 # score is the maximum of the two scores 407 $out_hash->{score} = ( $self->{score} < $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score}; 408 $out_hash->{correct_ans} = join(" OR ", $self->{correct_ans}, $rh_ans2->{correct_ans} ); 409 $out_hash->{student_ans} = $self->{student_ans}; 410 $out_hash->{type} = join(" OR ", $self->{type}, $rh_ans2->{type} ); 411 $out_hash->{preview_text_string} = join(" ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} ); 412 $out_hash->{original_student_ans} = $self->{original_student_ans}; 413 $out_hash; 414 } 415 416 sub AND { 417 my $self = shift; 418 my $rh_ans2 = shift; 419 my %options = @_; 420 my $out_hash = new AnswerHash; 421 # score is the minimum of the two scores 422 $out_hash->{score} = ( $self->{score} > $rh_ans2->{score} ) ? $rh_ans2->{score} :$self->{score}; 423 $out_hash->{correct_ans} = join(" AND ", $self->{correct_ans}, $rh_ans2->{correct_ans} ); 424 $out_hash->{student_ans} = $self->{student_ans}; 425 $out_hash->{type} = join(" AND ", $self->{type}, $rh_ans2->{type} ); 426 $out_hash->{preview_text_string} = join(" ", $self->{preview_text_string}, $rh_ans2->{preview_text_string} ); 427 $out_hash->{original_student_ans} = $self->{original_student_ans}; 428 $out_hash; 429 } 430 431 432 =head1 Description: AnswerEvaluator 433 434 435 436 437 =cut 438 439 440 441 package AnswerEvaluator; 442 443 444 =head3 AnswerEvaluator Methods 445 446 447 448 449 450 451 452 =cut 453 454 455 =head4 new 456 457 458 =cut 459 460 461 sub new { 462 my $class = shift @_; 463 464 my $self = { pre_filters => [ [\&blank_prefilter] ], 465 evaluators => [], 466 post_filters => [ [\&blank_postfilter] ], 467 debug => 0, 468 rh_ans => new AnswerHash, 469 470 }; 471 472 bless $self, $class; 473 $self->rh_ans(@_); #initialize answer hash 474 return $self; 475 } 476 477 # dereference_array_ans pretty prints an answer which is stored as an anonymous array. 478 sub dereference_array_ans { 479 my $self = shift; 480 my $rh_ans = shift; 481 if (defined($rh_ans->{student_ans}) and ref($rh_ans->{student_ans}) eq 'ARRAY' ) { 482 $rh_ans->{student_ans} = "( ". join(" , ",@{$rh_ans->{student_ans}} ) . " ) "; 483 } 484 $rh_ans; 485 } 486 487 sub get_student_answer { 488 my $self = shift; 489 my $input = shift; 490 my %answer_options = @_; 491 warn "Raw student answer is |$input|" if $self->{debug}; 492 $input = '' unless defined($input); 493 if (ref($input) =~/AnswerHash/) { 494 # in this case nothing needs to be done, since the student's answer is already in an answerhash. 495 # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator. 496 } elsif ($input =~ /\0/ ) { # this case may occur with older versions of CGI?? 497 my @input = split(/\0/,$input); 498 $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) "; 499 $input = \@input; 500 $self-> {rh_ans} -> {student_ans} = $input; 501 } elsif (ref($input) eq 'ARRAY' ) { # sometimes the answer may already be decoded into an array. 502 my @input = @$input; 503 $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) "; 504 $input = \@input; 505 $self-> {rh_ans} -> {student_ans} = $input; 506 } else { 507 508 $self-> {rh_ans} -> {original_student_ans} = $input; 509 $self-> {rh_ans} -> {student_ans} = $input; 510 } 511 $self->{rh_ans}->{ans_label} = $answer_options{ans_label} if defined($answer_options{ans_label}); 512 513 $input; 514 } 515 516 =head4 evaluate 517 518 519 520 521 =cut 522 523 sub evaluate { 524 my $self = shift; 525 $self->get_student_answer(@_); 526 $self->{rh_ans}->{error_flag}=undef; #reset the error flags in case 527 $self->{rh_ans}->{done}=undef; #the answer evaluator is called twice 528 my $rh_ans = $self ->{rh_ans}; 529 warn "<H3> Answer evaluator information: </H3>\n" if defined($self->{debug}) and $self->{debug}>0; 530 my @prefilters = @{$self -> {pre_filters}}; 531 my $count = -1; # the blank filter is counted as filter 0 532 foreach my $i (@prefilters) { 533 last if defined( $self->{rh_ans}->{error_flag} ); 534 my @array = @$i; 535 my $filter = shift(@array); # the array now contains the options for the filter 536 my %options = @array; 537 if (defined($self->{debug}) and $self->{debug}>0) { 538 539 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 540 warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print(); 541 } 542 $rh_ans = &$filter($rh_ans,@array); 543 warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" 544 if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name}); 545 $rh_ans->{_filter_name} = undef; 546 } 547 my @evaluators = @{$self -> {evaluators} }; 548 $count = 0; 549 foreach my $i ( @evaluators ) { 550 last if defined($self->{rh_ans}->{error_flag}); 551 my @array = @$i; 552 my $evaluator = shift(@array); # the array now contains the options for the filter 553 my %options = @array; 554 if (defined($self->{debug}) and $self->{debug}>0) { 555 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 556 warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print(); 557 } 558 $rh_ans = &$evaluator($rh_ans,@array); 559 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}); 560 $rh_ans->{_filter_name} = undef; 561 } 562 my @post_filters = @{$self -> {post_filters} }; 563 $count = -1; # blank filter catcher is filter 0 564 foreach my $i ( @post_filters ) { 565 last if defined($rh_ans->{done}) and $rh_ans->{done} == 1; # no further action needed 566 my @array = @$i; 567 568 my $filter = shift(@array); # the array now contains the options for the filter 569 my %options = @array; 570 if (defined($self->{debug}) and $self->{debug}>0) { 571 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 572 warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print(),"\n"; 573 } 574 575 $rh_ans = &$filter($rh_ans,@array); 576 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}); 577 $rh_ans->{_filter_name} = undef; 578 } 579 $rh_ans = $self->dereference_array_ans($rh_ans); 580 # make sure that the student answer is not an array so that it is reported correctly in answer section. 581 warn "<h4>final result: </h4>", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 582 $self ->{rh_ans} = $rh_ans; 583 $rh_ans; 584 } 585 # This next subroutine is for checking the instructor's answer and is not yet in use. 586 sub correct_answer_evaluate { 587 my $self = shift; 588 $self-> {rh_ans} -> {correct_ans} = shift @_; 589 my $rh_ans = $self ->{rh_ans}; 590 my @prefilters = @{$self -> {correct_answer_pre_filters}}; 591 my $count = -1; # the blank filter is counted as filter 0 592 foreach my $i (@prefilters) { 593 last if defined( $self->{rh_ans}->{error_flag} ); 594 my @array = @$i; 595 my $filter = shift(@array); # the array now contains the options for the filter 596 warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 597 $rh_ans = &$filter($rh_ans,@array); 598 warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}) 599 } 600 my @evaluators = @{$self -> {correct_answer_evaluators} }; 601 $count = 0; 602 foreach my $i ( @evaluators ) { 603 last if defined($self->{rh_ans}->{error_flag}); 604 my @array = @$i; 605 my $evaluator = shift(@array); # the array now contains the options for the filter 606 warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 607 $rh_ans = &$evaluator($rh_ans,@array); 608 } 609 my @post_filters = @{$self -> {correct_answer_post_filters} }; 610 $count = -1; # blank filter catcher is filter 0 611 foreach my $i ( @post_filters ) { 612 last if defined($rh_ans->{done}) and $rh_ans->{done} == 1; # no further action needed 613 my @array = @$i; 614 my $filter = shift(@array); # the array now contains the options for the filter 615 warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 616 $rh_ans = &$filter($rh_ans,@array); 617 warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}) 618 } 619 $rh_ans = $self->dereference_array_ans($rh_ans); 620 # make sure that the student answer is not an array so that it is reported correctly in answer section. 621 warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 622 $self ->{rh_ans} = $rh_ans; 623 $rh_ans; 624 } 625 626 627 =head4 install_pre_filter 628 629 =head4 install_evaluator 630 631 632 =head4 install_post_filter 633 634 635 =head4 636 637 638 639 =cut 640 641 642 sub install_pre_filter { 643 my $self = shift; 644 if (@_ == 0) { 645 # do nothing if input is empty 646 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 647 $self->{pre_filters} = []; 648 } else { 649 push(@{$self->{pre_filters}},[ @_ ]) if @_; #install pre_filter and it's options 650 } 651 @{$self->{pre_filters}}; # return array of all pre_filters 652 } 653 654 655 656 657 658 sub install_evaluator { 659 my $self = shift; 660 if (@_ == 0) { 661 # do nothing if input is empty 662 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 663 $self->{evaluators} = []; 664 } else { 665 push(@{$self->{evaluators}},[ @_ ]) if @_; #install evaluator and it's options 666 } 667 @{$self->{'evaluators'}}; # return array of all evaluators 668 } 669 670 671 sub install_post_filter { 672 my $self = shift; 673 if (@_ == 0) { 674 # do nothing if input is empty 675 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 676 $self->{post_filters} = []; 677 } else { 678 push(@{$self->{post_filters}}, [ @_ ]) if @_; #install post_filter and it's options 679 } 680 @{$self->{post_filters}}; # return array of all post_filters 681 } 682 683 ## filters for checking the correctAnswer 684 sub install_correct_answer_pre_filter { 685 my $self = shift; 686 if (@_ == 0) { 687 # do nothing if input is empty 688 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 689 $self->{correct_answer_pre_filters} = []; 690 } else { 691 push(@{$self->{correct_answer_pre_filters}},[ @_ ]) if @_; #install correct_answer_pre_filter and it's options 692 } 693 @{$self->{correct_answer_pre_filters}}; # return array of all correct_answer_pre_filters 694 } 695 696 sub install_correct_answer_evaluator { 697 my $self = shift; 698 if (@_ == 0) { 699 # do nothing if input is empty 700 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 701 $self->{correct_answer_evaluators} = []; 702 } else { 703 push(@{$self->{correct_answer_evaluators}},[ @_ ]) if @_; #install evaluator and it's options 704 } 705 @{$self->{correct_answer_evaluators}}; # return array of all evaluators 706 } 707 708 sub install_correct_answer_post_filter { 709 my $self = shift; 710 if (@_ == 0) { 711 # do nothing if input is empty 712 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 713 $self->{correct_answer_post_filters} = []; 714 } else { 715 push(@{$self->{correct_answer_post_filters}}, [ @_ ]) if @_; #install post_filter and it's options 716 } 717 @{$self->{correct_answer_post_filters}}; # return array of all post_filters 718 } 719 720 sub ans_hash { #alias for rh_ans 721 my $self = shift; 722 $self->rh_ans(@_); 723 } 724 sub rh_ans { 725 my $self = shift; 726 my %in_hash = @_; 727 foreach my $key (keys %in_hash) { 728 $self->{rh_ans}->{$key} = $in_hash{$key}; 729 } 730 $self->{rh_ans}; 731 } 732 733 =head1 Description: Filters 734 735 A filter is a subroutine which takes one AnswerHash as an input, followed by 736 a hash of options. 737 738 Useage: filter($ans_hash, option1 =>value1, option2=> value2 ); 739 740 741 The filter performs some operations on the input AnswerHash and returns an 742 AnswerHash as output. 743 744 Many AnswerEvaluator objects are merely a sequence of filters placed into 745 three queues: 746 747 pre_filters: these normalize student input, prepare text and so forth 748 evaluators: these decide whether or not an answer is correct 749 post_filters: typically these clean up error messages or process errors 750 and generate error messages. 751 752 If a filter detects an error it can throw an error message using the C<$rh_ans->throw_error()> 753 method. This skips the AnswerHash by all remaining pre_filter C<$rh_ans->catch_error>, 754 decides how ( 755 or whether) it is supposed to handle the error and then passes the result on 756 to the next post_filter. 757 758 Setting the flag C<$rh_ans->{done} = 1> will skip 759 the AnswerHash past the remaining post_filters. 760 761 762 =head3 Built in filters 763 764 =head4 blank_prefilter 765 766 767 =head4 blank_postfilter 768 769 =cut 770 771 ###################################################### 772 # 773 # Built in Filters 774 # 775 ###################################################### 776 777 778 sub blank_prefilter { # check for blanks 779 my $rh_ans = shift; 780 # undefined answers are BLANKS 781 ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank'); 782 return($rh_ans);}; 783 # answers which are arrays or hashes or some other object reference are NOT blanks 784 ( ref($rh_ans->{student_ans} ) ) && do { return( $rh_ans ) }; 785 # if the answer is a true variable consisting only of white space it is a BLANK 786 ( ($rh_ans->{student_ans}) !~ /\S/ ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank'); 787 return($rh_ans);}; 788 # If we get to here, we assume that the answer is not a blank. It is defined, not a reference 789 # and contains something other than whitespaces. 790 $rh_ans; 791 }; 792 793 sub blank_postfilter { 794 my $rh_ans=shift; 795 return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK'; 796 $rh_ans->{error_flag} = undef; 797 $rh_ans->{error_message} = ''; 798 $rh_ans->{done} =1; # no further checking is needed. 799 $rh_ans; 800 }; 801 802 1; 803 #package AnswerEvaluatorMaker; 804
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |