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