Parent Directory
| 
Revision Log
Copied PG modules over from old system. -sam
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 $input = '' unless defined($input); 491 if (ref($input) =~/AnswerHash/) { 492 # in this case nothing needs to be done, since the student's answer is already in an answerhash. 493 # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator. 494 } elsif ($input =~ /\0/ ) { # this case may occur with older versions of CGI?? 495 my @input = split(/\0/,$input); 496 $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) "; 497 $input = \@input; 498 $self-> {rh_ans} -> {student_ans} = $input; 499 } elsif (ref($input) eq 'ARRAY' ) { # sometimes the answer may already be decoded into an array. 500 my @input = @$input; 501 $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) "; 502 $input = \@input; 503 $self-> {rh_ans} -> {student_ans} = $input; 504 } else { 505 506 $self-> {rh_ans} -> {original_student_ans} = $input; 507 $self-> {rh_ans} -> {student_ans} = $input; 508 } 509 510 511 $input; 512 } 513 514 =head4 evaluate 515 516 517 518 519 =cut 520 521 sub evaluate { 522 my $self = shift; 523 $self->get_student_answer(shift @_); 524 $self->{rh_ans}->{error_flag}=undef; #reset the error flags in case 525 $self->{rh_ans}->{done}=undef; #the answer evaluator is called twice 526 my $rh_ans = $self ->{rh_ans}; 527 warn "<H3> Answer evaluator information: </H3>\n" if defined($self->{debug}) and $self->{debug}>0; 528 my @prefilters = @{$self -> {pre_filters}}; 529 my $count = -1; # the blank filter is counted as filter 0 530 foreach my $i (@prefilters) { 531 last if defined( $self->{rh_ans}->{error_flag} ); 532 my @array = @$i; 533 my $filter = shift(@array); # the array now contains the options for the filter 534 my %options = @array; 535 if (defined($self->{debug}) and $self->{debug}>0) { 536 537 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 538 warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print(); 539 } 540 $rh_ans = &$filter($rh_ans,@array); 541 warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" 542 if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name}); 543 $rh_ans->{_filter_name} = undef; 544 } 545 my @evaluators = @{$self -> {evaluators} }; 546 $count = 0; 547 foreach my $i ( @evaluators ) { 548 last if defined($self->{rh_ans}->{error_flag}); 549 my @array = @$i; 550 my $evaluator = shift(@array); # the array now contains the options for the filter 551 my %options = @array; 552 if (defined($self->{debug}) and $self->{debug}>0) { 553 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 554 warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print(); 555 } 556 $rh_ans = &$evaluator($rh_ans,@array); 557 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}); 558 $rh_ans->{_filter_name} = undef; 559 } 560 my @post_filters = @{$self -> {post_filters} }; 561 $count = -1; # blank filter catcher is filter 0 562 foreach my $i ( @post_filters ) { 563 last if defined($rh_ans->{done}) and $rh_ans->{done} == 1; # no further action needed 564 my @array = @$i; 565 566 my $filter = shift(@array); # the array now contains the options for the filter 567 my %options = @array; 568 if (defined($self->{debug}) and $self->{debug}>0) { 569 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 570 warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print(),"\n"; 571 } 572 573 $rh_ans = &$filter($rh_ans,@array); 574 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}); 575 $rh_ans->{_filter_name} = undef; 576 } 577 $rh_ans = $self->dereference_array_ans($rh_ans); 578 # make sure that the student answer is not an array so that it is reported correctly in answer section. 579 warn "<h4>final result: </h4>", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 580 $self ->{rh_ans} = $rh_ans; 581 $rh_ans; 582 } 583 # This next subroutine is for checking the instructor's answer and is not yet in use. 584 sub correct_answer_evaluate { 585 my $self = shift; 586 $self-> {rh_ans} -> {correct_ans} = shift @_; 587 my $rh_ans = $self ->{rh_ans}; 588 my @prefilters = @{$self -> {correct_answer_pre_filters}}; 589 my $count = -1; # the blank filter is counted as filter 0 590 foreach my $i (@prefilters) { 591 last if defined( $self->{rh_ans}->{error_flag} ); 592 my @array = @$i; 593 my $filter = shift(@array); # the array now contains the options for the filter 594 warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 595 $rh_ans = &$filter($rh_ans,@array); 596 warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}) 597 } 598 my @evaluators = @{$self -> {correct_answer_evaluators} }; 599 $count = 0; 600 foreach my $i ( @evaluators ) { 601 last if defined($self->{rh_ans}->{error_flag}); 602 my @array = @$i; 603 my $evaluator = shift(@array); # the array now contains the options for the filter 604 warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 605 $rh_ans = &$evaluator($rh_ans,@array); 606 } 607 my @post_filters = @{$self -> {correct_answer_post_filters} }; 608 $count = -1; # blank filter catcher is filter 0 609 foreach my $i ( @post_filters ) { 610 last if defined($rh_ans->{done}) and $rh_ans->{done} == 1; # no further action needed 611 my @array = @$i; 612 my $filter = shift(@array); # the array now contains the options for the filter 613 warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 614 $rh_ans = &$filter($rh_ans,@array); 615 warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}) 616 } 617 $rh_ans = $self->dereference_array_ans($rh_ans); 618 # make sure that the student answer is not an array so that it is reported correctly in answer section. 619 warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 620 $self ->{rh_ans} = $rh_ans; 621 $rh_ans; 622 } 623 624 625 =head4 install_pre_filter 626 627 =head4 install_evaluator 628 629 630 =head4 install_post_filter 631 632 633 =head4 634 635 636 637 =cut 638 639 640 sub install_pre_filter { 641 my $self = shift; 642 if (@_ == 0) { 643 # do nothing if input is empty 644 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 645 $self->{pre_filters} = []; 646 } else { 647 push(@{$self->{pre_filters}},[ @_ ]) if @_; #install pre_filter and it's options 648 } 649 @{$self->{pre_filters}}; # return array of all pre_filters 650 } 651 652 653 654 655 656 sub install_evaluator { 657 my $self = shift; 658 if (@_ == 0) { 659 # do nothing if input is empty 660 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 661 $self->{evaluators} = []; 662 } else { 663 push(@{$self->{evaluators}},[ @_ ]) if @_; #install evaluator and it's options 664 } 665 @{$self->{'evaluators'}}; # return array of all evaluators 666 } 667 668 669 sub install_post_filter { 670 my $self = shift; 671 if (@_ == 0) { 672 # do nothing if input is empty 673 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 674 $self->{post_filters} = []; 675 } else { 676 push(@{$self->{post_filters}}, [ @_ ]) if @_; #install post_filter and it's options 677 } 678 @{$self->{post_filters}}; # return array of all post_filters 679 } 680 681 ## filters for checking the correctAnswer 682 sub install_correct_answer_pre_filter { 683 my $self = shift; 684 if (@_ == 0) { 685 # do nothing if input is empty 686 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 687 $self->{correct_answer_pre_filters} = []; 688 } else { 689 push(@{$self->{correct_answer_pre_filters}},[ @_ ]) if @_; #install correct_answer_pre_filter and it's options 690 } 691 @{$self->{correct_answer_pre_filters}}; # return array of all correct_answer_pre_filters 692 } 693 694 sub install_correct_answer_evaluator { 695 my $self = shift; 696 if (@_ == 0) { 697 # do nothing if input is empty 698 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 699 $self->{correct_answer_evaluators} = []; 700 } else { 701 push(@{$self->{correct_answer_evaluators}},[ @_ ]) if @_; #install evaluator and it's options 702 } 703 @{$self->{correct_answer_evaluators}}; # return array of all evaluators 704 } 705 706 sub install_correct_answer_post_filter { 707 my $self = shift; 708 if (@_ == 0) { 709 # do nothing if input is empty 710 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 711 $self->{correct_answer_post_filters} = []; 712 } else { 713 push(@{$self->{correct_answer_post_filters}}, [ @_ ]) if @_; #install post_filter and it's options 714 } 715 @{$self->{correct_answer_post_filters}}; # return array of all post_filters 716 } 717 718 sub ans_hash { #alias for rh_ans 719 my $self = shift; 720 $self->rh_ans(@_); 721 } 722 sub rh_ans { 723 my $self = shift; 724 my %in_hash = @_; 725 foreach my $key (keys %in_hash) { 726 $self->{rh_ans}->{$key} = $in_hash{$key}; 727 } 728 $self->{rh_ans}; 729 } 730 731 =head1 Description: Filters 732 733 A filter is a subroutine which takes one AnswerHash as an input, followed by 734 a hash of options. 735 736 Useage: filter($ans_hash, option1 =>value1, option2=> value2 ); 737 738 739 The filter performs some operations on the input AnswerHash and returns an 740 AnswerHash as output. 741 742 Many AnswerEvaluator objects are merely a sequence of filters placed into 743 three queues: 744 745 pre_filters: these normalize student input, prepare text and so forth 746 evaluators: these decide whether or not an answer is correct 747 post_filters: typically these clean up error messages or process errors 748 and generate error messages. 749 750 If a filter detects an error it can throw an error message using the C<$rh_ans->throw_error()> 751 method. This skips the AnswerHash by all remaining pre_filter C<$rh_ans->catch_error>, 752 decides how ( 753 or whether) it is supposed to handle the error and then passes the result on 754 to the next post_filter. 755 756 Setting the flag C<$rh_ans->{done} = 1> will skip 757 the AnswerHash past the remaining post_filters. 758 759 760 =head3 Built in filters 761 762 =head4 blank_prefilter 763 764 765 =head4 blank_postfilter 766 767 =cut 768 769 ###################################################### 770 # 771 # Built in Filters 772 # 773 ###################################################### 774 775 776 sub blank_prefilter { # check for blanks 777 my $rh_ans = shift; 778 # undefined answers are BLANKS 779 ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank'); 780 return($rh_ans);}; 781 # answers which are arrays or hashes or some other object reference are NOT blanks 782 ( ref($rh_ans->{student_ans} ) ) && do { return( $rh_ans ) }; 783 # if the answer is a true variable consisting only of white space it is a BLANK 784 ( ($rh_ans->{student_ans}) !~ /\S/ ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank'); 785 return($rh_ans);}; 786 # If we get to here, we assume that the answer is not a blank. It is defined, not a reference 787 # and contains something other than whitespaces. 788 $rh_ans; 789 }; 790 791 sub blank_postfilter { 792 my $rh_ans=shift; 793 return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK'; 794 $rh_ans->{error_flag} = undef; 795 $rh_ans->{error_message} = ''; 796 $rh_ans->{done} =1; # no further checking is needed. 797 $rh_ans; 798 }; 799 800 1; 801 #package AnswerEvaluatorMaker; 802
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |