[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 11 - (download) (as text) (annotate)
Mon Jun 18 15:21:51 2001 UTC (18 years, 7 months ago) by sam
File size: 62031 byte(s)
another setup script test (changed #! lines)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9