[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 97 - (download) (as text) (annotate)
Tue Aug 7 18:33:14 2001 UTC (18 years, 4 months ago) by sam
File size: 63088 byte(s)
Added $envir{'externalTTHPath'} to defineProblemEnvir in each file. This
will work with dangerousMacros.pl to specify the path to TTH.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9