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