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