[system] / trunk / pg / macros / PGsequentialmacros.pl Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3386 - (view) (download) (as text)

1 : gage 3386 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 :    

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9