[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 2 - (download) (as text) (annotate)
Thu Jun 14 17:08:51 2001 UTC (18 years, 7 months ago) by sam
File size: 61848 byte(s)
initial import

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9