[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 2405 - (download) (as text) (annotate)
Fri Jun 25 15:17:52 2004 UTC (15 years, 7 months ago) by apizer
File size: 68896 byte(s)
Load IO.pl.  Also log answers in show past answers only if answers are submitted
and not anonymous (i.e. don't log answers if students only previews and don't log
questionnaire responses).

Arnie

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9