[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 21 - (download) (as text) (annotate)
Tue Jun 19 12:14:14 2001 UTC (18 years, 7 months ago) by apizer
File size: 62330 byte(s)
Added code giving students the choice whether or not to "show my old
answers", i.e. to show storred sticky answers.  The default for practice users
and all users after the answer date is not to show these.  Otherwise the
default is to show them.  This required a change everywhere processProblem
is called.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9