Parent Directory
| 
Revision Log
Made modifications in the evaluate method of AnswerEvaluator which allow the answer evaluators to be called twice. (Specifically the error flags are initialized at the beginning of each call to evaluate).
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 =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 debug => 0, 235 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 254 sub get_student_answer { 255 my $self = shift; 256 my $input = shift; 257 $input = '' unless defined($input); 258 if (ref($input) =~/AnswerHash/) { 259 # in this case nothing needs to be done, since the student's answer is already in an answerhash. 260 # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator. 261 } elsif ($input =~ /\0/ ) { # this case may occur with older versions of CGI?? 262 my @input = split(/\0/,$input); 263 $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) "; 264 $input = \@input; 265 $self-> {rh_ans} -> {student_ans} = $input; 266 } elsif (ref($input) eq 'ARRAY' ) { # sometimes the answer may already be decoded into an array. 267 my @input = @$input; 268 $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) "; 269 $input = \@input; 270 $self-> {rh_ans} -> {student_ans} = $input; 271 } else { 272 273 $self-> {rh_ans} -> {original_student_ans} = $input; 274 $self-> {rh_ans} -> {student_ans} = $input; 275 } 276 277 278 $input; 279 } 280 281 sub evaluate { 282 my $self = shift; 283 $self->get_student_answer(shift @_); 284 $self->{rh_ans}->{error_flag}=undef; #reset the error flags in case 285 $self->{rh_ans}->{done}=undef; #the answer evaluator is called twice 286 my $rh_ans = $self ->{rh_ans}; 287 warn "<H3> Answer evaluator information: </H3>\n" if defined($self->{debug}) and $self->{debug}>0; 288 my @prefilters = @{$self -> {pre_filters}}; 289 my $count = -1; # the blank filter is counted as filter 0 290 foreach my $i (@prefilters) { 291 last if defined( $self->{rh_ans}->{error_flag} ); 292 my @array = @$i; 293 my $filter = shift(@array); # the array now contains the options for the filter 294 my %options = @array; 295 if (defined($self->{debug}) and $self->{debug}>0) { 296 297 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 298 warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print(); 299 } 300 $rh_ans = &$filter($rh_ans,@array); 301 warn "<h4>Filter Name:", $rh_ans->{_filter_name},"</h4><BR>\n" 302 if defined($self->{debug}) and $self->{debug}>0 and defined($rh_ans->{_filter_name}); 303 $rh_ans->{_filter_name} = undef; 304 } 305 my @evaluators = @{$self -> {evaluators} }; 306 $count = 0; 307 foreach my $i ( @evaluators ) { 308 last if defined($self->{rh_ans}->{error_flag}); 309 my @array = @$i; 310 my $evaluator = shift(@array); # the array now contains the options for the filter 311 my %options = @array; 312 if (defined($self->{debug}) and $self->{debug}>0) { 313 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 314 warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print(); 315 } 316 $rh_ans = &$evaluator($rh_ans,@array); 317 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}); 318 $rh_ans->{_filter_name} = undef; 319 } 320 my @post_filters = @{$self -> {post_filters} }; 321 $count = -1; # blank filter catcher is filter 0 322 foreach my $i ( @post_filters ) { 323 last if defined($rh_ans->{done}) and $rh_ans->{done} == 1; # no further action needed 324 my @array = @$i; 325 326 my $filter = shift(@array); # the array now contains the options for the filter 327 my %options = @array; 328 if (defined($self->{debug}) and $self->{debug}>0) { 329 $self->{rh_ans}->{rh_options} = \%options; #include the options in the debug information 330 warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print(),"\n"; 331 } 332 333 $rh_ans = &$filter($rh_ans,@array); 334 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}); 335 $rh_ans->{_filter_name} = undef; 336 } 337 $rh_ans = $self->dereference_array_ans($rh_ans); 338 # make sure that the student answer is not an array so that it is reported correctly in answer section. 339 warn "<h4>final result: </h4>", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 340 $self ->{rh_ans} = $rh_ans; 341 $rh_ans; 342 } 343 # This next subroutine is for checking the instructor's answer and is not yet in use. 344 sub correct_answer_evaluate { 345 my $self = shift; 346 $self-> {rh_ans} -> {correct_ans} = shift @_; 347 my $rh_ans = $self ->{rh_ans}; 348 my @prefilters = @{$self -> {correct_answer_pre_filters}}; 349 my $count = -1; # the blank filter is counted as filter 0 350 foreach my $i (@prefilters) { 351 last if defined( $self->{rh_ans}->{error_flag} ); 352 my @array = @$i; 353 my $filter = shift(@array); # the array now contains the options for the filter 354 warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 355 $rh_ans = &$filter($rh_ans,@array); 356 warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}) 357 } 358 my @evaluators = @{$self -> {correct_answer_evaluators} }; 359 $count = 0; 360 foreach my $i ( @evaluators ) { 361 last if defined($self->{rh_ans}->{error_flag}); 362 my @array = @$i; 363 my $evaluator = shift(@array); # the array now contains the options for the filter 364 warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 365 $rh_ans = &$evaluator($rh_ans,@array); 366 } 367 my @post_filters = @{$self -> {correct_answer_post_filters} }; 368 $count = -1; # blank filter catcher is filter 0 369 foreach my $i ( @post_filters ) { 370 last if defined($rh_ans->{done}) and $rh_ans->{done} == 1; # no further action needed 371 my @array = @$i; 372 my $filter = shift(@array); # the array now contains the options for the filter 373 warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 374 $rh_ans = &$filter($rh_ans,@array); 375 warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name}) 376 } 377 $rh_ans = $self->dereference_array_ans($rh_ans); 378 # make sure that the student answer is not an array so that it is reported correctly in answer section. 379 warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0; 380 $self ->{rh_ans} = $rh_ans; 381 $rh_ans; 382 } 383 384 sub install_pre_filter { 385 my $self = shift; 386 if (@_ == 0) { 387 # do nothing if input is empty 388 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 389 $self->{pre_filters} = []; 390 } else { 391 push(@{$self->{pre_filters}},[ @_ ]) if @_; #install pre_filter and it's options 392 } 393 @{$self->{pre_filters}}; # return array of all pre_filters 394 } 395 396 sub install_evaluator { 397 my $self = shift; 398 if (@_ == 0) { 399 # do nothing if input is empty 400 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 401 $self->{evaluators} = []; 402 } else { 403 push(@{$self->{evaluators}},[ @_ ]) if @_; #install evaluator and it's options 404 } 405 @{$self->{'evaluators'}}; # return array of all evaluators 406 } 407 408 sub install_post_filter { 409 my $self = shift; 410 if (@_ == 0) { 411 # do nothing if input is empty 412 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 413 $self->{post_filters} = []; 414 } else { 415 push(@{$self->{post_filters}}, [ @_ ]) if @_; #install post_filter and it's options 416 } 417 @{$self->{post_filters}}; # return array of all post_filters 418 } 419 420 ## filters for checking the correctAnswer 421 sub install_correct_answer_pre_filter { 422 my $self = shift; 423 if (@_ == 0) { 424 # do nothing if input is empty 425 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 426 $self->{correct_answer_pre_filters} = []; 427 } else { 428 push(@{$self->{correct_answer_pre_filters}},[ @_ ]) if @_; #install correct_answer_pre_filter and it's options 429 } 430 @{$self->{correct_answer_pre_filters}}; # return array of all correct_answer_pre_filters 431 } 432 433 sub install_correct_answer_evaluator { 434 my $self = shift; 435 if (@_ == 0) { 436 # do nothing if input is empty 437 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 438 $self->{correct_answer_evaluators} = []; 439 } else { 440 push(@{$self->{correct_answer_evaluators}},[ @_ ]) if @_; #install evaluator and it's options 441 } 442 @{$self->{correct_answer_evaluators}}; # return array of all evaluators 443 } 444 445 sub install_correct_answer_post_filter { 446 my $self = shift; 447 if (@_ == 0) { 448 # do nothing if input is empty 449 } elsif ($_[0] eq 'reset' or $_[0] eq 'erase' ) { 450 $self->{correct_answer_post_filters} = []; 451 } else { 452 push(@{$self->{correct_answer_post_filters}}, [ @_ ]) if @_; #install post_filter and it's options 453 } 454 @{$self->{correct_answer_post_filters}}; # return array of all post_filters 455 } 456 457 sub ans_hash { #alias for rh_ans 458 my $self = shift; 459 $self->rh_ans(@_); 460 } 461 sub rh_ans { 462 my $self = shift; 463 my %in_hash = @_; 464 foreach my $key (keys %in_hash) { 465 $self->{rh_ans}->{$key} = $in_hash{$key}; 466 } 467 $self->{rh_ans}; 468 } 469 ###################################################### 470 # 471 # Built in Filters 472 # 473 ###################################################### 474 475 476 sub blank_prefilter { # check for blanks 477 my $rh_ans = shift; 478 # undefined answers are BLANKS 479 ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank'); 480 return($rh_ans);}; 481 # answers which are arrays or hashes or some other object reference are NOT blanks 482 ( ref($rh_ans->{student_ans} ) ) && do { return( $rh_ans ) }; 483 # if the answer is a true variable consisting only of white space it is a BLANK 484 ( ($rh_ans->{student_ans}) !~ /\S/ ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank'); 485 return($rh_ans);}; 486 # If we get to here, we assume that the answer is not a blank. It is defined, not a reference 487 # and contains something other than whitespaces. 488 $rh_ans; 489 }; 490 491 sub blank_postfilter { 492 my $rh_ans=shift; 493 return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK'; 494 $rh_ans->{error_flag} = undef; 495 $rh_ans->{error_message} = ''; 496 $rh_ans->{done} =1; # no further checking is needed. 497 $rh_ans; 498 }; 499 500 1; 501 #package AnswerEvaluatorMaker; 502
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |