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