[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 1050 - (download) (as text) (annotate)
Fri Jun 6 21:39:42 2003 UTC (16 years, 7 months ago) by sh002i
File size: 23974 byte(s)
moved PG modules and macro files from webwork-modperl to pg
-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>=&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->{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