View of /trunk/pg/macros/PGsequentialmacros.pl

    1 sub listFormVariables {
    2     # Lists all of the variables filled out on the input form
    3   # Useful for debugging
    4     TEXT($HR,"Form variables", );
    5     TEXT(pretty_print($inputs_ref));
    6     TEXT("Environment",$BR);
    7    TEXT(pretty_print(\%envir));
    8    TEXT($HR);
    9 }
   10 sub checkAnswer {
   11     # checks an answer on a given answer evaluator.
   12   my $answerName = shift;  # get the name of the answer
   13     my $ans_eval        = get_PG_ANSWERS_HASH($answerName),;   # get the answer evaluator
   14     my %options         = @_;
   15   my $debug =($options{debug})?1:0;  # give debug information
   16 
   17     my $answer = $main::inputs_ref->{$answerName};
   18     my $response = undef;
   19     if (defined($answer) and defined($ans_eval) ) {
   20     my $rh_ans_hash = $ans_eval->evaluate($answer);
   21                 $response = (defined($rh_ans_hash) and 1 == $rh_ans_hash->{score}) ? 1:0;
   22     TEXT("result of evaluating $answerName",$BR, pretty_print($rh_ans_hash) ) if $debug;
   23   } else {
   24          warn "Answer evaluator for answer $answerName is not defined" unless defined($ans_eval);
   25          # it's ok to have a blank answer.
   26     }
   27     return $response;   # response is (undef => no answer, 1=> correct answer, 0 => not completely correct
   28 }
   29 sub listQueuedAnswers {
   30         # lists the names of the answer blanks so far;
   31         my %pg_answers_hash = get_PG_ANSWERS_HASH();
   32         join(" ", keys %pg_answers_hash);
   33 }
   34 sub checkQueuedAnswers {
   35        # gather all of the answers submitted up to this time
   36       my %options = @_;
   37       my $debug = ($options{debug}) ? 1 :0;
   38       my (%pg_answers_hash) = get_PG_ANSWERS_HASH();
   39       my %scores=();
   40       foreach $label (keys %pg_answers_hash) {
   41              $scores{$label}=checkAnswer($label,  debug=>$debug);
   42       }
   43      %scores;
   44 }
   45 sub all_answers_are_correct{
   46      # return 1 if all scores are 1, else it returns 0;
   47      # returns 0 if no answers have been checked yet
   48      my %scores = checkQueuedAnswers();
   49      return 0 unless %scores;
   50      my $result =1;
   51      foreach my $label (keys %scores) { if (not defined($scores{$label}) or $scores{$label} <1) {$result=0; last;} };
   52      $result;
   53 }
   54 sub get_incorrect_answers {
   55   # returns only incorrect answers, not blank or undefined answers.
   56     my %scores = checkQueuedAnswers();
   57     my @incorrect = ();
   58     foreach my $label (keys %scores) {push( @incorrect, $label)
   59           unless  (not defined($scores{$label}) or $scores{$label}==1  )
   60     };
   61     @incorrect;
   62 }
   63 
   64 1;
   65 
   66