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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2698 - (download) (as text) (annotate)
Sat Aug 28 13:52:33 2004 UTC (15 years, 4 months ago) by dpvc
File size: 18164 byte(s)
Add better error reporting in PG translator.  In particular, these
changes add two new features:

	1)  produce a full stack trace when a .pg file dies, and
	2)  convert (eval nnn) references to filenames, when
	    possible, in warn and die messages while processing a
	    .pg file.

There is also a change in the webwork tree that is needed to make this
all work, so be sure to apply updates in both trees.

    1 # This file provided the fundamental macros for the pg language
    2 # These macros define the interface between the problems written by
    3 # the professor and the processing which occurs in the script
    4 # processProblem.pl
    5 
    6 
    7 BEGIN {
    8   be_strict();
    9 }
   10 
   11 sub _PG_init{
   12 
   13 }
   14 
   15 #package PG;
   16 
   17 
   18 =head1 NAME
   19 
   20   PG.pl --- located in the courseScripts directory.
   21   Defines the Program Generating language at the most basic level.
   22 
   23 =head1 SYNPOSIS
   24 
   25   The basic PG problem structure:
   26 
   27   DOCUMENT();          # should be the first statment in the problem
   28   loadMacros(.....);   # (optional) load other macro files if needed.
   29                        # (loadMacros is defined in F<dangerousMacros.pl>)
   30 
   31   HEADER_TEXT(...);    # (optional) used only for inserting javaScript into problems.
   32 
   33   #            #  insert text of problems
   34   TEXT("Problem text to be",
   35        "displayed. Enter 1 in this blank:",
   36        ANS_RULE(1,30)  #  ANS_RULE() defines an answer blank 30 characters long.
   37                        #  It is defined in F<PGbasicmacros.pl>
   38        );
   39 
   40 
   41   ANS( answer_evalutors);  # see F<PGanswermacros.pl> for examples of answer evaluatiors.
   42 
   43   ENDDOCUMENT()        # must be the last statement in the problem
   44 
   45 
   46 
   47 =head1 DESCRIPTION
   48 
   49 As described in the synopsis, this file and the macros C<DOCUMENT()> and C<ENDDOCUMENT()> determine
   50 the interface between problems written in the PG language and the rest of B<WeBWorK>, in particular
   51 the subroutine C<createPGtext(()> in the file F<translate.pl>.
   52 
   53 C<DOCUMENT()> must be the first statement in each problem template.
   54 It  initializes variables,
   55 in particular all of the contents of the
   56 environment variable  become defined in the problem enviroment.
   57 (See
   58 L</webwork_system_html/docs/techdescription/pglanguage/PGenvironment.html>)
   59 
   60 ENDDOCUMENT() must the last executable statement in any problem template.  It returns
   61 the rendered problem, answer evaluators and other flags to the rest of B<WeBWorK>, specificially
   62 to the routine C<createPGtext()> defined in F<translate.pl>
   63 
   64 
   65 The C<HEADER_TEXT()>, C<TEXT()>, and C<ANS()> functions load the
   66 header text string, the problem text string.
   67 and the answer evaulator queue respectively.
   68 
   69 
   70 =cut
   71 
   72 
   73 #  Private variables for the PG.pl file.
   74 
   75 my ($STRINGforOUTPUT, $STRINGforHEADER_TEXT, @PG_ANSWERS, @PG_UNLABELED_ANSWERS);
   76 my %PG_ANSWERS_HASH ;
   77 
   78 # my variables are unreliable if two DOCUMENTS were to be called before and ENDDOCUMENT
   79 # 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 
   82 #   DOCUMENT must come early in every .pg file, before any answers or text are
   83 # defined.  It initializes the variables.
   84 # It can appear only once.
   85 
   86 =head2 DOCUMENT()
   87 
   88 C<DOCUMENT()> must be the first statement in each problem template.  It can
   89 only be used once in each problem.
   90 
   91 C<DOCUMENT()> initializes some empty variables and via C<INITIALIZE_PG()> unpacks the
   92 variables in the C<%envir> variable which is implicitly passed to the problem. It must
   93 be the first statement in any problem template. It
   94 also unpacks any answers submitted and places them in the C<@submittedAnswer> list,
   95 saves the problem seed in C<$PG_original_problemSeed> in case you need it later, and
   96 initializes the pseudo random number generator object in C<$PG_random_generator>.
   97 
   98 You can reset the standard number generator using the command:
   99 
  100   $PG_random_generator->srand($new_seed_value);
  101 
  102 (See also C<SRAND> in the L<PGbasicmacros.pl> file.)
  103 
  104 The
  105 environment variable contents is defined in
  106 L</webwork_system_html/docs/techdescription/pglanguage/PGenvironment.html>
  107 
  108 
  109 =cut
  110 
  111 sub DOCUMENT {
  112 
  113   $STRINGforOUTPUT ="";
  114     $STRINGforHEADER_TEXT ="";
  115   @PG_ANSWERS=();
  116 
  117   @PG_UNLABELED_ANSWERS = ();
  118   %PG_ANSWERS_HASH = ();
  119   # FIXME:  We are initializing these variables into both Safe::Root1 (the cached safe compartment)
  120   # 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 
  123 #   @main::PG_ANSWER_ENTRY_ORDER = ();
  124 #   $main::ANSWER_PREFIX = 'AnSwEr';
  125 #   %main::PG_FLAGS=();  #global flags
  126 #   $main::showPartialCorrectAnswers = 0 unless defined($main::showPartialCorrectAnswers );
  127 #   $main::showHint = 1 unless defined($main::showHint);
  128 #   $main::solutionExists =0;
  129 #   $main::hintExists =0;
  130 #   %main::gifs_created = ();
  131   eval(q!
  132   @main::PG_ANSWER_ENTRY_ORDER = ();
  133   $main::ANSWER_PREFIX = 'AnSwEr';
  134   %main::PG_FLAGS=();  #global flags
  135   $main::showPartialCorrectAnswers = 0 unless defined($main::showPartialCorrectAnswers );
  136   $main::showHint = 1 unless defined($main::showHint);
  137   $main::solutionExists =0;
  138   $main::hintExists =0;
  139   %main::gifs_created = ();
  140 
  141     !);
  142 #    warn eval(q! "PG.pl:  The envir variable $main::{envir} is".join(" ",%main::envir)!);
  143     my $rh_envir = eval(q!\%main::envir!);
  144     my %envir    = %$rh_envir;
  145 
  146     # Save the file name for use in error messages
  147     my ($callpkg,$callfile) = caller(0);
  148     $envir{__files__}{$callfile} = $envir{templateDirectory}.$envir{fileName};
  149 
  150     #no strict;
  151     foreach  my  $var (keys %envir) {
  152       eval(q!$main::!.$var.q! = $main::envir{!.$var.q!}! );  #whew!! makes sure $var is interpolated but $main:: is evaluated at run time.
  153     #    warn eval(q! "var $var is defined ". $main::!.$var);
  154         warn "Problem defining ", q{\$main::}.$var, " while initializing the PG problem: $@" if $@;
  155     }
  156     #use strict;
  157     #FIXME these strict pragmas don't seem to be needed and they cause trouble in perl 5.6.0
  158 
  159 
  160 
  161     eval(q!
  162   @main::submittedAnswers = @{$main::refSubmittedAnswers} if defined($main::refSubmittedAnswers);
  163   $main::PG_original_problemSeed = $main::problemSeed;
  164   $main::PG_random_generator = new PGrandom($main::problemSeed) || die "Can't create random number generator.";
  165   $main::ans_rule_count = 0;  # counts questions
  166 
  167     # end unpacking of environment variables.
  168     $main::QUIZ_PREFIX = '' unless defined($main::QUIZ_PREFIX)
  169 
  170   !);
  171 #   @main::submittedAnswers = @{$main::refSubmittedAnswers} if defined($main::refSubmittedAnswers);
  172 #   $main::PG_original_problemSeed = $main::problemSeed;
  173 #   $main::PG_random_generator = new PGrandom($main::problemSeed) || die "Can't create random number generator.";
  174 #   $main::ans_rule_count = 0;  # counts questions
  175 
  176     # end unpacking of environment variables.
  177 #   $main::QUIZ_PREFIX = '' unless defined($main::QUIZ_PREFIX)
  178 
  179   $STRINGforOUTPUT = '<SCRIPT SRC="'.$main::envir{jsMathURL}.'"></SCRIPT>' . "\n" .
  180         '<NOSCRIPT><CENTER><FONT COLOR="#CC0000">' .
  181               '<B>Warning: the mathematics on this page requires JavaScript.<BR>' .
  182               'If your browser supports it, be sure it is enabled.</B>'.
  183               '</FONT></CENTER><p></NOSCRIPT>' .
  184                   $STRINGforOUTPUT if ($main::envir{displayMode} eq 'HTML_jsMath');
  185 
  186   $STRINGforOUTPUT = '<SCRIPT SRC="'.$main::envir{asciimathURL}.'"></SCRIPT>' . "\n" .
  187                            '<SCRIPT>mathcolor = "black"</SCRIPT>' . $STRINGforOUTPUT
  188     if ($main::envir{displayMode} eq 'HTML_asciimath');
  189 
  190 }
  191 
  192 sub inc_ans_rule_count {
  193   eval(q!++$main::ans_rule_count!); # evalute at runtime to get correct main::
  194 }
  195 # HEADER_TEXT is for material which is destined to be placed in the header of the html problem -- such
  196 #   as javaScript code.
  197 
  198 =head2 HEADER_TEXT()
  199 
  200 
  201   HEADER_TEXT("string1", "string2", "string3");
  202 
  203 The C<HEADER_TEXT()>
  204 function concatenates its arguments and places them in the output
  205 header text string.  It is used for material which is destined to be placed in
  206 the header of the html problem -- such as javaScript code.
  207  It can be used more than once in a file.
  208 
  209 
  210 =cut
  211 
  212 sub HEADER_TEXT {
  213   my @in = @_;
  214   $STRINGforHEADER_TEXT .= join(" ",@in);
  215   }
  216 
  217 # TEXT is the function which defines text which will appear in the problem.
  218 # All text must be an argument to this function.  Any other statements
  219 #   are calculations (done in perl) which will not directly appear in the
  220 # output.  Think of this as the "print" function for the .pg language.
  221 # It can be used more than once in a file.
  222 
  223 =head2 TEXT()
  224 
  225   TEXT("string1", "string2", "string3");
  226 
  227 The C<TEXT()> function concatenates its arguments and places them in the output
  228 text string. C<TEXT()> is the function which defines text which will appear in the problem.
  229 All text must be an argument to this function.  Any other statements
  230 are calculations (done in perl) which will not directly appear in the
  231 output.  Think of this as the "print" function for the .pg language.
  232 It can be used more than once in a file.
  233 
  234 =cut
  235 
  236 sub TEXT {
  237   my @in = @_;
  238   $STRINGforOUTPUT .= join(" ",@in);
  239   }
  240 
  241 
  242 
  243 =head2 ANS()
  244 
  245   ANS(answer_evaluator1, answer_evaluator2, answer_evaluator3,...)
  246 
  247 Places the answer evaluators in the unlabeled answer_evaluator queue.  They will be paired
  248 with unlabeled answer rules (answer entry blanks) in the order entered.  This is the standard
  249 method for entering answers.
  250 
  251   LABELED_ANS(answer_evaluater_name1, answer_evaluator1, answer_evaluater_name2,answer_evaluator2,...)
  252 
  253 Places the answer evaluators in the labeled answer_evaluator hash.  This allows pairing of
  254 labeled answer evaluators and labeled answer rules which may not have been entered in the same
  255 order.
  256 
  257 =cut
  258 
  259 sub ANS{             # store answer evaluators which have not been explicitly labeled
  260   my @in = @_;
  261   while (@in ) {
  262          warn("<BR><B>Error in ANS:$in[0]</B> -- inputs must be references to
  263                       subroutines<BR>")
  264       unless ref($in[0]);
  265       push(@PG_ANSWERS, shift @in );
  266       }
  267 }
  268 sub LABELED_ANS {  #a better alias for NAMED_ANS
  269   &NAMED_ANS;
  270 }
  271 
  272 sub NAMED_ANS{     # store answer evaluators which have been explicitly labeled (submitted in a hash)
  273   my @in = @_;
  274   while (@in ) {
  275     my $label = shift @in;
  276     $label = eval(q!$main::QUIZ_PREFIX.$label!);
  277     my $ans_eval = shift @in;
  278     TEXT("<BR><B>Error in NAMED_ANS:$in[0]</B>
  279           -- inputs must be references to subroutines<BR>")
  280       unless ref($ans_eval);
  281     $PG_ANSWERS_HASH{$label}= $ans_eval;
  282   }
  283 }
  284 sub RECORD_ANS_NAME {     # this maintains the order in which the answer rules are printed.
  285   my $label = shift;
  286   eval(q!push(@main::PG_ANSWER_ENTRY_ORDER, $label)!);
  287   $label;
  288 }
  289 
  290 sub NEW_ANS_NAME {        # this keeps track of the answers which are entered implicitly,
  291                           # rather than with a specific label
  292     my $number=shift;
  293     my $prefix = eval(q!$main::QUIZ_PREFIX.$main::ANSWER_PREFIX!);
  294     my $label = $prefix.$number;
  295     push(@PG_UNLABELED_ANSWERS,$label);
  296     $label;
  297 }
  298 sub ANS_NUM_TO_NAME {     # This converts a number to an answer label for use in
  299                           # radio button and check box answers. No new answer
  300                           # name is recorded.
  301     my $number=shift;
  302     my $label = eval(q!$main::QUIZ_PREFIX.$main::ANSWER_PREFIX!).$number;
  303     $label;
  304 }
  305 
  306 my $vecnum;
  307 
  308 sub RECORD_FORM_LABEL  {             # this stores form data (such as sticky answers), but does nothing more
  309                                      # 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.
  310   my $label   = shift;             # the label of the input box or textarea
  311     eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!); #put the labels into the hash to be caught later for recording purposes
  312     $label;
  313 }
  314 sub NEW_ANS_ARRAY_NAME {        # this keeps track of the answers which are entered implicitly,
  315                           # rather than with a specific label
  316     my $number=shift;
  317     $vecnum = 0;
  318     my $row = shift;
  319     my $col = shift;
  320 #   my $label = "ArRaY"."$number"."["."$vecnum".","."$row".","."$col"."]";
  321     my $label = "ArRaY"."$number"."__"."$vecnum".":"."$row".":"."$col"."__";
  322     push(@PG_UNLABELED_ANSWERS,$label);
  323     $label;
  324 }
  325 
  326 sub NEW_ANS_ARRAY_NAME_EXTENSION {        # this keeps track of the answers which are entered implicitly,
  327                           # rather than with a specific label
  328     my $number=shift;
  329     my $row = shift;
  330     my $col = shift;
  331     if( $row == 0 && $col == 0 ){
  332       $vecnum += 1;
  333     }
  334     #FIXME   change made to conform to HTML 4.01 standards.  "Name" attributes can only contain
  335     # alphanumeric characters,   _ : and .
  336     # Also need to make corresponding changes in PGmorematrixmacros.  grep for ArRaY.
  337     #my $label = "ArRaY"."$number"."["."$vecnum".","."$row".","."$col"."]";
  338     my $label = "ArRaY"."$number"."__"."$vecnum".":"."$row".":"."$col"."__";
  339     eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!);#put the labels into the hash to be caught later for recording purposes
  340     $label;
  341 }
  342 
  343 # ENDDOCUMENT must come at the end of every .pg file.
  344 #   It exports the resulting text of the problem, the text to be used in HTML header material
  345 #   (for javaScript), the list of answer evaluators and any other flags.  It can appear only once and
  346 #   it MUST be the last statement in the problem.
  347 
  348 =head2 ENDDOCUMENT()
  349 
  350 ENDDOCUMENT() must the last executable statement in any problem template.  It can
  351 only appear once.  It returns
  352 an array consisting of
  353 
  354   A reference to a string containing the rendered text of the problem.
  355   A reference to a string containing text to be placed in the header
  356                (for javaScript)
  357   A reference to the array containing the answer evaluators.
  358                (May be changed to a hash soon.)
  359   A reference to an associative array (hash) containing various flags.
  360 
  361   The following flags are set by ENDDOCUMENT:
  362   (1) showPartialCorrectAnswers  -- determines whether students are told which
  363       of their answers in a problem are wrong.
  364   (2) recordSubmittedAnswers  -- determines whether students submitted answers
  365       are saved.
  366   (3) refreshCachedImages  -- determines whether the cached image of the problem
  367       in typeset mode is always refreshed (i.e. setting this to 1 means cached
  368       images are not used).
  369   (4) solutionExits   -- indicates the existence of a solution.
  370   (5) hintExits   -- indicates the existence of a hint.
  371   (6) showHintLimit -- determines the number of attempts after which hint(s) will be shown
  372 
  373   (7) PROBLEM_GRADER_TO_USE -- chooses the problem grader to be used in this order
  374     (a) A problem grader specified by the problem using:
  375         install_problem_grader(\&grader);
  376     (b) One of the standard problem graders defined in PGanswermacros.pl when set to
  377         'std_problem_grader' or 'avg_problem_grader' by the environment variable
  378         $PG_environment{PROBLEM_GRADER_TO_USE}
  379     (c) A subroutine referenced by $PG_environment{PROBLEM_GRADER_TO_USE}
  380     (d) The default &std_problem_grader defined in PGanswermacros.pl
  381 
  382 
  383 =cut
  384 
  385 sub ENDDOCUMENT {
  386 
  387     my $index=0;
  388     foreach my $label (@PG_UNLABELED_ANSWERS) {
  389         if ( defined($PG_ANSWERS[$index]) ) {
  390         $PG_ANSWERS_HASH{"$label"}= $PG_ANSWERS[$index];
  391       #warn "recording answer label = $label";
  392       } else {
  393         warn "No answer provided by instructor for answer $label";
  394       }
  395       $index++;
  396     }
  397 
  398     $STRINGforOUTPUT .="\n";
  399    eval q{  #make sure that "main" points to the current safe compartment by evaluating these lines.
  400     $main::PG_FLAGS{'showPartialCorrectAnswers'} = $main::showPartialCorrectAnswers;
  401     $main::PG_FLAGS{'recordSubmittedAnswers'} = $main::recordSubmittedAnswers;
  402     $main::PG_FLAGS{'refreshCachedImages'} = $main::refreshCachedImages;
  403     $main::PG_FLAGS{'hintExists'} = $main::hintExists;
  404     $main::PG_FLAGS{'showHintLimit'} = $main::showHint;
  405     $main::PG_FLAGS{'solutionExists'} = $main::solutionExists;
  406     $main::PG_FLAGS{ANSWER_ENTRY_ORDER} = \@main::PG_ANSWER_ENTRY_ORDER;
  407     $main::PG_FLAGS{KEPT_EXTRA_ANSWERS} = \@main::KEPT_EXTRA_ANSWERS;##need to keep array labels that don't call "RECORD_ANS_NAME"
  408     $main::PG_FLAGS{ANSWER_PREFIX} = $main::ANSWER_PREFIX;
  409     # install problem grader
  410     if (defined($main::PG_FLAGS{PROBLEM_GRADER_TO_USE}) ) {
  411       # problem grader defined within problem -- no further action needed
  412     } elsif ( defined( $main::envir{PROBLEM_GRADER_TO_USE} ) ) {
  413       if (ref($main::envir{PROBLEM_GRADER_TO_USE}) eq 'CODE' ) {         # user defined grader
  414         $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = $main::envir{PROBLEM_GRADER_TO_USE};
  415       } elsif ($main::envir{PROBLEM_GRADER_TO_USE} eq 'std_problem_grader' ) {
  416         if (defined(&std_problem_grader) ){
  417           $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl
  418         } # std_problem_grader is the default in any case so don't give a warning.
  419       } elsif ($main::envir{PROBLEM_GRADER_TO_USE} eq 'avg_problem_grader' ) {
  420         if (defined(&avg_problem_grader) ){
  421           $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = \&avg_problem_grader; # defined in PGanswermacros.pl
  422         }
  423         #else { # avg_problem_grader will be installed by PGtranslator so there is no need for a warning.
  424         # warn "The problem grader 'avg_problem_grader' has not been defined.  Has PGanswermacros.pl been loaded?";
  425         #}
  426       } else {
  427         warn "Error:  $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} is not a known program grader.";
  428       }
  429     } elsif (defined(&std_problem_grader)) {
  430       $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl
  431     } else {
  432       # PGtranslator will install its default problem grader
  433     }
  434 
  435     warn "ERROR: The problem grader is not a subroutine" unless ref( $main::PG_FLAGS{PROBLEM_GRADER_TO_USE}) eq 'CODE'
  436                      or $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = 'std_problem_grader'
  437                      or $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = 'avg_problem_grader';
  438      # return results
  439     };
  440 
  441     $STRINGforOUTPUT .= '<SCRIPT> jsMath.ProcessBeforeShowing() </SCRIPT>'
  442       if ($main::envir{displayMode} eq 'HTML_jsMath');
  443 
  444     if ($main::envir{displayMode} eq 'HTML_asciimath') {
  445       $STRINGforOUTPUT .= '<SCRIPT> translate() </SCRIPT>';
  446       $STRINGforHEADER_TEXT .=
  447         '<object id="mathplayer" classid="clsid:32F66A20-7614-11D4-BD11-00104BD3F987">' . "\n" .
  448         '</object><?import namespace="mml" implementation="#mathplayer"?>'
  449   unless ($STRINGforHEADER_TEXT =~ m/mathplayer/);
  450     }
  451 
  452   (\$STRINGforOUTPUT, \$STRINGforHEADER_TEXT,\%PG_ANSWERS_HASH,eval(q!\%main::PG_FLAGS!));
  453 }
  454 
  455 
  456 
  457 =head2 INITIALIZE_PG()
  458 
  459 This is executed each C<DOCUMENT()> is called.  For backward compatibility
  460 C<loadMacros> also checks whether the C<macroDirectory> has been defined
  461 and if not, it runs C<INITIALIZE_PG()> and issues a warning.
  462 
  463 =cut
  464 
  465 
  466 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9