[system] / trunk / webwork / system / cgi / cgi-scripts / processProblem8.pl Repository:
ViewVC logotype

View of /trunk/webwork/system/cgi/cgi-scripts/processProblem8.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 131 - (download) (as text) (annotate)
Tue Aug 14 20:25:40 2001 UTC (18 years, 5 months ago) by apizer
File size: 63330 byte(s)
Modified lines 505-10 so that when a problem is viewed for the first time,
process_answers from PGtranslator.pm is still run with empty imput.  This
means that the correct mesages from problem graders will be displayed (and
erroneous error messages will not be displayed) the first time a problem
is viewed.

    1 #!/usr/local/bin/webwork-perl
    2 
    3 # This file is processProblem8.pl
    4 # This is a special version of processProblem.pl
    5 # made to be used as an editor
    6 
    7 # It is called from a form with inputs
    8 # 'user',
    9 # 'key'
   10 # 'course'
   11 # 'probSetKey' and
   12 # 'probNum'
   13 # and in addition
   14 # 'Mode'   (for either TeX mode or HTML mode or Latex2HTML mode)
   15 # 'show_old_answers'  (whether or not student's old answers should be filled in)
   16 # 'ShowAns'  (asks for answer to be shown -- only available for instructors)
   17 # 'answer$i'  (the answers -- if any --provided to the questions)
   18 # 'showEdit'  (checks if the ShowEditor button should be shown and clicked)
   19 # 'showSol'   (checks if the solution button ishould be shown and clicked)
   20 # as well as
   21 # 'source' when an edited source is provided by a web based editor
   22 # 'seed'   when a new seed is provided by a web based editor
   23 # 'readSourceFromHTMLQ'
   24 # 'action' which can be 'Save updated version' or 'Read problem from disk' or
   25 #    'Submit Answers' or 'Preview Answers' or 'Preview Again'
   26 # 'probFileName'
   27 # 'languageType'
   28 
   29 use strict;
   30 use lib '.'; use webworkInit; # WeBWorKInitLine
   31 
   32 use CGI qw(:standard);
   33 use Net::SMTP;
   34 use Global;
   35 use Auth;
   36 use Safe;
   37 use MIME::Base64 qw( encode_base64 decode_base64) ;
   38 use PGtranslator;
   39 BEGIN {
   40   # set to 1 to enable timing_log
   41   # (contains debugging info about time taken by scripts to run)
   42   $main::logTimingData = 1;
   43 
   44   # begin Timing code
   45   if( $main::logTimingData == 1 ) {
   46     use Benchmark;
   47     $main::beginTime = new Benchmark;
   48   }
   49   # end Timing code
   50 
   51   $main::TIME_OUT_CONSTANT = 60;                   # one minute wait for on screen problems
   52   $SIG{'TERM'} = sub {die '[',scalar(localtime),"] Caught a SIGTERM, Error: $!   stopped at $0\n";};
   53   $SIG{'PIPE'} = sub {$main::SIGPIPE = 1, die '[',scalar(localtime),"] Caught a SIGPIPE, Error: $!   stopped at $0\n";  };
   54   $SIG{ALRM} = sub { $main::SIG_TIME_OUT = 1; exit(0) };
   55 
   56 # ## ATTENTION:  The handlers PG_floating_point_exception_handler and PG_warnings_handler
   57 # ## have to be installed after CGI::Carp is called since it also
   58 # ## modifes the die and warn labels. Finding the right warning mechanism using these two
   59 # ## methods bears further investigation
   60 # ## They are defined in Global.pm
   61    $SIG{'FPE'}  = \&Global::PG_floating_point_exception_handler;
   62    $SIG{__WARN__}=\&Global::PG_warnings_handler;
   63 
   64    alarm($main::TIME_OUT_CONSTANT);
   65 
   66 };
   67 
   68 
   69 
   70 use vars qw ( $questionNumber $STRINGforOUTPUT $languageMode  $ansCount $openDate $cgiURL
   71   $studentName $pinNumber $submittedAnswers $setNumber $answerDate $dueDate $studentLogin
   72   $problemValue $safeCompartment $psvnNumber $fileName
   73   $probNum $sectionName  $sectionNumber $recitationName $recitationNumber $sessionKey
   74   $courseName $modules_to_evaluate $extra_packages_to_be_loaded
   75   );
   76 
   77 eval {
   78 
   79 # This hardwires access to these modules/objects.
   80 
   81 
   82 ################################################
   83 
   84 #switched to object-oriented interface with CGI
   85 #DME 6/15/2000
   86 my $cgi = new CGI;
   87 
   88 if( $CGI::VERSION < 2.5 ) {
   89   die "This version of WeBWorK requires at least version 2.50 of the CGI.pm library";
   90 }
   91 my %inputs = $cgi -> Vars();
   92 
   93 
   94 # get information from CGI inputs  (see also below for additional information)
   95   my $Course    = $inputs{'course'};
   96   my $User    = $inputs{'user'};
   97   # define these for the timingLogInfo
   98   $main::Course   = $Course;
   99   $main::User   = $User;
  100   $main::Action     = $inputs{'action'};
  101 
  102 
  103   my $Session_key     = $inputs{'key'};
  104   my $randpsvn      = 22222; #int rand(1111,9999);
  105   my $psvn        = $inputs{'probSetKey'};  #psvn stands for Problem Set Version Number
  106   my $probNum       = 1;
  107      $probNum       = $inputs{'probNum'} if defined($inputs{'probNum'});
  108   my $nextProbNum     = $probNum +1 if defined($probNum);
  109   my $previousProbNum   = $probNum -1 if defined($probNum);
  110   my $mode        = "HTML";
  111        $mode        = $inputs{'Mode'} if defined( $inputs{'Mode'} );
  112        $main::display_mode  = $mode;  # this is only used for the timing messages.
  113     my $showEdit      = $inputs{'showEdit'};
  114     my $show_old_answers  = 0;
  115      $show_old_answers  = $inputs{'show_old_answers'} if defined($inputs{'show_old_answers'});
  116 
  117 # verify that information has been received
  118   unless($Course && $User && $Session_key && $psvn) {
  119       my $error_msg = $cgi -> remote_host() . '   ' .
  120         $cgi -> user_agent() . '   ' . $cgi -> query_string();
  121         &wwerror("$0, missing data",
  122           "The script did not receive the proper input data.
  123           Course is $Course, user is $User, session key is $Session_key, psvn is $psvn",'','',$error_msg
  124     );
  125   }
  126 
  127 
  128 # establish environment for this script
  129   &Global::getCourseEnvironment($Course);
  130   my $macroDirectory      = getCourseMacroDirectory();
  131   my $databaseDirectory     = getCourseDatabaseDirectory();
  132   my $htmlDirectory         = getCourseHtmlDirectory();
  133   my $htmlURL               = getCourseHtmlURL();
  134   my $scriptDirectory       = getWebworkScriptDirectory();
  135   my $templateDirectory     = getCourseTemplateDirectory();
  136     my $courseScriptsDirectory  = getCourseScriptsDirectory();
  137 
  138 
  139 
  140     require "${courseScriptsDirectory}$Global::displayMacros_pl";
  141   require "${scriptDirectory}$Global::DBglue_pl";
  142   require "${scriptDirectory}$Global::classlist_DBglue_pl";
  143   require "${scriptDirectory}$Global::HTMLglue_pl";
  144   require "${scriptDirectory}$Global::FILE_pl";
  145 
  146   my $permissionsFile = &Global::getCoursePermissionsFile($Course);
  147   my $permissions   = &get_permissions($User,$permissionsFile);
  148   my $keyFile     = &Global::getCourseKeyFile($Course);
  149 
  150 ####################################################################
  151 # load the modules to be used in PGtranslator
  152   require "${courseScriptsDirectory}PG_module_list.pl" or
  153     wwerror($0, "Can't read ${courseScriptsDirectory}PG_module_list.pl");
  154 ####################################################################
  155 
  156 # log access
  157   &Global::log_info('', $cgi -> query_string);
  158 
  159 unless ($User eq "practice666" ) {
  160   #verify session key
  161     &verify_key($User, $Session_key, "$keyFile", $Course, \%inputs);
  162 }
  163 
  164 
  165 ##right now $probNum cannot possibly be "", because its default is 1
  166 ##is that how it should be?
  167 ###Should problemBank2 be substituted by some Global variable???###
  168   if($probNum eq "" && ($Course ne "problemBank2") )
  169     {
  170     &selectionError;
  171     die "Content-type: text/html\n\n ERROR: in $Global::processProblem_CGI near &selectionError";
  172     }
  173 
  174 
  175 # get the rest of the information from the CGI script
  176     # get language type
  177     my $displayMode = defined($inputs{'languageType'}) ?$inputs{'languageType'}:'pg';
  178 
  179     # get answers
  180 
  181     # Decide whether answers have been submitted.
  182     my $answers_submitted =0;
  183     $answers_submitted = 1 if defined($inputs{answer_form_submitted}) and 1 == $inputs{answer_form_submitted};
  184 
  185     # Decide whether preview_mode has been selected
  186     my $preview_mode =0;
  187     $preview_mode = 1 if defined($inputs{'action'}) and
  188       (( $inputs{'action'} =~ /Preview Answer/ ) or ( $inputs{'action'} =~ /Preview Again/ ));
  189 
  190 
  191     my $answersRequestedQ = 0;
  192   $answersRequestedQ=  $inputs{'ShowAns'} if defined($inputs{'ShowAns'});
  193 
  194   my $solutionsRequestedQ= 0;
  195     $solutionsRequestedQ= $inputs{'ShowSol'} if defined($inputs{'ShowSol'});
  196 
  197   my $hintsRequestedQ= 0;
  198     $hintsRequestedQ= $inputs{'ShowHint'} if defined($inputs{'ShowHint'});
  199 
  200     my $doNotRecordAnsRequestedQ= 0;
  201     $doNotRecordAnsRequestedQ= $inputs{'doNotRecordAns'} if defined($inputs{'doNotRecordAns'});
  202 
  203 
  204 #
  205 # # cache information about the problem set (from the webwork-database)
  206 # and begin constructing the environment for constructing and displaying the problem
  207   &attachProbSetRecord($psvn);
  208 
  209 
  210 # Get information from database
  211   my  ($currentTime,$odts,$ddts,$adts);
  212   $currentTime  = time;
  213   $odts     = &getOpenDate($psvn);
  214   $ddts     = &getDueDate($psvn);
  215   $adts     = &getAnswerDate($psvn);
  216 
  217 
  218   my  ($setNumber,$numberOfProblems);
  219   $setNumber      = &getSetNumber($psvn);
  220   $numberOfProblems     = &getAllProblemsForProbSetRecord($psvn);
  221 
  222 
  223 # If answers have not been submitted and previous answers have been saved, patch them in
  224 # unless $show_old_answers = 0
  225 
  226   unless ($answers_submitted or !$show_old_answers) {
  227     my $student_answers = getProblemStudentAnswer($probNum,$psvn);
  228     if (defined $student_answers) {
  229       my $rh_answer_hash =  decode_submitted_answers($student_answers);
  230       my %answer_hash = %$rh_answer_hash;
  231       my ($label, $value);
  232       foreach $label (keys %answer_hash) {$inputs{$label} = $answer_hash{$label};}
  233     }
  234   }
  235 
  236 
  237 # Determine language from the file extension(e.g.  file.pg  or file.pz)
  238     $displayMode  = &getProblemFileName($probNum,$psvn);
  239   $displayMode   = $inputs{'probFileName'} if defined($inputs{'probFileName'});
  240 
  241   $displayMode  =~ s/^.*\.([^\.]*)$/$1/;
  242 
  243 
  244 # get problem name
  245   my $probFileName      =  &getProblemFileName($probNum,$psvn);
  246      $probFileName  =  $inputs{'probFileName'} if defined($inputs{'probFileName'});
  247 
  248 # determine time status.
  249 
  250 # check that the psvn corresponds to the user and that it is after the open
  251 # date.  This should only fail if someone is trying to break into WeBWorK.
  252 
  253 
  254     if ( ( ( $User ne &getStudentLogin($psvn)) ||($currentTime < $odts) )
  255             and ($permissions != $Global::instructor_permissions)
  256                 and   ($permissions != $Global::TA_permissions)
  257         )   {
  258     &hackerError;
  259     exit;
  260   }
  261 
  262 
  263 
  264 ## check to see if it is after due + answer date, if so, put note by
  265 ## submit answer button (below)
  266   my $dueDateNote = "";
  267   my $answerNote  = "";
  268 
  269   if($currentTime>$ddts)
  270     {$dueDateNote=" <EM>Note: it is after the due date.</EM>\n";}
  271   if($currentTime>$adts)
  272     {$answerNote= " <EM>Answers available.</EM>\n";}
  273 
  274 # determine display defaults
  275   my ($displayCorrectAnswersQ,$displayShowAnswerLineQ);
  276 
  277   $displayShowAnswerLineQ = ($permissions == $Global::instructor_permissions) || ($currentTime > $adts) ;
  278   $displayCorrectAnswersQ = 1 if  $answersRequestedQ && ($currentTime > $adts);
  279   $displayCorrectAnswersQ = 1 if $answersRequestedQ && ($permissions == $Global::instructor_permissions);
  280 
  281 
  282   my $displaySolutionsQ = 0;
  283   $displaySolutionsQ  = 1 if  $solutionsRequestedQ && ($currentTime > $adts);
  284   $displaySolutionsQ  = 1 if $solutionsRequestedQ && ($permissions == $Global::instructor_permissions);
  285 
  286   my $displayHintsQ = 0;
  287   $displayHintsQ  = 1 if  $hintsRequestedQ;
  288 
  289 #check if we need to save the updated version of the text
  290 my $problem_has_been_saved = '';
  291 if ( defined($inputs{'action'}) &&
  292      ( $inputs{'action'} eq 'Save updated version' ) &&
  293      ($permissions == $Global::instructor_permissions) &&
  294      defined($inputs{'source'})  ) {
  295     my $temp_source = decodeSource($inputs{'source'});
  296     $temp_source=~ s/\r\n/\n/g;
  297   #$temp_source = $cgi -> unescape( $temp_source );
  298   saveProblem($temp_source, $probFileName);
  299   $problem_has_been_saved = "<H4>Current version of the problem ${templateDirectory}$probFileName has been saved.</H4>
  300     <b>The original version has been appended to the file ${templateDirectory}$probFileName.bak . </b><BR>";
  301 
  302   undef($inputs{'source'});   # make sure that we read input from the saved version
  303 }
  304 
  305 #check if we need to save the updated version of the text as a new problem
  306 
  307 if ( defined($inputs{'action'}) &&
  308      ( $inputs{'action'} eq 'Save as' ) &&
  309      ($permissions == $Global::instructor_permissions) &&
  310      defined($inputs{'source'})  ) {
  311     my $temp_source = decodeSource( $inputs{'source'} );
  312 
  313     $temp_source=~ s/\r\n/\n/g;
  314   #$temp_source = $cgi -> unescape( $temp_source );
  315     my $new_file_name = $inputs{'new file name'};
  316   saveNewProblem($temp_source, $new_file_name);
  317   $problem_has_been_saved = "<H4>The file ${templateDirectory}$new_file_name  has been saved.</H4>
  318     <b>The new problem must be added to the set definition file and the set must be rebuilt before the new problem
  319     will be displayed as part of the regular set.</b><BR>";
  320 }
  321 
  322 
  323 # get the text source of the problem
  324 
  325 # first determine whether to load the source (and seed) from the calling HTML form or from the disk
  326  my $readSourceFromHTMLQ =0;
  327  $readSourceFromHTMLQ = 1 if (                            # load source from HTML if these conditions are met:
  328                             ($permissions == $Global::instructor_permissions ||   # only instructors can modify the source
  329                              ($User eq "practice666" )) &&              # practice666 can generate source
  330               defined($inputs{'source'})  &&              # there is a source field in the form
  331               defined($inputs{'seed'})    &&              # you need a seed field as well
  332               defined($inputs{'readSourceFromHTMLQ'}) &&
  333               $inputs{'readSourceFromHTMLQ'} == 1           # and the calling form asks that its source be read
  334               );
  335 
  336  # Over ride button forces reading the source from the disk.
  337    if (defined($inputs{'action'}) and $inputs{'action'} eq 'Read problem from disk') {
  338      $readSourceFromHTMLQ = 0;
  339      $inputs{refreshLatex2HTML} = 1;   # force the Latex2HTML rendering to be redone
  340    }
  341 
  342  # Determine whether to insert the source into the outgoing form.
  343  my $insertSourceIntoFormQ = 0;
  344  $insertSourceIntoFormQ = 1 if (                            # insert the source field into forms only if these conditions are met:
  345               ($permissions == $Global::instructor_permissions) ||    # only instructors can modify the source
  346                  ($User eq "practice666" )                          # practice666 can also
  347               );
  348 
  349 # Now lets get the source and the seed.
  350     my $source;
  351     my $seed;
  352     if ( $readSourceFromHTMLQ  )  {
  353 #   $source = $inputs{'source'};
  354     $source = decodeSource($inputs{'source'});
  355 #     if ( defined($inputs{'source_encoded_using'}) ) {  # the source has been encoded and we need to decode it first
  356 #       if ( $inputs{'source_encoded_using'} eq 'base64_encode' )  {
  357 #         $source = decode_base64($source);
  358 #       }
  359 #       elsif ( $inputs{'source_encoded_using'} eq 'cgi_escape' ) {
  360 #         $source = $cgi -> unescape($source);
  361 #       }
  362 #       elsif ( $inputs{'source_encoded_using'} eq 'none'  )    {
  363 #         # no action needed
  364 #
  365 #       }
  366 #       elsif ( $inputs{'source_encoded_using'} eq 'escaped_returns'  )    {
  367 #         $source =~s/&#010;/\n/g;  warn "uncoding escaped returns";
  368 #         $source =~s/\r\n/\n/g;
  369 #       }
  370 #       else {
  371 #         warn "Did not recognize the source encoding method $inputs{'source_encoded_using'}";
  372 #       }
  373 #      }
  374       ##substitute carriage return with a newline
  375       ##otherwise EndOfText construction does not work
  376       ##browsers always have \r\n at the end of the line
  377         $source=~ s/\r\n/\n/g;
  378 
  379         # get seed from the appropriate place
  380         $seed = $inputs{'seed'};
  381     }
  382   elsif ($probFileName eq '') {
  383     $probFileName = "New File";
  384     $source = '';
  385     $seed ="11111";  # perhaps we can pick a better initial value for the seed.
  386   }
  387   else {
  388     if (-e "${templateDirectory}$probFileName" ) {
  389       #print "|$probFileName|<BR>";
  390       unless (-r "${templateDirectory}$probFileName") {
  391         wwerror($0, "Can't read ${templateDirectory}$probFileName");
  392       }
  393       open(PROB,"<${templateDirectory}$probFileName");
  394       $source = join('',<PROB>);
  395       close(PROB);
  396     }
  397     else {
  398       wwerror($0, "<H4>Error: The problem ${templateDirectory}$probFileName could not be found!</H4>");
  399     }
  400       $seed = &getProblemSeed($probNum, $psvn);
  401   }
  402 
  403 ##################################################
  404 # begin processing problem
  405 ##################################################
  406 
  407 
  408   my %envir=defineProblemEnvir($mode,$probNum,$psvn,$Course);
  409   #print %envir;    #DEBUG
  410   ##Need to check what language is used here
  411   #this comes from createDisplayedProblem in displayMacros
  412   my @printlines;
  413 
  414   #this is no longer used     DME 6/15/2000
  415   #my $refSubmittedAnswers=$envir{'refSubmittedAnswers'};
  416 
  417   # require "${courseScriptsDirectory}PG_module_list.pl";
  418   # (Modules are defined by this require statement found near the top of this file, outside the loop.)
  419   my $pt = new PGtranslator;  #pt stands for problem translator;
  420   $pt -> evaluate_modules( @{main::modules_to_evaluate});
  421   $pt -> load_extra_packages(@{main::extra_packages_to_be_loaded});
  422   # The variables in the two preceding lines are  defined in PG_module_list.pl at Indiana.
  423   $pt ->  environment(\%envir);
  424   $pt ->  initialize();
  425   $pt ->  set_mask();
  426   $pt ->  source_string($source);
  427     $pt ->  unrestricted_load("${courseScriptsDirectory}PG.pl");
  428     $pt ->  unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl");
  429     $pt ->  rf_safety_filter( \&safetyFilter);   # install blank safety filter
  430     $pt ->  translate();
  431 
  432   # dereference some flags returned by createPGtext;
  433         if ( defined( $pt ->rh_flags ) ) {
  434           $main::showPartialCorrectAnswers = $pt ->rh_flags->{'showPartialCorrectAnswers'};
  435           $main::recordSubmittedAnswers = $pt ->rh_flags->{'recordSubmittedAnswers'};
  436         }
  437 
  438   # massage problem text if necessary.
  439   if($mode eq "HTML" || $mode eq 'HTML_tth' || $pt ->rh_flags->{'error_flag'}) {
  440     @printlines=@{ $pt->ra_text() };
  441   }
  442   elsif ($mode eq 'Latex2HTML') {
  443       my %PG_flags = %{ $pt->rh_flags() };
  444       $PG_flags{'refreshLatex2HTML'} = $inputs{'refreshLatex2HTML'};
  445       $PG_flags{'refreshLatex2HTML'} = 1 if $displaySolutionsQ;
  446       $PG_flags{'refreshLatex2HTML'} = 1 if $displayHintsQ;
  447     @printlines = &createDisplayedProblem($setNumber,$probNum,$psvn,$pt->ra_text(),\%PG_flags );
  448 
  449     @printlines = &l2h_sticky_answers($envir{'inputs_ref'}, \@printlines, $pt->rh_flags() );
  450 
  451 #   @printlines = &l2h_update_keys($envir{'sessionKey'}, \@printlines);
  452     } elsif ($mode eq "TeX") {   #TEMPORARY KLUDGE
  453       @printlines = @{$pt->ra_text() };
  454 
  455   } else {
  456       @printlines="$0: Error:  Mode |$mode| is not HTML, HTML_tth or Latex2HTML.";
  457     }
  458 
  459 
  460 
  461 # Determine the problem_state
  462 
  463 
  464 # Determine the recorded score
  465   my $recorded_score = getProblemStatus($probNum, $psvn);
  466 
  467 
  468 # Initialize the variables reporting the answers
  469   my $rh_answer_results = {};
  470   my $rh_problem_result = {};
  471   my $rh_problem_state = {};
  472   my $record_problem_message = '';
  473   my $answer_line_text = '';
  474   my $preview_text = '';
  475   my $expected_answer_count = keys( %{ $pt -> rh_correct_answers() } ); # count the number of correct answers
  476 
  477 # Determine which problem grader to use
  478   #$pt->rf_problem_grader($pt->rf_std_problem_grader);  #this is the default
  479     my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE};
  480 
  481     if ( defined($problem_grader_to_use) and $problem_grader_to_use   ) {  # if defined and non-empty
  482       if ($problem_grader_to_use eq 'std_problem_grader') {
  483         # Reset problem grader to standard problem grader.
  484         $pt->rf_problem_grader($pt->rf_std_problem_grader);
  485       }
  486     elsif ($problem_grader_to_use eq 'avg_problem_grader') {
  487         # Reset problem grader to average problem grader.
  488             $pt->rf_problem_grader($pt->rf_avg_problem_grader);
  489       }
  490     elsif (ref($problem_grader_to_use) eq 'CODE') {
  491           # Set problem grader to instructor defined problem grader -- use cautiously.
  492         $pt->rf_problem_grader($problem_grader_to_use)
  493       }
  494     else {
  495           warn "Error:  Could not understand problem grader flag $problem_grader_to_use";
  496         #this is the default set by the translator and used if the flag is not understood
  497         #$pt->rf_problem_grader($pt->rf_std_problem_grader);
  498       }
  499 
  500     }
  501   else {#this is the default set by the translator and used if no flag is set.
  502       #$pt->rf_problem_grader($pt->rf_std_problem_grader);   }
  503     }
  504 
  505 # creates and stores a hash of answer results: $rh_answer_results
  506   if  ($answers_submitted == 1) {
  507     $pt -> process_answers(\%inputs);
  508   }
  509   else {
  510     $pt -> process_answers({});   ## pass a ref to an empty hash to process_answers
  511                     ## so that problem graders messages will be
  512                     ## output even when looking at a problem the
  513                     ## first time
  514   }
  515       ####################################################################
  516       # If preview mode has been selected, build the preview page and exit
  517       ####################################################################
  518 
  519     if  (($preview_mode ==1) and ($answers_submitted ==1)) {
  520 
  521     my $ra_answer_entry_order = ( defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ?
  522                         $pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
  523 
  524     $preview_text = preview_answers(
  525                                         $pt->rh_evaluated_answers,
  526                                         $rh_problem_result,
  527                                          {
  528                                           ANSWER_ENTRY_ORDER      => $ra_answer_entry_order,
  529                                           ANSWER_PREFIX               => ($pt->{PG_FLAGS_REF}->{ANSWER_PREFIX}) ? $pt->{PG_FLAGS_REF}->{ANSWER_PREFIX} :'AnSwEr'
  530 
  531                                          }
  532                                         );
  533     build_preview_page();
  534     exit(0);
  535   }
  536 
  537 
  538 
  539       ####################################################################
  540       # set the problem state.
  541       # Record the grade and report the answer results
  542       ####################################################################
  543 
  544 
  545     $pt->rh_problem_state({ recorded_score      => $recorded_score ,
  546                 num_of_correct_ans    => &getProblemNumOfCorrectAns($probNum,$psvn) ,
  547                 num_of_incorrect_ans  => &getProblemNumOfIncorrectAns($probNum,$psvn)
  548               } );
  549 
  550     my $ra_answer_entry_order = ( defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ?
  551                         $pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
  552 
  553     ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted,
  554                                                                  ANSWER_ENTRY_ORDER => $ra_answer_entry_order
  555                                                                );       # grades the problem.
  556 # If there was a syntax error, do not report partial correct answers:
  557    $main::showPartialCorrectAnswers = 0 if defined($rh_problem_result->{show_partial_correct_answers})
  558                                            and  $rh_problem_result->{show_partial_correct_answers} == 0;
  559 
  560   if  ($answers_submitted == 1) {
  561 
  562     # Store the answers an an encoded form in the database
  563 
  564     my $saved_submitted_answers_string = encode_submitted_answers($ra_answer_entry_order);
  565 
  566 
  567 
  568     # If an answer form has been submitted format answer message,
  569       # record problem status and format the record_problem_message
  570       # check if before due date and number of incorrect attempts is
  571       # below limit (if any). If so, record answer
  572 
  573     $record_problem_message = '';
  574     my $attemptsRemaining =  getProblemMaxNumOfIncorrectAttemps($probNum,$psvn)
  575                            - getProblemNumOfCorrectAns($probNum,$psvn)
  576                            - getProblemNumOfIncorrectAns($probNum,$psvn);
  577 
  578     ## Professors and TA's are allowed to submit answers without results being recorded
  579     my $doNotRecordAnswers = 0;
  580     if (($permissions == $Global::instructor_permissions) or ($permissions == $Global::TA_permissions)) {
  581       $doNotRecordAnswers = 1 if $doNotRecordAnsRequestedQ;
  582     }
  583 
  584       if ( (not $doNotRecordAnswers) and ($currentTime<=$ddts) and
  585           ( ( getProblemMaxNumOfIncorrectAttemps($probNum,$psvn) < 0 ) or ( $attemptsRemaining >= 1 )) ) {
  586       &save_problem_state($saved_submitted_answers_string,$rh_problem_state,$probNum,$inputs{'user'},$psvn);
  587     }
  588     else {
  589       if ($doNotRecordAnswers){
  590         $record_problem_message = "<STRONG>Note: Answer not recorded.</STRONG><BR>";
  591       }
  592       elsif ($currentTime>$ddts){
  593         $record_problem_message = "<STRONG>Note: Answer not recorded - it is after the due date.</STRONG><BR>";
  594       }
  595       else {
  596         $record_problem_message = "<STRONG>Note: Answer not recorded - You have already attempted this problem the maximum allowed number of times.</STRONG><BR>";
  597       }
  598     }
  599       ####################################################################
  600       #  Format the answer section of the displayed problem
  601       ####################################################################
  602     my $ra_answer_entry_order = ( defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ?
  603                         $pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
  604 
  605     $answer_line_text = display_answers(
  606                                         $pt->rh_evaluated_answers,
  607                                         $rh_problem_result,
  608                                          {  displayCorrectAnswersQ    => $displayCorrectAnswersQ,
  609                                           showPartialCorrectAnswers   => $main::showPartialCorrectAnswers,
  610                                           ANSWER_ENTRY_ORDER      => $ra_answer_entry_order,
  611                                           ANSWER_PREFIX               => ($pt->{PG_FLAGS_REF}->{ANSWER_PREFIX}) ? $pt->{PG_FLAGS_REF}->{ANSWER_PREFIX} :'AnSwEr'
  612                                          }
  613                                         );
  614 
  615 
  616 
  617 
  618 
  619 }
  620 
  621 
  622       ####################################################################
  623       ###         format problem status message     ###
  624       ####################################################################
  625 my $status = getProblemStatus($probNum,$psvn);
  626 my $attempted = getProblemAttempted($probNum,$psvn);
  627 
  628 my $problemStatusMessage = '';
  629 if ( !$attempted) {
  630   $problemStatusMessage   = "Our records show problem $probNum of set $setNumber has not been attempted.";  # default value
  631 }
  632 elsif ($status >= 0 and $status <=1)  {
  633     my $percentCorr = int(100*$status+.5);
  634     my $problemValue = &getProblemValue($probNum,$psvn);
  635     my $score = round_score($status*$problemValue);
  636     my $pts = 'points';
  637     if ($score == 1) {$pts = 'point';}
  638   $problemStatusMessage     = "Our records show problem $probNum of set $setNumber has a score of ${percentCorr}\%  ($score $pts).";
  639 }
  640 else {
  641   $problemStatusMessage   = "Our records show problem $probNum of set $setNumber has an unknown status.";
  642 }
  643 ########## end format problem status message #######
  644 
  645 ##########################################################
  646 ###### format messages about number of attempts remaining.
  647 ##########################################################
  648   my  $maxNumOfIncorrectAttempts  = &getProblemMaxNumOfIncorrectAttemps($probNum,$psvn);
  649   my  $numOfCorrectAns    = &getProblemNumOfCorrectAns($probNum,$psvn);
  650   my  $numOfIncorrectAns    = &getProblemNumOfIncorrectAns($probNum,$psvn);
  651   my  $numOfAttempts    = $numOfCorrectAns + $numOfIncorrectAns;
  652   my  $maxAttemptNote   = "";
  653   my  $attemptsRemaining = $maxNumOfIncorrectAttempts -$numOfAttempts;
  654 
  655 
  656 #
  657 
  658 
  659 
  660 #################################################
  661 #  begin printing the HTML text     #
  662 #################################################
  663     my $Edited = '';
  664     my $bg_color = undef;
  665     $bg_color = $Global::bg_color if  $Global::WARNINGS   ;
  666   $Edited = "EDITED " if $readSourceFromHTMLQ;
  667   $Edited = "NEW FILE " if (defined($inputs{'action'}) and ($inputs{'action'} eq 'Save as'));
  668   print &processProblem_htmlTOP("${Edited}Problem $probNum",
  669                                   ${ $pt->r_header },
  670                                  $bg_color    # background color
  671                                 );  #see subroutines at the bottom of this file
  672                                     #this allows the use of a small gif for the webwork logo
  673                                     #and takes up less screen real estate.
  674 
  675   #text in case the problem has been saved
  676   print $problem_has_been_saved;
  677 
  678 ################print Navigation Bar ###########
  679 
  680   print &format_navigation_bar($previousProbNum,$nextProbNum,$numberOfProblems);
  681 
  682 ##############print warning about setting the Encoding properly###############
  683      my $browser = $cgi -> user_agent();
  684      # browser contains a string such as: |Mozilla/4.07 (Macintosh; I; PPC, Nav) |
  685      $browser =~ m|Mozilla/([\d.]+)|;
  686      my $version = $1;
  687        print( qq!<FONT COLOR="#ff0000"><P> <B>WARNING:</B> Versions of Netscape before 4.0 running on a Macintosh computer
  688                will not be able to display all the math symbols correctly in formatted text mode. Square root and integral
  689                signs may disappear entirely. Please use
  690                another mode.
  691                <P>
  692                 When using Netscape 4 or greater on a Macintosh computer, set your fonts by choosing
  693                <BR>View --&gt;Encoding--&gt;Western(MacRoman) from the menu.  This will make square root signs
  694                and integral signs display correctly.
  695                </P></FONT>!) if ($mode eq 'HTML_tth' && $browser =~/Macintosh/ && $version < "4");
  696 
  697 ###############begin Answer Section###########
  698 
  699 if ($answers_submitted ==1) {
  700 # print "<BR>Problem grader message is:<BR> " , $rh_problem_result->{msg}    if defined($rh_problem_result->{msg});
  701 
  702   print $answer_line_text,
  703           $record_problem_message;
  704 
  705   print(  "<BR>Problem grader errors are " . $rh_problem_result->{errors} ) if $rh_problem_result->{errors};
  706 }
  707 
  708     print "\r\n<!-- BEGIN_PG_PROBLEM_FORM -->\r\n";
  709 
  710 ################begin Problem Text ###########
  711   print "\n",$cgi -> startform(-action=>"$Global::processProblem_CGI"),"\n\n";
  712   print "\r\n<!-- BEGIN_PG_PROBLEM_TEXT -->\r\n";
  713   print @printlines;
  714   print "\r\n<!-- END_PG_PROBLEM_TEXT -->\r\n";
  715   print "<P>";
  716 
  717 
  718 ################print Submit button and display check boxes###########
  719 
  720   print "<EM><B>Note:</B>" . $pt->rh_problem_result->{msg} . "</EM><p>" if ($pt->rh_problem_result->{msg});
  721   my  $s      = '';
  722   if( $expected_answer_count > 1) {
  723     $s = 's'; #makes the Answer button plural (purely cosmetic)
  724   }
  725 
  726 # Decide whether the Do not save answers is visible
  727   if (($User ne &getStudentLogin($psvn)) and
  728     ( ($permissions == $Global::instructor_permissions) or ($permissions == $Global::TA_permissions) ) ) {
  729 
  730     print $cgi -> checkbox(-name=>'doNotRecordAns',
  731             -value=>1,
  732             -label=>"Do Not Record Answer$s",
  733             -checked,
  734             -override => 1), "\n\t";
  735   } else {
  736     print $cgi -> hidden(-name=>'doNotRecordAns',
  737         -value => 0,override => 1), "\n\t";
  738   }
  739 
  740 # Decide whether the showHint line is visible
  741 
  742   if (
  743     defined($pt ->rh_flags->{'hintExists'})
  744     and ($pt ->rh_flags->{'hintExists'} ==1)
  745     and ($numOfAttempts >= $pt ->rh_flags->{'showHintLimit'})
  746   ) {
  747         print $cgi -> checkbox(-name=>'ShowHint',
  748             -value=>1,
  749             -label=>"Show Hint",
  750             -override => 1);
  751   } else {
  752     print $cgi -> hidden(-name=>'ShowHint', -value=>0, -override => 1), "\n\t";
  753   }
  754 
  755 
  756 
  757 # Decide whether the showAnswer line is visible
  758 
  759   if (defined($displayShowAnswerLineQ) and $displayShowAnswerLineQ) {
  760     print $cgi -> checkbox(-name=>'ShowAns',
  761             -value=>1,
  762             -label=>"Show Correct Answer$s",
  763             -override => 1), "\n\t";
  764   } else {
  765     print $cgi -> hidden(-name=>'ShowAns',
  766         -value => 0,-override => 1), "\n\t";
  767   }
  768 
  769 
  770 
  771 # Decide whether the showSolution line is visible
  772 
  773   if (defined($displayShowAnswerLineQ) and $displayShowAnswerLineQ and defined($pt ->rh_flags->{'solutionExists'}) and $pt ->rh_flags->{'solutionExists'} ==1) {
  774       print $cgi -> checkbox(-name=>'ShowSol',
  775             -value=>1,
  776             -label=>"Show Solution$s",
  777             -override => 1);
  778   } else {
  779     print $cgi -> hidden(-name=>'ShowSol',  -value=>0, -override => 1), "\n\t";
  780   }
  781 
  782 
  783 ## check to see if $numOfAttempts is approaching or at the limit
  784 ## $maxNumOfIncorrectAttempts. If so, put note by
  785 ## submit answer button (below)
  786 ##  $maxNumOfIncorrectAttempts = -1 means unlimited attempts
  787   my $plural = '';
  788   $plural = 's'   if $attemptsRemaining > 1;
  789 
  790   if(($maxNumOfIncorrectAttempts >= 0) and ($attemptsRemaining <= 0) and ($currentTime<=$ddts)) {
  791     $maxAttemptNote = " <EM>Note: You have already attempted this problem the
  792                            maximum allowed number of times.</EM>\n";
  793   }
  794   elsif (($maxNumOfIncorrectAttempts >= 0) and
  795          ($attemptsRemaining <= $Global::maxAttemptsWarningLevel) and
  796          ($currentTime<=$ddts)
  797         )  {
  798        $maxAttemptNote = " <EM>Note: You are allowed only $attemptsRemaining more
  799                            attempt$plural at this problem.</EM>\n";
  800 
  801   }
  802 
  803 ############# print hidden information about problem and set
  804 
  805   print $cgi -> hidden( -name => 'probNum', -value => $probNum ), "\n\t",
  806       $cgi -> hidden( -name => 'probSetKey', -value => $psvn ), "\n\t",
  807       $cgi->hidden( -name=>'show_old_answers', -value=>$show_old_answers), "\n\t",
  808       $cgi -> hidden( -name => 'answer_form_submitted', -value => 1 );   # alerts the problem to show answers.
  809 
  810   #sessionKeyInputs() in scripts/HTMLglue.pl
  811   print &sessionKeyInputs(\%inputs),
  812     "<BR>",
  813     $cgi -> submit(  -name => 'action',  -value=>"Submit Answer$s"),  # -onClick=>"submitProblem()" # this javaScript call caused problems on some older browsers -- removed temporarily while we find a fix
  814 
  815     "\n\t",
  816     $cgi -> submit(  -name => 'action',  -value=>"Preview Answer$s"),"\n\t",
  817     qq!$maxAttemptNote $dueDateNote $answerNote!;
  818     if ($mode ne 'TeX') { #TEMPORARY KLUDGE
  819     my $displayMode_hidden_inputs = displaySelectModeLine_string($mode);
  820     $displayMode_hidden_inputs =~ s/<BR>//g;  # remove returns to get one line display
  821     print "<BR>$displayMode_hidden_inputs<BR>";
  822   }
  823 
  824 # $source =~ s/([^\r])\n/$1\r\n/g;  # replace any bare \n by \r\n
  825 # $source =~ s/\n/&#010;/g;
  826 #   my $sourceAsHTMLEncodingMethod = 'escaped_returns';  # this makes iCab work properly
  827    my $sourceAsHTMLEncodingMethod = 'base64_encode';
  828    my $sourceAsHTML = encode_base64($source);
  829    if ($readSourceFromHTMLQ ) {   # reading from source is a sticky option.
  830     print $cgi -> hidden(-name  => 'readSourceFromHTMLQ', -value => "1" );
  831     print "<BR>\r\n",
  832           $cgi -> hidden(-name  =>  'source_encoded_using',   -value  =>  $sourceAsHTMLEncodingMethod, -override => 1),
  833           "<BR>\r\n",
  834           $cgi -> hidden(-name  =>  'source',   -value  =>  $sourceAsHTML, -override => 1),
  835           "<BR>\r\n",
  836           $cgi -> hidden(-name  => 'seed',    -value => "$seed" );
  837   }
  838   print "\r\n<!-- BEGIN_PG_READ_FROM_DISK -->\r\n";
  839   if ($readSourceFromHTMLQ ) {
  840     print $cgi -> submit(-name  =>  'action',   -value  => 'Read problem from disk');  # this allows an override about reading from the HTML source
  841 
  842                 # This ensures that we are using the current (possibly changed)
  843                 # seed even if we are resubmitting answers to a question.
  844    }
  845    print $cgi -> endform();
  846    print "\r\n<!-- END_PG_PROBLEM_FORM -->\r\n";
  847 #############################################################
  848 ##  End of main form, containing the problem and answer rules
  849 #############################################################
  850 ##print the form to get the editor in a different window if the
  851 ##person using WeBWorK has professor permissions
  852 
  853 #############################################################
  854 ##  Show editor form
  855 #############################################################
  856 
  857 if ($insertSourceIntoFormQ) {
  858   print "\n\n<!--Source is encoded for more security and to avoid problems with the " .
  859       "conversion from HTML to straight text-->\n";
  860   print $cgi -> startform(-action=>"$Global::problemEditor_CGI",
  861     -target=>'editor'),
  862     &sessionKeyInputs(\%inputs),
  863     $cgi -> hidden( -name =>'source_encoded_using',   -value => $sourceAsHTMLEncodingMethod, -override =>1), "\r\n",
  864     $cgi -> hidden( -name =>'source',       -value  =>  $sourceAsHTML, -override =>1), "\r\n",
  865     $cgi -> submit( -name =>'action',       -value  =>  "Show Editor"), "\r\n",
  866     $cgi -> hidden( -name =>'probSetKey',     -value  =>  $psvn), "\r\n",
  867     $cgi -> hidden( -name =>'probNum',      -value  =>  $probNum), "\n",
  868     $cgi -> hidden( -name =>'Mode',       -value  =>  $mode, -override =>1), "\r\n",
  869     $cgi -> hidden( -name =>'seed',       -value  =>  $seed, -override =>1), "\r\n",
  870     $cgi -> endform();
  871 
  872 }
  873 
  874 #############################################################
  875 ##  End "Show editor" form
  876 ################################################################
  877   print &htmlBOTTOM($0, \%inputs, 'processProblemHelp.html');
  878 
  879   $main::Course = $Course;
  880   $main::User   = $User;
  881 
  882   exit(0);
  883 
  884 
  885 
  886 
  887 ### DONE ###
  888 ############################################
  889 ## SUBROUTINES specific to processProblem.pl
  890 # this normally loads in macro files -- but for the demo this is done by hand.
  891 
  892 sub save_problem_state {
  893     my ($saved_submitted_answers_string,$rh_problem_state, $num,$user, $psvn)=@_;
  894 
  895     # define constants
  896     my  $DELIM = $Global::delim;
  897     my  $scoreFilePrefix = $Global::scoreFilePrefix;
  898     my  $dash = $Global::dash;
  899     my $numericalID = $Global::numericalGroupID;
  900        $numericalID = $Global::numericalGroupID;
  901     #
  902 
  903     #&attachProbSetRecord($psvn); # (not needed);
  904     my($setNumber)=&getSetNumber($psvn);
  905     my ($scoreFileName)="${databaseDirectory}$scoreFilePrefix$setNumber$dash${psvn}.sco";
  906     unless (-e $scoreFileName) {
  907         &createFile($scoreFileName, $Global::sco_files_permission, $numericalID);
  908     }
  909     open(TEMP_FILE,">>$scoreFileName") || print "Couldn't record answer in $scoreFileName";
  910     my $time = &formatDateAndTime(time);    # add time stamp
  911 
  912     print TEMP_FILE "$num  $DELIM  " . $rh_problem_state->{recorded_score} . " $DELIM " . $rh_problem_state->{num_of_correct_ans} . " $DELIM" . $rh_problem_state->{num_of_incorrect_ans} . " $DELIM $user $DELIM $time\n";
  913     close(TEMP_FILE);
  914 
  915   putProblemStudentAnswer($saved_submitted_answers_string,$num,$psvn) if $main::recordSubmittedAnswers;
  916 
  917     &putProblemNumOfCorrectAns($rh_problem_state->{num_of_correct_ans},$num,$psvn) if defined($rh_problem_state->{num_of_correct_ans}) ;
  918     &putProblemNumOfIncorrectAns($rh_problem_state->{num_of_incorrect_ans},$num,$psvn) if defined($rh_problem_state->{num_of_incorrect_ans});
  919 
  920     &putProblemAttempted(1,$num,$psvn);  ## save_problem_state() is run only if the submit button has been
  921                                          ## hit so that means the problem has been attempted
  922 
  923     if ( defined($rh_problem_state->{recorded_score})  ) {
  924       &putProblemStatus( $rh_problem_state->{recorded_score} ,$num,$psvn);
  925     } else {
  926       warn "Error no recorded_score has been calculated for this problem.";
  927     }
  928 
  929     #my %temp1 = getProbSetRecord($psvn);
  930     #warn "number of correct attempts is pst$num ", $temp1{"pst$num"};
  931     &detachProbSetRecord($psvn);
  932 };
  933 
  934 
  935 sub hackerError  { ## prints hacker error message
  936 
  937 
  938     my $msg = "Attempt to hack into WeBWorK \n Remote Host is: ". $cgi -> remote_host()."\n";
  939     $msg .= $cgi -> query_string();
  940 #    &Global::log_error('hacker error', $cgi -> query_string);
  941     &Global::log_error('hacker error', $msg);   ## log attempt
  942 
  943     ## notify by email
  944 
  945     my $toAdd = $Global::feedbackAddress;
  946 
  947     my $emailMsg = "To: $toAdd
  948 Subject: Attempt to hack into WeBWorK
  949 
  950 Here are the details on the attempt to hack into weBWorK:\n
  951 $msg
  952 \n";
  953 
  954   my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>20);
  955   $smtp->mail($Global::webmaster);
  956   $smtp->recipient($Global::feedbackAddress);
  957   $smtp->data($msg);
  958   $smtp->quit;
  959 
  960 
  961 #    my $SENDMAIL = $Global::SENDMAIL;
  962 #    open (MAIL,"|$SENDMAIL");
  963 #    print MAIL "$emailMsg";
  964 #    close (MAIL);
  965 
  966     print   &htmlTOP("Hacker Error"),
  967                         "<H2>Error:Please do not try to hack into WeBWorK!</H2>",
  968                        $cgi -> startform(-action=>"${Global::welcomeAction_CGI}"),
  969                         "<p>",
  970                         &sessionKeyInputs(\%inputs),
  971                         $cgi -> hidden(-name=>'local_psvns', -value=>$psvn),
  972                         $cgi -> hidden(-name=>'action', -value=>'Do_problem_set'),
  973                         $cgi -> endform(),
  974                         &htmlBOTTOM($0, \%inputs);
  975 }
  976 
  977 sub selectionError  ## prints error message
  978   {
  979   print   &htmlTOP("Error: need to select problem"),
  980       "<H2>Error: You must select a problem!</H2>",
  981       $cgi -> startform(-action=>"${Global::welcomeAction_CGI}"),
  982       &sessionKeyInputs(\%inputs),
  983                         $cgi -> hidden(-name=>'local_psvns', -value=>$psvn),
  984                         $cgi -> hidden(-name=>'action', -value=>'Do_problem_set'),
  985                         $cgi -> submit(-value=>"Return to Problem Set"),
  986                         $cgi -> endform(),
  987       &htmlBOTTOM($0, \%inputs);
  988   }
  989 
  990 
  991 ###################################################
  992 sub decodeSource {
  993   my $source = shift;
  994   warn "Only source embedded in HTML needs to be decoded" unless defined($inputs{'source'});
  995   if ( defined($inputs{'source_encoded_using'}) ) {  # the source has been encoded and we need to decode it first
  996     if ( $inputs{'source_encoded_using'} eq 'base64_encode' )  {
  997       $source = decode_base64($source);
  998     }
  999     elsif ( $inputs{'source_encoded_using'} eq 'cgi_escape' ) {
 1000       $source = $cgi -> unescape($source);
 1001     }
 1002     elsif ( $inputs{'source_encoded_using'} eq 'none'  )    {
 1003       # no action needed
 1004     }
 1005     elsif ( $inputs{'source_encoded_using'} eq 'escaped_returns'  )    {
 1006       $source =~s/&#010;/\n/g;  warn "uncoding escaped returns";
 1007       $source =~s/\r\n/\n/g;
 1008     }
 1009     else {
 1010       warn "Did not recognize the source encoding method $inputs{'source_encoded_using'}";
 1011     }
 1012    }
 1013      $source;
 1014 }
 1015 
 1016 
 1017 sub safetyFilter {
 1018 #   my $answer = shift;  # accepts one answer and checks it
 1019 #   $answer = '' unless defined $answer;
 1020 #   my ($errorno, $answerIsCorrectQ);
 1021 #   $answer =~ tr/\000-\037/ /;
 1022 #   #### Return if answer field is empty ########
 1023 #   unless ($answer =~ /\S/) {
 1024 #     $errorno =1; # "No answer was submitted.";
 1025 #
 1026 #     return ($answer,$errorno);
 1027 #     }
 1028 #   ######### replace ^ with **    (for exponentiation)
 1029 #   #   $answer =~ s/\^/**/g;
 1030 #   ######### Return if  forbidden characters are found
 1031 #   unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)\[\]\{\}]+$/ )  {
 1032 #     $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)\[\]\{\}]/#/c;
 1033 #     $errorno = 2; #  "There are forbidden characters in your answer: $submittedAnswer<BR>";
 1034 #
 1035 #     return ($answer,$errorno);
 1036 #     }
 1037 #
 1038   my $answer = shift @_;
 1039   my $errorno = 0;
 1040 
 1041   return($answer, $errorno);
 1042 }
 1043 
 1044 
 1045 
 1046 sub processProblem_htmlTOP {
 1047       my ($title, $header_text, $bg_url) = @_;
 1048 
 1049       my $bg_color = $bg_url || $Global::bg_color;
 1050 
 1051       $header_text = '' unless defined($header_text);
 1052 #       my $out =  header(-type=>'text/html');
 1053 #     $out .= start_html(-'title'=>$title,
 1054 #                     -script=>$header_text,
 1055 #         -background=>$background_url);
 1056     my $test = $cgi -> user_agent();
 1057 #       determine the proper charset
 1058     my $charset_definition;
 1059     my $browser = $cgi -> user_agent();
 1060     # browser contains a string such as: |Mozilla/4.07 (Macintosh; I; PPC, Nav) |
 1061     if ($browser =~/Macintosh/  or $browser =~/Mac_PowerPC/) {  # do we need to know the mode in order to set this properly??
 1062       $charset_definition = q{charset="x-mac-roman";};
 1063     } else {
 1064       $charset_definition =q{};
 1065     }
 1066 
 1067         my $out = <<ENDhtmlTOP;
 1068 content-type: text/html; $charset_definition
 1069 
 1070 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">
 1071 <HTML>
 1072 <HEAD>
 1073 <TITLE>$title</TITLE>
 1074 <style>
 1075   .parsehilight { background: yellow }
 1076 </style>
 1077 $header_text
 1078 </HEAD>
 1079 <BODY BGCOLOR="$bg_color"><p>
 1080 ENDhtmlTOP
 1081     $out;
 1082 }
 1083 
 1084 sub preview_answers_htmlTOP {
 1085       my ($title, $header_text, $bg_url) = @_;
 1086 
 1087       my $bg_color = $bg_url || $Global::bg_color;
 1088 
 1089       $header_text = '' unless defined($header_text);
 1090 
 1091         my $out = <<ENDhtmlTOP;
 1092 content-type: text/html;
 1093 
 1094 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">
 1095 <HTML>
 1096 <HEAD>
 1097 <TITLE>$title</TITLE>
 1098 <style>
 1099   .parsehilight { background: yellow }
 1100 </style>
 1101 $header_text
 1102 </HEAD>
 1103 <BODY BGCOLOR="$bg_color"><p>
 1104 ENDhtmlTOP
 1105     $out;
 1106 }
 1107 
 1108 
 1109 
 1110 sub format_navigation_bar {
 1111 my ($previousProbNum, $nextProbNum,$numberOfProblems) = @_;
 1112   my $navigation_bar = '';
 1113   $navigation_bar .= qq{
 1114     <TABLE BORDER="0" WIDTH="100%">
 1115     <TR ALIGN=CENTER VALIGN=TOP >
 1116     <TD ALIGN=LEFT VALIGN=MIDDLE>
 1117     <TABLE><TR><TD ALIGN=CENTER VALIGN=MIDDLE>
 1118   };
 1119 
 1120   unless($previousProbNum <= 0) {
 1121   $navigation_bar .= $cgi->startform(-method=>'POST', -action=>"$Global::processProblem_CGI"). "\n".
 1122         $cgi->input({-type=>'IMAGE', -src=>"$Global::previousImgUrl", -alt=>'<--Previous Problem'}). "\n".
 1123         $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"). "\n".
 1124         $cgi->hidden(-name=>'probNum', -value=>"$previousProbNum", -override=>1). "\n".
 1125         $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"). "\n".
 1126         $cgi->hidden(-name=>'show_old_answers', -value=>$show_old_answers). "\n".
 1127         $cgi->hidden(-name=>'user', -value=>"$inputs{user}"). "\n".
 1128         $cgi->hidden(-name=>'key', -value=>"$inputs{key}"). "\n".
 1129         $cgi->hidden(-name=>'course', -value=>"$inputs{course}"). "\n".
 1130         $cgi->endform(). "\n";
 1131 
 1132 #     $navigation_bar .= qq{
 1133 #   <A HREF="$Global::processProblem_CGI?probSetKey=$inputs{'probSetKey'}&probNum=$previousProbNum&Mode=$inputs{'Mode'}&course=$inputs{'course'}&user=$inputs{'user'}&key=$inputs{'key'}">
 1134 #         <IMG SRC="$Global::previousImgUrl" ALT="&lt;--Previous Problem"></A>
 1135 #     };
 1136   };
 1137 
 1138   $navigation_bar .= qq{
 1139     </TD> <TD ALIGN=CENTER VALIGN=MIDDLE>
 1140   };
 1141 
 1142         $navigation_bar .= $cgi->startform(-method=>'POST', -action=>"$Global::welcomeAction_CGI"). "\n".
 1143                                 $cgi->input({-type=>'IMAGE', -src=>"$Global::problistImgUrl", -alt=>'Problem List'}). "\n".
 1144         $cgi->hidden(-name=>'local_psvns', -value=>"$inputs{probSetKey}"). "\n".
 1145                                 $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"). "\n".
 1146                                 $cgi->hidden(-name=>'action', -value=>"Do_problem_set",-override=>1). "\n".
 1147                                 $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"). "\n".
 1148                                 $cgi->hidden(-name=>'user', -value=>"$inputs{user}"). "\n".
 1149                                 $cgi->hidden(-name=>'key', -value=>"$inputs{key}"). "\n".
 1150                                 $cgi->hidden(-name=>'course', -value=>"$inputs{course}"). "\n".
 1151                            $cgi->endform(). "\n";
 1152 
 1153 # $navigation_bar .= qq{
 1154 #         <A HREF="$Global::welcomeAction_CGI?local_psvns=$inputs{'probSetKey'}&Mode=$inputs{'Mode'}&course=$inputs{'course'}&user=$inputs{'user'}&action=Do_problem_set&key=$inputs{'key'}">
 1155 #         <IMG SRC="$Global::problistImgUrl" ALT="Problem List"></A>
 1156 # };
 1157 
 1158   $navigation_bar .= qq{  </TD>
 1159 
 1160         <TD ALIGN=CENTER VALIGN=MIDDLE>
 1161   };
 1162 
 1163   unless($nextProbNum > $numberOfProblems) {
 1164 
 1165     $navigation_bar .= $cgi->startform(-method=>'POST', -action=>"$Global::processProblem_CGI"). "\n".
 1166         $cgi->input({-type=>'IMAGE', -src=>"$Global::nextImgUrl", -alt=>'Next Problem-->'}). "\n".
 1167         $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"). "\n".
 1168         $cgi->hidden(-name=>'probNum', -value=>"$nextProbNum", -override=>1). "\n".
 1169         $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"). "\n".
 1170         $cgi->hidden(-name=>'show_old_answers', -value=>$show_old_answers). "\n".
 1171         $cgi->hidden(-name=>'user', -value=>"$inputs{user}"). "\n".
 1172         $cgi->hidden(-name=>'key', -value=>"$inputs{key}"). "\n".
 1173         $cgi->hidden(-name=>'course', -value=>"$inputs{course}"). "\n".
 1174         $cgi->endform(). "\n";
 1175 
 1176 #     $navigation_bar .= qq{
 1177 #       <A HREF="$Global::processProblem_CGI?probSetKey=$inputs{'probSetKey'}&probNum=$nextProbNum&Mode=$inputs{'Mode'}&course=$inputs{'course'}&user=$inputs{'user'}&key=$inputs{'key'}">
 1178 #         <IMG SRC="$Global::nextImgUrl" ALT="Next Problem--&gt;"></A>
 1179 #     };
 1180   }
 1181 
 1182   $navigation_bar .= qq{  </TD>
 1183     </TR></TABLE></TD><TD ALIGN=RIGHT VALIGN=TOP  ROWSPAN=2>
 1184 
 1185   };
 1186 
 1187   $navigation_bar .= qq{
 1188       <A HREF="$Global::webworkDocsURL">
 1189       <IMG SRC="$Global::squareWebworkGif" BORDER=1 ALT="WeBWorK"></A>
 1190 
 1191           </TD></TR>
 1192     <TR><TD ALIGN=LEFT VALIGN=BOTTOM> <H4>$problemStatusMessage</H4>
 1193   </TD></TR>
 1194   </TABLE>
 1195     };
 1196  #   $navigation_bar =~ s/&/&amp;/g;  # urlEncode hack.
 1197 
 1198   return $navigation_bar;
 1199 }
 1200 
 1201 
 1202 sub format_preview_navigation_bar {
 1203 my $curentProbNum = shift;
 1204   my $navigation_bar = '';
 1205   $navigation_bar .= qq{
 1206     <TABLE BORDER="0" WIDTH="100%">
 1207     <TR ALIGN=CENTER VALIGN=TOP >
 1208     <TD ALIGN=LEFT VALIGN=MIDDLE>
 1209     <TABLE><TR><TD ALIGN=CENTER VALIGN=MIDDLE>
 1210   };
 1211 
 1212 
 1213   $navigation_bar .= $cgi->startform(-method=>'POST', -action=>"$Global::processProblem_CGI"). "\n".
 1214     $cgi->input({-type=>'IMAGE', -src=>"$Global::currentImgUrl", -alt=>'Current Problem'}). "\n".
 1215     $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"). "\n".
 1216     $cgi->hidden(-name=>'probNum', -value=>"$curentProbNum", -override=>1). "\n".
 1217     $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"). "\n".
 1218     $cgi->hidden(-name=>'show_old_answers', -value=>$show_old_answers). "\n".
 1219     $cgi->hidden(-name=>'user', -value=>"$inputs{user}"). "\n".
 1220     $cgi->hidden(-name=>'key', -value=>"$inputs{key}"). "\n".
 1221     $cgi->hidden(-name=>'course', -value=>"$inputs{course}"). "\n".
 1222     $cgi->endform(). "\n";
 1223 
 1224 
 1225 # $navigation_bar .= qq{
 1226 #         <A HREF="$Global::processProblem_CGI?probSetKey=$inputs{'probSetKey'}&probNum=$curentProbNum&Mode=$inputs{'Mode'}&course=$inputs{'course'}&user=$inputs{'user'}&key=$inputs{'key'}">
 1227 #         <IMG SRC="$Global::currentImgUrl" ALT="Current Problem"></A>
 1228 #     };
 1229 
 1230   $navigation_bar .= qq{
 1231     </TD> <TD ALIGN=CENTER VALIGN=MIDDLE>
 1232   };
 1233 
 1234   $navigation_bar .= qq{
 1235     </TD> <TD ALIGN=CENTER VALIGN=MIDDLE>
 1236   };
 1237 
 1238         $navigation_bar .= $cgi->startform(-method=>'POST', -action=>"$Global::welcomeAction_CGI"). "\n".
 1239                                 $cgi->input({-type=>'IMAGE', -src=>"$Global::problistImgUrl", -alt=>'Problem List'}). "\n".
 1240         $cgi->hidden(-name=>'local_psvns', -value=>"$inputs{probSetKey}"). "\n".
 1241                                 $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"). "\n".
 1242                                 $cgi->hidden(-name=>'action', -value=>"Do_problem_set", -override=>1). "\n".
 1243                                 $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"). "\n".
 1244                                 $cgi->hidden(-name=>'user', -value=>"$inputs{user}"). "\n".
 1245                                 $cgi->hidden(-name=>'key', -value=>"$inputs{key}"). "\n".
 1246                                 $cgi->hidden(-name=>'course', -value=>"$inputs{key}"). "\n".
 1247                            $cgi->endform(). "\n";
 1248 
 1249 
 1250 
 1251 # $navigation_bar .= qq{
 1252 #         <A HREF="$Global::welcomeAction_CGI?local_psvns=$inputs{'probSetKey'}&Mode=$inputs{'Mode'}&course=$inputs{'course'}&user=$inputs{'user'}&action=Do_problem_set&key=$inputs{'key'}">
 1253 #         <IMG SRC="$Global::problistImgUrl" ALT="Problem List"></A>
 1254 # };
 1255 
 1256   $navigation_bar .= qq{  </TD>
 1257 
 1258         <TD ALIGN=CENTER VALIGN=MIDDLE>
 1259   };
 1260 
 1261   $navigation_bar .= qq{  </TD>
 1262     </TR></TABLE></TD><TD ALIGN=RIGHT VALIGN=TOP WIDTH="20%" ROWSPAN=2>
 1263 
 1264   };
 1265 
 1266   $navigation_bar .= qq{
 1267       <A HREF="$Global::webworkDocsURL">
 1268       <IMG SRC="$Global::squareWebworkGif" BORDER=1 ALT="WeBWorK"></A>
 1269     </TD>
 1270   </TD></TR>
 1271       <TR><TD ALIGN=LEFT VALIGN=BOTTOM> <h3> Preview Answers for Problem $probNum of Set $setNumber </h3>
 1272   </TD></TR>
 1273   </TABLE>
 1274     };
 1275   $navigation_bar;
 1276 }
 1277 
 1278 
 1279 ##Subroutine saveProblem takes the modified source of the problem and
 1280 ##saves it to the file with the original problem name and appends the
 1281 ##old version of the problem to the file problemname.pg.bak
 1282 
 1283 sub saveProblem {
 1284   my ($source, $probFileName)= @_;
 1285   my $org_source;
 1286  #######get original source of the problem
 1287   if (-e "${templateDirectory}$probFileName" ) {
 1288     unless (-w "${templateDirectory}$probFileName") {
 1289       wwerror($0, "Can't write to ${templateDirectory}$probFileName.\n" .
 1290                    "No changes were saved.\n" .
 1291                    "Check that the  permissions for this problem are 660 (-rw-rw----)\n",
 1292                    "", "", $cgi -> query_string());
 1293     }
 1294     open(PROB,"<${templateDirectory}$probFileName");
 1295     $org_source = join("",<PROB>);
 1296       close(PROB);
 1297   } else {
 1298     wwerror($0, "<H4>Error: The problem ${templateDirectory}$probFileName could not be found!</H4>");
 1299   }
 1300 
 1301  #######append old version to problemfilename.pg.bak:
 1302   open BAKFILE, ">>${templateDirectory}${probFileName}.bak" or
 1303     wwerror($0, "Could not open \n${templateDirectory}${probFileName}.bak for appending.\nNo changes were saved.");
 1304   my ($sec, $min, $hour, $mday, $mon, $year)=localtime(time);
 1305   print BAKFILE "##################################################################\n",
 1306           "##########Date:: $mday-$mon-$year, $hour:$min:$sec################", "\n\n\n";
 1307   print BAKFILE $org_source;
 1308   close BAKFILE;
 1309 
 1310   chmod 0660, "${templateDirectory}${probFileName}.bak" ||
 1311                print "Content-type: text/html\n\n
 1312                       CAN'T CHANGE PERMISSIONS ON FILE ${templateDirectory}${probFileName}.bak";
 1313 
 1314 
 1315  #######copy new version to the file problemfilename.pg
 1316   open (PROBLEM, ">${templateDirectory}$probFileName") ||
 1317     wwerror($0, "Could not open ${templateDirectory}$probFileName for writing.
 1318     Check that the  permissions for this problem are 660 (-rw-rw----)");
 1319   print PROBLEM $source;
 1320   close PROBLEM;
 1321   chmod 0660, "${templateDirectory}${probFileName}" ||
 1322                print "Content-type: text/html\n\n
 1323                       CAN'T CHANGE PERMISSIONS ON FILE ${templateDirectory}${probFileName}";
 1324 
 1325 }
 1326 
 1327 ##Subroutine saveNewProblem takes the modified source of the problem and
 1328 ##saves it to the file with the $new_file_name
 1329 
 1330 sub saveNewProblem {
 1331   my ($source, $new_file_name)= @_;
 1332 
 1333  #######check that the new file name is legal
 1334   unless ($new_file_name =~ /^\w/ ) {
 1335     wwerror($0, "The file name or path\n".
 1336     "$new_file_name\n".
 1337     "can not begin with a non word character.\n" .
 1338     "<b>The new version was not saved.</b>\n" .
 1339     "Go back and choose a different name.");
 1340   }
 1341 
 1342   if ($new_file_name =~ /\.\./ ) {
 1343     wwerror($0, "The file name or path\n".
 1344     "$new_file_name\n".
 1345     "is illegal.\n" .
 1346     "<b>The new version was not saved.</b>\n" .
 1347     "Go back and choose a different name.");
 1348   }
 1349 
 1350 
 1351  #######check that the new file name doesn't exist
 1352   if (-e "${templateDirectory}$new_file_name" ) {
 1353     wwerror($0, "The file\n".
 1354     "${templateDirectory}$new_file_name\n".
 1355     "already exists.\n" .
 1356     "<b>The new version was not saved.</b>\n" .
 1357     "Go back and choose a different file name or\, if you really want to edit\n".
 1358     "${templateDirectory}$new_file_name\,\n".
 1359     "go back and hit the \&quot;Save updated version\&quot; button.");
 1360   }
 1361 
 1362 
 1363  #######copy new version to the file new_file_name
 1364   open (PROBLEM, ">${templateDirectory}$new_file_name") ||
 1365     wwerror($0, "Could not open ${templateDirectory}$new_file_name for writing.
 1366   Check that the  permissions for the directory ${templateDirectory} are 770 (drwxrwx---)
 1367   Also check permissions for any subdirectories in the path.");
 1368   print PROBLEM $source;
 1369   close PROBLEM;
 1370   chmod 0660, "${templateDirectory}$new_file_name" ||
 1371                print "Content-type: text/html\n\n
 1372                       CAN'T CHANGE PERMISSIONS ON FILE ${templateDirectory}$new_file_name";
 1373 
 1374 }
 1375 
 1376 
 1377 sub build_preview_page {
 1378     print preview_answers_htmlTOP("Preview Answers for Problem $probNum", '',$bg_color);
 1379   print format_preview_navigation_bar($probNum);
 1380   print $cgi -> startform(-action=>"$Global::processProblem_CGI");
 1381     print $preview_text;
 1382     ############# print hidden information about problem and set
 1383   $s = '';
 1384   if( $expected_answer_count > 1) {$s = 's'; }
 1385   print   $cgi -> hidden(-name=>'probNum',  -value=>$probNum),
 1386     $cgi -> hidden(-name=>'probSetKey', -value=>$psvn),
 1387     $cgi -> hidden(-name=>'answer_form_submitted', -value=>1),   # alerts the problem to show answers.
 1388     $cgi -> hidden(-name=>'Mode',   -value=>$mode);
 1389     $cgi -> hidden(-name=>'show_old_answers', -value=>$show_old_answers);
 1390   print   &sessionKeyInputs(\%inputs),
 1391     '<BR>',
 1392     $cgi -> submit(  -name => 'action',  -value=>"Submit Answer$s" ),' ',
 1393     $cgi -> submit(  -name => 'action',  -value=>"Preview Again" ),"\n";
 1394 
 1395     print $cgi -> endform();
 1396 
 1397     print &htmlBOTTOM($0, \%inputs, 'previewAnswersHelp.html');
 1398 }
 1399 
 1400 sub encode_submitted_answers { ## returns an encoded string
 1401   my $ra_answer_entry_order = shift;
 1402   my @answer_labels = @$ra_answer_entry_order;
 1403   my %answer_hash =();
 1404   my ($label,$value,$out_string);
 1405 
 1406   ## we will use ## to joint the hash into a string for storage
 1407   ## so first we protect # in all keys and values
 1408   foreach $label (@answer_labels) {
 1409     $value = (defined $inputs{$label}) ? $inputs{$label} : '' ;
 1410     $value = '' if length($value) > $Global::maxSizeRecordedAns;
 1411 #warn "label is |$label| \n";
 1412 #warn "val is |$value| \n";
 1413     $label =~ s/#/\\#\\/g;
 1414     $value =~ s/#/\\#\\/g;
 1415     $answer_hash{$label} = $value;
 1416   }
 1417   $out_string = join '##', %answer_hash;
 1418 
 1419   ## When using flat databases (gdbm, db), we use '&' and '=' to
 1420   ## separate values so we must replace all such occurences. We will
 1421   ## replace then by %% and @@. First we escape any of these.
 1422 
 1423   $out_string =~ s/%/\\%\\/g;
 1424   $out_string =~ s/@/\\@\\/g;
 1425   $out_string =~ s/&/%%/g;
 1426   $out_string =~ s/=/@@/g;
 1427 #warn "outstring is |$out_string| \n";
 1428   $out_string;
 1429 }
 1430 
 1431 sub decode_submitted_answers { ## returns a ref to a hash of submitted answers
 1432   my $in_string = shift;
 1433 
 1434   ## reverse encoding process. See comments in encode_submitted_answers
 1435   $in_string =~ s/@@/=/g;
 1436   $in_string =~ s/%%/&/g;
 1437   $in_string =~ s/\\@\\/@/g;
 1438   $in_string =~ s/\\%\\/%/g;
 1439 
 1440   $in_string =~ s/##$/## /;   # This makes sure that the last element has a value.
 1441                 # It may cause trouble if this value was supposed to be nil instead of a space.
 1442 
 1443   my %saved_answers = split /##/,$in_string;
 1444   my ($label,$value);
 1445   my %answer_hash = ();
 1446 
 1447   foreach $label (keys (%saved_answers)) {
 1448     $value = $saved_answers{$label};
 1449     $label =~ s/\\#\\/#/g;
 1450     $value =~ s/\\#\\/#/g;
 1451     $answer_hash{$label} = $value;
 1452   }
 1453   \%answer_hash;
 1454 }
 1455 
 1456 sub defineProblemEnvir {
 1457     my ($mode,$probNum,$psvn,$courseName)      =   @_;
 1458     my %envir=();
 1459     my $loginName = &getStudentLogin($psvn);
 1460   ##how to put an array submittedAnswers in a hash??
 1461 #    $envir{'refSubmittedAnswers'}    =   $refSubmittedAnswers if defined($refSubmittedAnswers);
 1462     $envir{'psvnNumber'}        =   $psvn;
 1463     $envir{'psvn'}            =   $psvn;
 1464     $envir{'studentName'}       =   &CL_getStudentName($loginName);
 1465   $envir{'studentLogin'}        = &getStudentLogin($psvn);
 1466   $envir{'sectionName'}       = &CL_getClassSection($loginName);
 1467   $envir{'sectionNumber'}       = &CL_getClassSection($loginName);
 1468   $envir{'recitationName'}      = &CL_getClassRecitation($loginName);
 1469   $envir{'recitationNumber'}      = &CL_getClassRecitation($loginName);
 1470   $envir{'setNumber'}         = &getSetNumber($psvn);
 1471   $envir{'questionNumber'}        = $probNum;
 1472   $envir{'probNum'}           = $probNum;
 1473   $envir{'openDate'}          = &getOpenDate($psvn);
 1474   $envir{'formattedOpenDate'}     = &formatDateAndTime(&getOpenDate($psvn));
 1475   $envir{'dueDate'}           = &getDueDate($psvn);
 1476   $envir{'formattedDueDate'}      = &formatDateAndTime(&getDueDate($psvn));
 1477   $envir{'answerDate'}        = &getAnswerDate($psvn);
 1478   $envir{'formattedAnswerDate'}   = &formatDateAndTime(&getAnswerDate($psvn));
 1479   $envir{'problemValue'}        = &getProblemValue($probNum,$psvn);
 1480   $envir{'fileName'}          = &getProblemFileName($probNum,$psvn);
 1481   $envir{'probFileName'}        = &getProblemFileName($probNum,$psvn);
 1482   $envir{'languageMode'}        = $mode;
 1483   $envir{'displayMode'}       = $mode;
 1484   $envir{'outputMode'}        = $mode;
 1485   $envir{'courseName'}        = $courseName;
 1486   $envir{'sessionKey'}        = ( defined($inputs{'key'}) ) ?$inputs{'key'} : " ";
 1487 
 1488   # initialize constants for PGanswermacros.pl
 1489   $envir{'numRelPercentTolDefault'}   =     getNumRelPercentTolDefault();
 1490   $envir{'numZeroLevelDefault'}   =     getNumZeroLevelDefault();
 1491   $envir{'numZeroLevelTolDefault'}  =     getNumZeroLevelTolDefault();
 1492   $envir{'numAbsTolDefault'}      =     getNumAbsTolDefault();
 1493   $envir{'numFormatDefault'}      =     getNumFormatDefault();
 1494   $envir{'functRelPercentTolDefault'} =     getFunctRelPercentTolDefault();
 1495   $envir{'functZeroLevelDefault'}   =     getFunctZeroLevelDefault();
 1496   $envir{'functZeroLevelTolDefault'}  =     getFunctZeroLevelTolDefault();
 1497   $envir{'functAbsTolDefault'}    =     getFunctAbsTolDefault();
 1498   $envir{'functNumOfPoints'}      =     getFunctNumOfPoints();
 1499   $envir{'functVarDefault'}       =     getFunctVarDefault();
 1500   $envir{'functLLimitDefault'}    =     getFunctLLimitDefault();
 1501   $envir{'functULimitDefault'}    =     getFunctULimitDefault();
 1502   $envir{'functMaxConstantOfIntegration'} = getFunctMaxConstantOfIntegration();
 1503   #kludge check definition of number of attempts again. The +1 is because this is used before the current answer is evaluated.
 1504   $envir{'numOfAttempts'}             =     &getProblemNumOfCorrectAns($probNum,$psvn)
 1505                                           + &getProblemNumOfIncorrectAns($probNum,$psvn)+1;
 1506 
 1507 
 1508 
 1509   # defining directorys and URLs
 1510   $envir{'templateDirectory'}       = &getCourseTemplateDirectory();
 1511   $envir{'classDirectory'}        = $Global::classDirectory;
 1512   $envir{'cgiDirectory'}        = $Global::cgiDirectory;
 1513   $envir{'cgiURL'}                    =   getWebworkCgiURL();
 1514   $envir{'macroDirectory'}        = getCourseMacroDirectory();
 1515   $envir{'courseScriptsDirectory'}    = getCourseScriptsDirectory();
 1516   $envir{'htmlDirectory'}             =   getCourseHtmlDirectory();
 1517   $envir{'htmlURL'}           = getCourseHtmlURL();
 1518   $envir{'tempDirectory'}             =   getCourseTempDirectory();
 1519   $envir{'tempURL'}                   =   getCourseTempURL();
 1520   $envir{'scriptDirectory'}       = $Global::scriptDirectory;
 1521   $envir{'webworkDocsURL'}        = $Global::webworkDocsURL;
 1522   $envir{'externalTTHPath'}       = $Global::externalTTHPath;
 1523 
 1524 
 1525 
 1526   $envir{'inputs_ref'}                = \%inputs;
 1527   $envir{'problemSeed'}         =   $seed;
 1528   $envir{'displaySolutionsQ'}     =   $displaySolutionsQ;
 1529   $envir{'displayHintsQ'}       =   $displayHintsQ;
 1530 
 1531   # here is a way to pass environment variables defined in webworkCourse.ph
 1532   my $k;
 1533   foreach $k (keys %Global::PG_environment ) {
 1534     $envir{$k} = $Global::PG_environment{$k};
 1535   }
 1536   %envir;
 1537 }
 1538 
 1539 };  # end eval
 1540 
 1541 print "Content-type:  text/plain\n\n Error in $Global::processProblem_CGI\n$@" if $@;
 1542 
 1543 #### for error checking and debugging purposes
 1544 sub pretty_print_rh {
 1545   my $rh = shift;
 1546   foreach my $key (sort keys %{$rh})  {
 1547     print "  $key => ",$rh->{$key},"\n";
 1548   }
 1549 }
 1550 END {
 1551    if (defined($main::SIG_TIME_OUT) && $main::SIG_TIME_OUT == 1) {
 1552       alarm(0);  # turn off the alarm
 1553 
 1554       my $problem_message = qq!Content-type: text/html\n\n<HTML><BODY BGCOLOR = "FF99CC">
 1555         <BLOCKQUOTE><H3>WeBWorK heavy useage time out.</H3>\n
 1556       <H4>Your request for a WeBWorK problem was cancelled because it took more
 1557       than $main::TIME_OUT_CONSTANT seconds.</H4>
 1558       If this occurs for only this problem, it is likely that there is a programing error
 1559       in this problem, maybe an infinite loop.  Please report this to your instructor.<P>\n
 1560       If you get this error on several different problems, it
 1561       is probably because the
 1562       WeBWorK server is extraordinarily busy.<P>\n
 1563       In this case you should be warned that WeBWorK response will be unusually slow.  If possible you should try
 1564       to use WeBWorK at another time when the load is not as high.  The highest useage periods are in the
 1565       evening, particularly in the two hours before assignments are due.<P>\n
 1566           Use the back button to return to the previous page and try again.<P>\n
 1567           If the high useage problem continues you can report this to your instructor using
 1568           the feedback button.
 1569           <P>
 1570           Script: $Global::processProblem_CGI
 1571            </BLOCKQUOTE></BODY></HTML>
 1572       !;
 1573         print $problem_message, "\n";
 1574 
 1575 
 1576 
 1577    }
 1578 
 1579     # begin Timing code
 1580   if( $main::logTimingData == 1 ) {
 1581     my $endTime = new Benchmark;
 1582     my $error_str='';
 1583 
 1584     if ($main::SIGPIPE) {
 1585       $error_str = 'broken PIPE--';
 1586     }
 1587     elsif ($main::SIG_TIME_OUT) {
 1588       $error_str = "TIME_OUT after $main::TIME_OUT_CONSTANT secs --";
 1589     }
 1590 
 1591     &Global::logTimingInfo($main::beginTime,$endTime,$error_str.'processProb8.pl '. "(mode: $main::display_mode, action: $main::Action)",$main::Course,$main::User);
 1592   }
 1593   # end Timing code
 1594 
 1595 }
 1596 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9