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