[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 2984 Revision 3385
72 72
73# Private variables for the PG.pl file. 73# Private variables for the PG.pl file.
74 74
75my ($STRINGforOUTPUT, $STRINGforHEADER_TEXT, @PG_ANSWERS, @PG_UNLABELED_ANSWERS); 75my ($STRINGforOUTPUT, $STRINGforHEADER_TEXT, @PG_ANSWERS, @PG_UNLABELED_ANSWERS);
76my %PG_ANSWERS_HASH ; 76my %PG_ANSWERS_HASH ;
77our $PG_STOP_FLAG;
77 78
78# my variables are unreliable if two DOCUMENTS were to be called before and ENDDOCUMENT 79# my variables are unreliable if two DOCUMENTS were to be called before an ENDDOCUMENT
79# there could be conflicts. As I understand the behavior of the Apache child 80# there could be conflicts. As I understand the behavior of the Apache child
80# this cannot occur -- a child finishes with one request before obtaining the next 81# this cannot occur -- a child finishes with one request before obtaining the next
81 82
82# DOCUMENT must come early in every .pg file, before any answers or text are 83# DOCUMENT must come early in every .pg file, before any answers or text are
83# defined. It initializes the variables. 84# defined. It initializes the variables.
111sub DOCUMENT { 112sub DOCUMENT {
112 113
113 $STRINGforOUTPUT =""; 114 $STRINGforOUTPUT ="";
114 $STRINGforHEADER_TEXT =""; 115 $STRINGforHEADER_TEXT ="";
115 @PG_ANSWERS=(); 116 @PG_ANSWERS=();
116 117 $PG_STOP_FLAG=0;
117 @PG_UNLABELED_ANSWERS = (); 118 @PG_UNLABELED_ANSWERS = ();
118 %PG_ANSWERS_HASH = (); 119 %PG_ANSWERS_HASH = ();
119 # FIXME: We are initializing these variables into both Safe::Root1 (the cached safe compartment) 120 # FIXME: We are initializing these variables into both Safe::Root1 (the cached safe compartment)
120 # and Safe::Root2 (the current one) 121 # and Safe::Root2 (the current one)
121 # There is a good chance they won't be properly updated in one or the other of these compartments. 122 # There is a good chance they won't be properly updated in one or the other of these compartments.
248It can be used more than once in a file. 249It can be used more than once in a file.
249 250
250=cut 251=cut
251 252
252sub TEXT { 253sub TEXT {
254 return "" if $PG_STOP_FLAG;
253 my @in = @_; 255 my @in = @_;
254 $STRINGforOUTPUT .= join(" ",@in); 256 $STRINGforOUTPUT .= join(" ",@in);
255 } 257}
256 258sub STOP_RENDERING {
257 259 $PG_STOP_FLAG=1;
260 "";
261}
262sub RESUME_RENDERING {
263 $PG_STOP_FLAG=0;
264 "";
265}
258 266
259=head2 ANS() 267=head2 ANS()
260 268
261 ANS(answer_evaluator1, answer_evaluator2, answer_evaluator3,...) 269 ANS(answer_evaluator1, answer_evaluator2, answer_evaluator3,...)
262 270
271order. 279order.
272 280
273=cut 281=cut
274 282
275sub ANS{ # store answer evaluators which have not been explicitly labeled 283sub ANS{ # store answer evaluators which have not been explicitly labeled
284 return "" if $PG_STOP_FLAG;
276 my @in = @_; 285 my @in = @_;
277 while (@in ) { 286 while (@in ) {
278 warn("<BR><B>Error in ANS:$in[0]</B> -- inputs must be references to 287 warn("<BR><B>Error in ANS:$in[0]</B> -- inputs must be references to
279 subroutines<BR>") 288 subroutines<BR>")
280 unless ref($in[0]); 289 unless ref($in[0]);
281 push(@PG_ANSWERS, shift @in ); 290 push(@PG_ANSWERS, shift @in );
282 } 291 }
283} 292}
284sub LABELED_ANS { #a better alias for NAMED_ANS 293sub LABELED_ANS { #a better alias for NAMED_ANS
285 &NAMED_ANS; 294 &NAMED_ANS;
286} 295}
287 296
288sub NAMED_ANS{ # store answer evaluators which have been explicitly labeled (submitted in a hash) 297sub NAMED_ANS{ # store answer evaluators which have been explicitly labeled (submitted in a hash)
298 return "" if $PG_STOP_FLAG;
289 my @in = @_; 299 my @in = @_;
290 while (@in ) { 300 while (@in ) {
291 my $label = shift @in; 301 my $label = shift @in;
292 $label = eval(q!$main::QUIZ_PREFIX.$label!); 302 $label = eval(q!$main::QUIZ_PREFIX.$label!);
293 my $ans_eval = shift @in; 303 my $ans_eval = shift @in;
296 unless ref($ans_eval); 306 unless ref($ans_eval);
297 $PG_ANSWERS_HASH{$label}= $ans_eval; 307 $PG_ANSWERS_HASH{$label}= $ans_eval;
298 } 308 }
299} 309}
300sub RECORD_ANS_NAME { # this maintains the order in which the answer rules are printed. 310sub RECORD_ANS_NAME { # this maintains the order in which the answer rules are printed.
311 return "" if $PG_STOP_FLAG;
301 my $label = shift; 312 my $label = shift;
302 eval(q!push(@main::PG_ANSWER_ENTRY_ORDER, $label)!); 313 eval(q!push(@main::PG_ANSWER_ENTRY_ORDER, $label)!);
303 $label; 314 $label;
304} 315}
305 316
306sub NEW_ANS_NAME { # this keeps track of the answers which are entered implicitly, 317sub NEW_ANS_NAME { # this keeps track of the answers which are entered implicitly,
307 # rather than with a specific label 318 # rather than with a specific label
319 return "" if $PG_STOP_FLAG;
308 my $number=shift; 320 my $number=shift;
309 my $prefix = eval(q!$main::QUIZ_PREFIX.$main::ANSWER_PREFIX!); 321 my $prefix = eval(q!$main::QUIZ_PREFIX.$main::ANSWER_PREFIX!);
310 my $label = $prefix.$number; 322 my $label = $prefix.$number;
311 push(@PG_UNLABELED_ANSWERS,$label); 323 push(@PG_UNLABELED_ANSWERS,$label);
312 $label; 324 $label;
321 333
322my $vecnum; 334my $vecnum;
323 335
324sub RECORD_FORM_LABEL { # this stores form data (such as sticky answers), but does nothing more 336sub RECORD_FORM_LABEL { # this stores form data (such as sticky answers), but does nothing more
325 # it's a bit of hack since we are storing these in the KEPT_EXTRA_ANSWERS queue even if they aren't answers per se. 337 # it's a bit of hack since we are storing these in the KEPT_EXTRA_ANSWERS queue even if they aren't answers per se.
338 return "" if $PG_STOP_FLAG;
326 my $label = shift; # the label of the input box or textarea 339 my $label = shift; # the label of the input box or textarea
327 eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!); #put the labels into the hash to be caught later for recording purposes 340 eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!); #put the labels into the hash to be caught later for recording purposes
328 $label; 341 $label;
329} 342}
330sub NEW_ANS_ARRAY_NAME { # this keeps track of the answers which are entered implicitly, 343sub NEW_ANS_ARRAY_NAME { # this keeps track of the answers which are entered implicitly,
331 # rather than with a specific label 344 # rather than with a specific label
345 return "" if $PG_STOP_FLAG;
332 my $number=shift; 346 my $number=shift;
333 $vecnum = 0; 347 $vecnum = 0;
334 my $row = shift; 348 my $row = shift;
335 my $col = shift; 349 my $col = shift;
336# my $label = "ArRaY"."$number"."["."$vecnum".","."$row".","."$col"."]"; 350# my $label = "ArRaY"."$number"."["."$vecnum".","."$row".","."$col"."]";
338 push(@PG_UNLABELED_ANSWERS,$label); 352 push(@PG_UNLABELED_ANSWERS,$label);
339 $label; 353 $label;
340} 354}
341 355
342sub NEW_ANS_ARRAY_NAME_EXTENSION { # this keeps track of the answers which are entered implicitly, 356sub NEW_ANS_ARRAY_NAME_EXTENSION { # this keeps track of the answers which are entered implicitly,
343 # rather than with a specific label 357 # rather than with a specific label
358 return "" if $PG_STOP_FLAG;
344 my $number=shift; 359 my $number=shift;
345 my $row = shift; 360 my $row = shift;
346 my $col = shift; 361 my $col = shift;
347 if( $row == 0 && $col == 0 ){ 362 if( $row == 0 && $col == 0 ){
348 $vecnum += 1; 363 $vecnum += 1;
354 my $label = "ArRaY"."$number"."__"."$vecnum".":"."$row".":"."$col"."__"; 369 my $label = "ArRaY"."$number"."__"."$vecnum".":"."$row".":"."$col"."__";
355 eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!);#put the labels into the hash to be caught later for recording purposes 370 eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!);#put the labels into the hash to be caught later for recording purposes
356 $label; 371 $label;
357} 372}
358 373
374
375sub get_PG_ANSWERS_HASH {
376 # update the PG_ANSWWERS_HASH, then report the result.
377 # This is used in writing sequential problems
378 # if there is an input, use that as a key into the answer hash
379 my $key = shift;
380 my (%pg_answers_hash, @pg_unlabeled_answers);
381 %pg_answers_hash= %PG_ANSWERS_HASH;
382 #warn "order ", eval(q!@main::PG_ANSWER_ENTRY_ORDER!);
383 #warn "pg answers", %PG_ANSWERS_HASH;
384 #warn "unlabeled", @PG_UNLABELED_ANSWERS;
385 my $index=0;
386 foreach my $label (@PG_UNLABELED_ANSWERS) {
387 if ( defined($PG_ANSWERS[$index]) ) {
388 $pg_answers_hash{"$label"}= $PG_ANSWERS[$index];
389 #warn "recording answer label = $label";
390 } else {
391 warn "No answer provided by instructor for answer $label";
392 }
393 $index++;
394 }
395 if ($key) {
396 return $pg_answers_hash{$key};
397 } else {
398 return %pg_answers_hash;
399 }
400}
359# ENDDOCUMENT must come at the end of every .pg file. 401# ENDDOCUMENT must come at the end of every .pg file.
360# It exports the resulting text of the problem, the text to be used in HTML header material 402# It exports the resulting text of the problem, the text to be used in HTML header material
361# (for javaScript), the list of answer evaluators and any other flags. It can appear only once and 403# (for javaScript), the list of answer evaluators and any other flags. It can appear only once and
362# it MUST be the last statement in the problem. 404# it MUST be the last statement in the problem.
363 405

Legend:
Removed from v.2984  
changed lines
  Added in v.3385

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9