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

Diff of /trunk/pg/macros/PG.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1266 Revision 1280
74 74
75# Private variables for the PG.pl file. 75# Private variables for the PG.pl file.
76 76
77my ($STRINGforOUTPUT, $STRINGforHEADER_TEXT, @PG_ANSWERS, @PG_UNLABELED_ANSWERS); 77my ($STRINGforOUTPUT, $STRINGforHEADER_TEXT, @PG_ANSWERS, @PG_UNLABELED_ANSWERS);
78my %PG_ANSWERS_HASH ; 78my %PG_ANSWERS_HASH ;
79
79# my variables are unreliable if two DOCUMENTS were to be called before and ENDDOCUMENT 80# my variables are unreliable if two DOCUMENTS were to be called before and ENDDOCUMENT
80# there could be conflicts. As I understand the behavior of the Apache child 81# there could be conflicts. As I understand the behavior of the Apache child
81# this cannot occur -- a child finishes with one request before obtaining the next 82# this cannot occur -- a child finishes with one request before obtaining the next
82 83
83# DOCUMENT must come early in every .pg file, before any answers or text are 84# DOCUMENT must come early in every .pg file, before any answers or text are
136 $main::showPartialCorrectAnswers = 0 unless defined($main::showPartialCorrectAnswers ); 137 $main::showPartialCorrectAnswers = 0 unless defined($main::showPartialCorrectAnswers );
137 $main::showHint = 1 unless defined($main::showHint); 138 $main::showHint = 1 unless defined($main::showHint);
138 $main::solutionExists =0; 139 $main::solutionExists =0;
139 $main::hintExists =0; 140 $main::hintExists =0;
140 %main::gifs_created = (); 141 %main::gifs_created = ();
142
141 !); 143 !);
142# warn eval(q! "PG.pl: The envir variable $main::{envir} is".join(" ",%main::envir)!); 144# warn eval(q! "PG.pl: The envir variable $main::{envir} is".join(" ",%main::envir)!);
143 my $rh_envir = eval(q!\%main::envir!); 145 my $rh_envir = eval(q!\%main::envir!);
144 my %envir = %$rh_envir; 146 my %envir = %$rh_envir;
145 no strict; 147 no strict;
254 256
255sub NAMED_ANS{ # store answer evaluators which have been explicitly labeled (submitted in a hash) 257sub NAMED_ANS{ # store answer evaluators which have been explicitly labeled (submitted in a hash)
256 my @in = @_; 258 my @in = @_;
257 while (@in ) { 259 while (@in ) {
258 my $label = shift @in; 260 my $label = shift @in;
259 $label = $main::QUIZ_PREFIX.$label; 261 $label = eval(q!$main::QUIZ_PREFIX.$label!);
260 my $ans_eval = shift @in; 262 my $ans_eval = shift @in;
261 TEXT("<BR><B>Error in NAMED_ANS:$in[0]</B> 263 TEXT("<BR><B>Error in NAMED_ANS:$in[0]</B>
262 -- inputs must be references to subroutines<BR>") 264 -- inputs must be references to subroutines<BR>")
263 unless ref($ans_eval); 265 unless ref($ans_eval);
264 $PG_ANSWERS_HASH{$label}= $ans_eval; 266 $PG_ANSWERS_HASH{$label}= $ans_eval;
265 } 267 }
266} 268}
267sub RECORD_ANS_NAME { # this maintains the order in which the answer rules are printed. 269sub RECORD_ANS_NAME { # this maintains the order in which the answer rules are printed.
268 my $label = shift; 270 my $label = shift;
269 push(@main::PG_ANSWER_ENTRY_ORDER, $label); 271 eval(q!push(@main::PG_ANSWER_ENTRY_ORDER, $label)!);
270 $label; 272 $label;
271} 273}
272 274
273sub NEW_ANS_NAME { # this keeps track of the answers which are entered implicitly, 275sub NEW_ANS_NAME { # this keeps track of the answers which are entered implicitly,
274 # rather than with a specific label 276 # rather than with a specific label
275 my $number=shift; 277 my $number=shift;
276 my $label = "$main::QUIZ_PREFIX$main::ANSWER_PREFIX$number"; 278 my $prefix = eval(q!$main::QUIZ_PREFIX.$main::ANSWER_PREFIX!);
279 my $label = $prefix.$number;
277 push(@PG_UNLABELED_ANSWERS,$label); 280 push(@PG_UNLABELED_ANSWERS,$label);
278 $label; 281 $label;
279} 282}
280sub ANS_NUM_TO_NAME { # This converts a number to an answer label for use in 283sub ANS_NUM_TO_NAME { # This converts a number to an answer label for use in
281 # radio button and check box answers. No new answer 284 # radio button and check box answers. No new answer
282 # name is recorded. 285 # name is recorded.
283 my $number=shift; 286 my $number=shift;
284 my $label = "$main::QUIZ_PREFIX$main::ANSWER_PREFIX$number"; 287 my $label = eval(q!$main::QUIZ_PREFIX$main::ANSWER_PREFIX$number"!);
285 $label; 288 $label;
286} 289}
287 290
288my $vecnum; 291my $vecnum;
289 292
356 359
357 my $index=0; 360 my $index=0;
358 foreach my $label (@PG_UNLABELED_ANSWERS) { 361 foreach my $label (@PG_UNLABELED_ANSWERS) {
359 if ( defined($PG_ANSWERS[$index]) ) { 362 if ( defined($PG_ANSWERS[$index]) ) {
360 $PG_ANSWERS_HASH{"$label"}= $PG_ANSWERS[$index]; 363 $PG_ANSWERS_HASH{"$label"}= $PG_ANSWERS[$index];
364 #warn "recording answer label = $label";
361 } else { 365 } else {
362 warn "No answer provided by instructor for answer $label"; 366 warn "No answer provided by instructor for answer $label";
363 } 367 }
364 $index++; 368 $index++;
365 } 369 }
403 warn "ERROR: The problem grader is not a subroutine" unless ref( $main::PG_FLAGS{PROBLEM_GRADER_TO_USE}) eq 'CODE' 407 warn "ERROR: The problem grader is not a subroutine" unless ref( $main::PG_FLAGS{PROBLEM_GRADER_TO_USE}) eq 'CODE'
404 or $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = 'std_problem_grader' 408 or $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = 'std_problem_grader'
405 or $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = 'avg_problem_grader'; 409 or $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = 'avg_problem_grader';
406 # return results 410 # return results
407 }; 411 };
412
408 (\$STRINGforOUTPUT, \$STRINGforHEADER_TEXT,\%PG_ANSWERS_HASH,eval(q!\%main::PG_FLAGS!)); 413 (\$STRINGforOUTPUT, \$STRINGforHEADER_TEXT,\%PG_ANSWERS_HASH,eval(q!\%main::PG_FLAGS!));
409} 414}
410 415
411 416
412 417

Legend:
Removed from v.1266  
changed lines
  Added in v.1280

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9