[system] / trunk / pg / lib / AnswerHash.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/AnswerHash.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3349 - (download) (as text) (annotate)
Mon Jul 4 22:11:08 2005 UTC (14 years, 7 months ago) by gage
File size: 24224 byte(s)
Add comment

    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>=&gt;</td><td>&nbsp;".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->{preview_latex_string} = join("\\quad", $self->{preview_latex_string}, $rh_ans2->{preview_latex_string} );
  428   $out_hash->{original_student_ans} = $self->{original_student_ans};
  429   $out_hash;
  430 }
  431 
  432 
  433 =head1 Description:  AnswerEvaluator
  434 
  435 
  436 
  437 
  438 =cut
  439 
  440 
  441 
  442 package AnswerEvaluator;
  443 
  444 
  445 =head3 AnswerEvaluator Methods
  446 
  447 
  448 
  449 
  450 
  451 
  452 
  453 =cut
  454 
  455 
  456 =head4 new
  457 
  458 
  459 =cut
  460 
  461 
  462 sub new {
  463   my $class = shift @_;
  464 
  465   my $self  = { pre_filters   =>  [ [\&blank_prefilter] ],
  466           evaluators    =>  [],
  467           post_filters  =>  [ [\&blank_postfilter] ],
  468           debug     =>  0,
  469           rh_ans    =>  new AnswerHash,
  470 
  471   };
  472 
  473   bless $self, $class;
  474   $self->rh_ans(@_);    #initialize answer hash
  475   return $self;
  476 }
  477 
  478 # dereference_array_ans pretty prints an answer which is stored as an anonymous array.
  479 sub dereference_array_ans {
  480   my $self = shift;
  481   my $rh_ans = shift;
  482   $rh_ans->{_filter_name} = 'dereference_array_ans';
  483   if (defined($rh_ans->{student_ans}) and ref($rh_ans->{student_ans}) eq 'ARRAY'  ) {
  484     $rh_ans->{student_ans} = "( ". join(" , ",@{$rh_ans->{student_ans}} ) . " ) ";
  485   }
  486   $rh_ans;
  487 }
  488 
  489 sub get_student_answer {
  490   my $self           = shift;
  491   my $input          = shift;
  492   my %answer_options = @_;
  493   my $display_input  = $input;
  494   $display_input =~ s/\0/\\0/g;  # make null spacings visible
  495   warn "Raw student answer is |$display_input|" if $self->{debug};
  496   $input = '' unless defined($input);
  497   if (ref($input) =~/AnswerHash/) {
  498     # in this case nothing needs to be done, since the student's answer is already in an answerhash.
  499     # This is useful when an AnswerEvaluator is used as a filter in another answer evaluator.
  500   } elsif ($input =~ /\0/ ) {  # this case may occur with older versions of CGI??
  501       my @input = split(/\0/,$input);
  502       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  503     $input = \@input;
  504     $self-> {rh_ans} -> {student_ans} = $input;
  505   } elsif (ref($input) eq 'ARRAY' ) {  # sometimes the answer may already be decoded into an array.
  506       my @input = @$input;
  507       $self-> {rh_ans} -> {original_student_ans} = " ( " .join(", ",@input) . " ) ";
  508     $input = \@input;
  509     $self-> {rh_ans} -> {student_ans} = $input;
  510   } else {
  511 
  512     $self-> {rh_ans} -> {original_student_ans} = $input;
  513     $self-> {rh_ans} -> {student_ans} = $input;
  514   }
  515   $self->{rh_ans}->{ans_label}   = $answer_options{ans_label} if defined($answer_options{ans_label});
  516   $self->{rh_ans}->{_filter_name} = 'get_student_answer';
  517   $input;
  518 }
  519 
  520 =head4  evaluate
  521 
  522   $answer_evaluator->evaluate($student_answer_string
  523 
  524 
  525 =cut
  526 our $count;   # used to keep track of where we are in queue
  527 
  528 sub evaluate {
  529   my $self    =   shift;
  530   $self->get_student_answer(@_);
  531   # dereference $self->{rh_ans};
  532   my $rh_ans      =   $self ->{rh_ans};
  533   $rh_ans->{error_flag}=undef;  #reset the error flags in case
  534   $rh_ans->{done}=undef;        #the answer evaluator is called twice
  535 
  536     warn "<H3> Answer evaluator information: </H3>\n" if defined($self->{debug}) and $self->{debug}>0;
  537     $self->print_result_if_debug('pre_filter',$rh_ans);
  538 
  539   my @prefilters  = @{$self -> {pre_filters}};
  540   $count = 0;  # the get student answer filter is counted as filter -1
  541   foreach my $i (@prefilters) {
  542       last if defined( $rh_ans->{error_flag} );
  543       my @array = @$i;
  544       my $filter = shift(@array);      # the array now contains the options for the filter
  545       $rh_ans               = &$filter($rh_ans,@array);
  546       $self->print_result_if_debug('pre_filter',$rh_ans,@array);
  547   }
  548   my @evaluators = @{$self -> {evaluators} };
  549   $count = 0;
  550   foreach my $i ( @evaluators )   {
  551       last if defined($rh_ans->{error_flag});
  552     my @array = @$i;
  553       my $evaluator = shift(@array);   # the array now contains the options for the filter
  554       $rh_ans               = &$evaluator($rh_ans,@array);
  555       $self->print_result_if_debug('evaluator',$rh_ans,@array);
  556   }
  557   my @post_filters = @{$self -> {post_filters} };
  558   $count = 0;  # blank filter catcher is filter 0
  559   foreach my $i ( @post_filters ) {
  560       last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
  561     my @array = @$i;
  562 
  563       my $filter = shift(@array);      # the array now contains the options for the filter
  564       $rh_ans               = &$filter($rh_ans,@array);
  565       $self->print_result_if_debug('post_filter',$rh_ans,@array);
  566   }
  567   $rh_ans = $self->dereference_array_ans($rh_ans);
  568   # make sure that the student answer is not an array so that it is reported correctly in answer section.
  569   warn "<h4>final result: </h4>", $rh_ans->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  570   # re-refrence $rh_ans;
  571   $self ->{rh_ans} = $rh_ans;
  572   $rh_ans;
  573 }
  574 sub print_result_if_debug {
  575   my $self = shift;
  576   my $queue = shift;    # the name of the queue we are in
  577   my $rh_ans= shift;
  578   my %options = @_;
  579   if (defined($self->{debug}) and $self->{debug}>0) {
  580         $rh_ans->{rh_options} = \%options;  #include the options in the debug information
  581         my $name = (defined($rh_ans->{_filter_name})) ? $rh_ans->{_filter_name}: 'unnamed';
  582         warn "$count. Result from \"$name\" $queue:", $rh_ans->pretty_print();
  583         ++$count;
  584    }
  585   $rh_ans->{_filter_name} = undef;
  586 }
  587 
  588 # This next subroutine is for checking the instructor's answer and is not yet in use.
  589 # sub correct_answer_evaluate {
  590 #   my $self    =   shift;
  591 #   $self-> {rh_ans} -> {correct_ans} = shift @_;
  592 #   my $rh_ans    =   $self ->{rh_ans};
  593 #   my @prefilters  = @{$self -> {correct_answer_pre_filters}};
  594 #   my $count = -1;  # the blank filter is counted as filter 0
  595 #   foreach my $i (@prefilters) {
  596 #       last if defined( $rh_ans->{error_flag} );
  597 #       my @array = @$i;
  598 #       my $filter = shift(@array);      # the array now contains the options for the filter
  599 #       warn "before pre-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  600 #     $rh_ans   = &$filter($rh_ans,@array);
  601 #     warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name})
  602 #   }
  603 #   my @evaluators = @{$self -> {correct_answer_evaluators} };
  604 #   $count = 0;
  605 #   foreach my $i ( @evaluators )   {
  606 #       last if defined($self->{rh_ans}->{error_flag});
  607 #     my @array = @$i;
  608 #       my $evaluator = shift(@array);   # the array now contains the options for the filter
  609 #       warn "before evaluator: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  610 #     $rh_ans   = &$evaluator($rh_ans,@array);
  611 #   }
  612 #   my @post_filters = @{$self -> {correct_answer_post_filters} };
  613 #   $count = -1;  # blank filter catcher is filter 0
  614 #   foreach my $i ( @post_filters ) {
  615 #       last if defined($rh_ans->{done}) and $rh_ans->{done} == 1;    # no further action needed
  616 #     my @array = @$i;
  617 #       my $filter = shift(@array);      # the array now contains the options for the filter
  618 #       warn "before post-filter: ",++$count, $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  619 #     $rh_ans   = &$filter($rh_ans,@array);
  620 #     warn "Filter Name:", $rh_ans->{_filter_name},"<BR>\n" if $self->{debug}>0 and defined($rh_ans->{_filter_name})
  621 #   }
  622 #   $rh_ans = $self->dereference_array_ans($rh_ans);
  623 #   # make sure that the student answer is not an array so that it is reported correctly in answer section.
  624 #   warn "final result: ", $self->{rh_ans}->pretty_print() if defined($self->{debug}) and $self->{debug}>0;
  625 #   $self ->{rh_ans} = $rh_ans;
  626 #   $rh_ans;
  627 # }
  628 
  629 
  630 =head4 install_pre_filter
  631 
  632 =head4 install_evaluator
  633 
  634 
  635 =head4 install_post_filter
  636 
  637 
  638 =head4
  639 
  640 
  641 
  642 =cut
  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   $rh_ans->{_filter_name} = 'blank_prefilter';
  783     # undefined answers are BLANKS
  784   ( not defined($rh_ans->{student_ans}) ) && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  785                             return($rh_ans);};
  786     # answers which are arrays or hashes or some other object reference  are NOT blanks
  787     ( ref($rh_ans->{student_ans} )        ) && do { return( $rh_ans ) };
  788     # if the answer is a true variable consisting only of white space it is a BLANK
  789     ( ($rh_ans->{student_ans}) !~ /\S/   )    && do {$rh_ans->throw_error("BLANK", 'The answer is blank');
  790                             return($rh_ans);};
  791   # If we get to here, we assume that the answer is not a blank. It is defined, not a reference
  792   # and contains something other than whitespaces.
  793   $rh_ans;
  794 };
  795 
  796 sub blank_postfilter  {
  797   my $rh_ans=shift;
  798   $rh_ans->{_filter_name} = 'blank_postfilter';
  799     return($rh_ans) unless defined($rh_ans->{error_flag}) and $rh_ans->{error_flag} eq 'BLANK';
  800     $rh_ans->{error_flag} = undef;
  801     $rh_ans->{error_message} = '';
  802     $rh_ans->{done} =1;    # no further checking is needed.
  803     $rh_ans;
  804 };
  805 
  806 1;
  807 #package AnswerEvaluatorMaker;
  808 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9