[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 363 - (download) (as text) (annotate)
Sat Jun 15 02:11:47 2002 UTC (17 years, 6 months ago) by apizer
File size: 62718 byte(s)
Use CGI.pm rather than raw html to format_navigation_bar

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9