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