Parent Directory
| 
Revision Log
Added forking code to probSerHeader translation code in createTexSource().
1 #!/usr/local/bin/webwork-perl 2 3 ################################################################ 4 # Copyright @1995-1999 by Michael E. Gage, Arnold K. Pizer and 5 # WeBWorK at the University of Rochester. All rights reserved. 6 ################################################################ 7 8 my $debugON=0; 9 10 use lib '.'; use webworkInit; # WeBWorKInitLine 11 12 require 5.001; 13 use strict; 14 use Global; 15 use Auth; 16 use CGI qw(:standard); 17 use Net::SMTP; 18 use Safe; 19 20 use PGtranslator; 21 use vars qw($modules_to_evaluate $extra_packages_to_be_loaded); 22 23 $/ ="\n"; 24 25 BEGIN { 26 # set to 1 to enable timing_log 27 # (contains information about time taken by scripts to run) 28 $main::logTimingData = 0; 29 30 # begin Timing code 31 if( $main::logTimingData == 1 ) { 32 use Benchmark; 33 $main::beginTime = new Benchmark; 34 } 35 # end Timing code 36 37 # Setting these time out comstants to zeros removes the time constraint completely. (zero = infinity :=) ) 38 $main::TIME_OUT_CONSTANT = 60; # one minute wait for on screen problems 39 $main::CLASS_DOWNLOAD_TIME_OUT_CONSTANT = 1200; #twenty minutes 40 $main::CLASS_DOWNLOAD_NICE = 5; # higher numbers indicated lower priorities 41 # $main::DOWNLOAD_TIME_OUT_CONSTANT = 300; # give it five minutes 42 # $main::DOWNLOAD_NICE = 2; 43 44 # ATTENTION: The handlers PG_floating_point_exception_handler and PG_warnings_handler 45 # have to be installed after CGI::Carp is called since it also 46 # modifes the die and warn labels. Finding the right warning mechanism using these two 47 # methods bears further investigation 48 # They are defined in Global.pm 49 $SIG{'FPE'} = \&Global::PG_floating_point_exception_handler; 50 $SIG{__WARN__}=\&Global::PG_warnings_handler; 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 alarm($main::TIME_OUT_CONSTANT); 56 # By explicitly catching the signals and dieing one forces the execution of the END statements which clean up the files. 57 }; 58 59 ################################################################################ 60 # main ######################################################################### 61 ################################################################################ 62 63 &CGI::ReadParse; 64 my %inputs=%main::in; 65 my $query = $main::in{CGI}; 66 67 # verify that the rest of the information has been received 68 my $Course = $inputs{'course'}; 69 my $User = $inputs{'user'}; 70 71 my @local_psvns = $query -> param('local_psvns'); 72 my $psvn = $local_psvns[0]; # get the first one for doing problem sets 73 $inputs{'probSetKey'} = $psvn; # only used by htmlBOTTOM 74 my $Session_key = $inputs{'key'}; 75 76 &Global::getCourseEnvironment($Course); 77 78 my $scriptDirectory = getWebworkScriptDirectory(); 79 my $databaseDirectory = getCourseDatabaseDirectory(); 80 my $courseScriptsDirectory = getCourseScriptsDirectory(); 81 my $templateDirectory = getCourseTemplateDirectory(); 82 my $tempDirectory = getCourseTempDirectory(); 83 84 eval{require "${courseScriptsDirectory}$Global::displayMacros_pl";}; 85 eval{require "${scriptDirectory}$Global::DBglue_pl";}; 86 eval{require "${scriptDirectory}$Global::classlist_DBglue_pl";}; 87 eval{require "${scriptDirectory}$Global::HTMLglue_pl";}; 88 eval{require "${scriptDirectory}$Global::FILE_pl";}; 89 90 # load the modules to be used in PGtranslator 91 require "${courseScriptsDirectory}PG_module_list.pl" 92 or wwerror($0, "Can't read ${courseScriptsDirectory}PG_module_list.pl"); 93 94 my $keyFile = &Global::getCourseKeyFile($Course); 95 my $permissionsFile = &getCoursePermissionsFile($Course); 96 97 # check to see if prob set has been selected 98 if(not defined($psvn) or $psvn eq "") { 99 selectionError(); 100 exit; 101 } 102 103 # log access 104 &Global::log_info('', query_string); 105 106 &verify_key($inputs{'user'}, $Session_key, $keyFile, $Course); 107 my $permissions = &get_permissions($User,$permissionsFile); 108 109 &attachProbSetRecord($psvn); 110 my $login_name_for_psvn = &getStudentLogin($psvn); 111 attachCLRecord($login_name_for_psvn); 112 113 my $setNumber=&getSetNumber($psvn); 114 $setNumber = $inputs{'setNo'} if defined $inputs{'setNo'}; ## script called from profChangeDates.pl 115 116 # keep strict happy -sh 117 my $tempTexFileBaseName; 118 119 # check to see that it is after the open date 120 my ($currentTime,$odts,$ddts,$remainingTime, $TimeString); 121 $currentTime = time; 122 $odts=&getOpenDate($psvn); 123 $ddts=&getDueDate($psvn); 124 $remainingTime=$ddts-$currentTime; 125 126 if($currentTime<$odts && $permissions !=$Global::instructor_permissions) { 127 print &htmlTOP("Before open date error"); 128 print "<CENTER><h2>Sorry, cannot download or do problem set $setNumber yet. 129 <BR>It is before the open date.</h2></CENTER>"; 130 print &htmlBOTTOM("downloadPS.pl",\%inputs); 131 exit(0); 132 } 133 134 my %PSVNHashForSet = %{getPSVNHashForSet($setNumber)}; 135 my $action = $inputs{'action'}; 136 my $downloadType= $inputs{'downloadType'}; # either pdf, ps, tex, or dvi 137 138 # Verify that the problem set has been created if a psvn number has been passed 139 unless ($action eq 'Get_all_copies') { 140 unless (defined $PSVNHashForSet{$psvn} ) { 141 print &htmlTOP("Problem set version number $psvn not created"); 142 print ( "Pin number $psvn was not created for set $setNumber"); 143 print &htmlBOTTOM("downloadPS.pl", \%inputs); 144 exit(0); 145 } 146 } 147 148 my $save_errors = ''; 149 150 if ($action eq 'Do problem set' or $action eq 'Do_problem_set') { displayProbSet(); } 151 elsif ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') { downloadAllSets(); } 152 elsif ($action eq 'Get_all_copies') { downloadAllSets(); } 153 else { wwerror($0, "Unknown action: $action"); } 154 155 # begin Timing code 156 #my $endTime = new Benchmark; 157 #&Global::logTimingInfo($main::beginTime,$endTime,$0,$Course,$User); 158 # end Timing code 159 160 exit; 161 162 ################################################################################ 163 # displayProbSet ############################################################### 164 ################################################################################ 165 166 sub displayProbSet 167 { 168 my $studentName=&CL_getStudentName($login_name_for_psvn); 169 my $probHeaderFileName = &getProbHeaderFileName($psvn); 170 171 sub numerical { $a <=> $b}; 172 my @problems=sort numerical &getAllProblemsForProbSetRecord($psvn); 173 my $numberOfProblems = @problems; 174 175 print &probSet_htmlTOP("Problem Set $setNumber from $inputs{'course'} for $studentName"); 176 #see subroutines at the bottom of this file 177 #this allows the use of a small gif for the webwork logo 178 #and takes up less screen real estate. 179 180 print &probSet_titleBar("Problem Set $setNumber from $inputs{'course'} for $studentName"); 181 182 print <<"ENDOFHTML"; 183 <TABLE BORDER=1> 184 <TR> 185 <!-- Row 1 Column 1 --> 186 <TD> 187 Select one of the $numberOfProblems problems to try: 188 <FORM METHOD=POST ACTION="$Global::processProblem_CGI"> 189 <INPUT TYPE=HIDDEN NAME=probSetKey VALUE=$psvn> 190 <P> 191 <SELECT NAME=probNum SIZE=11> 192 ENDOFHTML 193 194 my ($problemAttempted, $problemStatus, $longProblemStatus); 195 foreach my $problem (@problems) { 196 $problemStatus = getProblemStatus($problem,$psvn); 197 $problemAttempted = getProblemAttempted($problem,$psvn); 198 199 if (!$problemAttempted) { 200 $longProblemStatus = ''; 201 } elsif ($problemStatus >= 0 and $problemStatus <=1 ) { 202 my $percentCorr = int(100*$problemStatus+.5); 203 $longProblemStatus = "${percentCorr}\% correct" 204 } else { 205 $longProblemStatus = 'unknown status'; # default value 206 } 207 print "<OPTION VALUE=\"$problem\">Problem $problem -- $longProblemStatus</OPTION>\n"; 208 } 209 210 # nice note to warn if there's less than one day left to complete problem set 211 if ($remainingTime < 86400 and $remainingTime > 0) { 212 $TimeString = "<BR><EM>Note: you have less than one day left to complete this problem set</EM>"; 213 } else { 214 $TimeString = ""; 215 } 216 217 print "</SELECT><BR>"; 218 219 my $practiceUser = $Global::practiceUser; 220 if (($currentTime > $ddts) or ($User =~ /^$practiceUser/)) { 221 print '<INPUT type="checkbox" name="show_old_answers" value="1"> Show my old answers<BR>'; 222 } 223 else { 224 print '<INPUT type="checkbox" name="show_old_answers" value="1" checked> Show my old answers<BR>'; 225 } 226 227 print &sessionKeyInputs(\%inputs); 228 229 my $mode = $inputs{'Mode'}; 230 $mode = $Global::htmlModeDefault unless ($mode); 231 &displaySelectModeLine($mode); ## displays mode select buttons 232 ## displaySelectModeLine() is in "${courseScriptsDirectory}$Global::displayMacros_pl" 233 print <<"ENDOFHTML"; 234 <BR> 235 <INPUT TYPE=SUBMIT VALUE="Get Problem"> 236 $TimeString 237 </FORM> 238 ENDOFHTML 239 240 print "<FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P>"; 241 print &sessionKeyInputs(\%inputs); 242 243 print <<"ENDOFHTML"; 244 <INPUT TYPE=HIDDEN NAME="probSetKey" VALUE=$psvn> 245 <INPUT TYPE=SUBMIT VALUE="Problem Sets"> 246 </FORM> 247 </TD> 248 <!-- Row 1 Column 2 --> 249 <TD> 250 ENDOFHTML 251 252 253 # process problem and save @printlines 254 my $probHeader = $Global::PROB_HEADER; # default value 255 if ((defined($probHeaderFileName)) and ($probHeaderFileName =~ /\S/)) { 256 $probHeader = $probHeaderFileName; 257 } 258 259 # use $probHeader as default unless $probHeaderFileName is defined in the set definition file 260 my $source; 261 if (-e "${templateDirectory}$probHeader") { 262 unless (-r "${templateDirectory}$probHeader") { 263 wwerror($0, "Can't read ${templateDirectory}$probHeader"); 264 } 265 open(PROB,"<${templateDirectory}$probHeader"); 266 $source = join("",<PROB>); 267 close(PROB); 268 } 269 270 # translate the problem header file 271 my %envir=defineProblemEnvir($mode,0,$psvn,$Course); 272 273 my $pt = new PGtranslator; # pt stands for problem translator; 274 $pt->environment(\%envir); 275 $pt->initialize(); 276 $pt->set_mask(); 277 $pt->source_string($source); 278 $pt->unrestricted_load("${courseScriptsDirectory}PG.pl"); 279 $pt->unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl"); 280 $pt->translate(); 281 282 my $PG_PROBLEM_TEXT_REF = $pt->ra_text(); 283 my $PG_HEADER_TEXT_REF = $pt->r_header; #\$PG_HEADER_TEXT; 284 my $PG_ANSWER_HASH_REF = $pt->rh_correct_answers; 285 my $PG_FLAGS_REF = $pt->rh_flags; 286 287 my @printlines; 288 if($mode eq "HTML" || $mode eq 'HTML_tth') { 289 @printlines = @{$PG_PROBLEM_TEXT_REF}; 290 #@printlines = @{$pt->ra_text()}; 291 } 292 elsif ($mode eq 'Latex2HTML') { 293 @printlines = 294 &createDisplayedInsert($setNumber,$probHeader,$psvn,$Course,$PG_PROBLEM_TEXT_REF); 295 } 296 print @printlines; 297 print "</TD></TR></TABLE>"; 298 299 print &htmlBOTTOM('welcomeAction.pl', \%inputs,'probSetHelp.html'); 300 } 301 302 ################################################################################ 303 # downloadAllSets (and related subroutines) #################################### 304 ################################################################################ 305 306 ################### 307 # downloadAllSets # 308 ################### 309 310 sub downloadAllSets { 311 system("/usr/bin/renice +$main::CLASS_DOWNLOAD_NICE -p $$ 1>/dev/null") && warn "Could not renice process. pid $$"; 312 alarm( $main::CLASS_DOWNLOAD_TIME_OUT_CONSTANT); 313 314 my $downloadMulti = "unknown"; 315 $downloadMulti = "multistudent" if $action eq "Get_all_copies"; 316 $downloadMulti = "multiset" if $action eq "Get_hard_copy"; 317 318 my @psvns_to_download = $query->param('local_psvns'); 319 my $num_psvns_to_download = @psvns_to_download; 320 my $max_psvns_to_download = $Global::max_num_of_ps_downloads_allowed; 321 322 if($num_psvns_to_download > 1 and $permissions != $Global::instructor_permissions) { 323 wwerror("Non-professors are not permitted to download more than one problem set at a time."); 324 } 325 326 if(@psvns_to_download > $Global::max_num_of_ps_downloads_allowed) { 327 my $tooManyWhat = $downloadMulti eq "multiset" ? "problem sets" : "students"; 328 wwerror("Too many $tooManyWhat are selected for download.", 329 "The maximum number of $tooManyWhat which can be downloaded at one time is $Global::max_num_of_ps_downloads_allowed." 330 ." You selected $num_psvns_to_download. Go back and select fewer $tooManyWhat." 331 ." (This maximun is set by the variable \$max_num_of_ps_downloads_allowed in Global.pm.)"); 332 } 333 334 my ($cumulativeTexSource, $currentTexSourceRef, $currentTexSource, $currentTexErrorRef); 335 336 # this could be used when eliminating pre-foreach createTexSourceHandleErrors call 337 # s/\\end\{document\}.*?\\begin\{document\}/\n\\newpage\n/s; 338 339 $tempTexFileBaseName = "${tempDirectory}Temp_downloadAllSets_$User"; 340 my $first_psvn = $psvns_to_download[0]; 341 342 my $current_psvn = shift @psvns_to_download; 343 ($currentTexSourceRef, $currentTexErrorRef) = createTexSource($current_psvn); 344 @psvns_to_download = () if(@$currentTexErrorRef); 345 $currentTexSource = $$currentTexSourceRef; 346 $currentTexSource =~ s|\\end\{document\}\s$|\n|s; 347 $cumulativeTexSource .= $currentTexSource; 348 349 foreach $current_psvn (@psvns_to_download) { 350 ($currentTexSourceRef, $currentTexErrorRef) = createTexSource($current_psvn); 351 @psvns_to_download = () if(@$currentTexErrorRef); 352 $currentTexSource = $$currentTexSourceRef; 353 $currentTexSource =~ s|^.*?\\begin\{document\}|\n\\newpage\n|s; 354 $currentTexSource =~ s|\\end\{document\}\s$|\n|s; 355 $cumulativeTexSource .= $currentTexSource; 356 } 357 358 $cumulativeTexSource .= "\n\\end{document}\n"; 359 360 open TEXOUTPUT, ">$tempTexFileBaseName.tex" 361 or wwerror("Can't open $tempTexFileBaseName.tex for output."); 362 print TEXOUTPUT $cumulativeTexSource; 363 close TEXOUTPUT; 364 365 if(@$currentTexErrorRef) { 366 PG_error_print($tempTexFileBaseName, $current_psvn, @$currentTexErrorRef); 367 } else { 368 $downloadType = lc $downloadType; 369 my $mimeType = prepareHardcopy($tempTexFileBaseName, $downloadType); 370 371 my ($setName, $userName); 372 &attachProbSetRecord($first_psvn); 373 if($downloadMulti eq "multistudent") { 374 if($num_psvns_to_download == 1) { 375 $setName = getSetNumber($first_psvn); 376 $userName = getStudentLogin($first_psvn); 377 } else { 378 $setName = getSetNumber($first_psvn); 379 $userName = "multistudent"; 380 } 381 } elsif($downloadMulti eq "multiset") { 382 if($num_psvns_to_download == 1) { 383 $setName = getSetNumber($first_psvn); 384 $userName = getStudentLogin($first_psvn); 385 } else { 386 $setName = "multiset"; 387 $userName = getStudentLogin($first_psvn); 388 } 389 } 390 my $hardCopyName = "$Course.$userName.$setName.$downloadType"; 391 392 open(TEXINPUT, "$tempTexFileBaseName.$downloadType") 393 or wwerror($0, "Can't open $tempTexFileBaseName.$downloadType: $!\n"); 394 print "Content-type: $mimeType\n"; 395 print "Content-disposition: attachment; filename=\"$hardCopyName\"\n\n"; 396 print while (<TEXINPUT>); 397 close TEXINPUT; 398 } 399 } 400 401 ################### 402 # createTexSource # 403 ################### 404 405 sub createTexSource { 406 my $psvn = shift; 407 408 # Check that the psvn corresponds to the user and that it is after the open date. 409 # This should only fail if someone is trying to break into WeBWorK. 410 &attachProbSetRecord($psvn); 411 $login_name_for_psvn = &getStudentLogin($psvn); 412 attachCLRecord($login_name_for_psvn); 413 414 if ((($User ne &getStudentLogin($psvn)) ||($currentTime < $odts)) 415 and ($permissions != $Global::instructor_permissions) 416 and ($permissions != $Global::TA_permissions)) 417 { 418 &hackerError; 419 exit; 420 } 421 422 my $probSetHeader = $Global::SET_HEADER; 423 my $setHeaderFileName = &getSetHeaderFileName($psvn); 424 425 my $answersRequestedQ = 0; 426 $answersRequestedQ= $inputs{'ShowAns'} if defined($inputs{'ShowAns'}); 427 428 my $adts=&getAnswerDate($psvn); 429 my $displayCorrectAnswersQ = 0; #initialize 430 $displayCorrectAnswersQ =1 if $answersRequestedQ && ($currentTime > $adts); 431 $displayCorrectAnswersQ =1 if $answersRequestedQ && ($permissions == $Global::instructor_permissions); 432 433 my $texSource =''; 434 435 print STDERR "%%Creating a tex version of set $setNumber<BR>\n" if $debugON; 436 print STDERR "%%For", &CL_getStudentName($login_name_for_psvn), "psvn=$psvn<BR>\n" if $debugON; 437 438 # print TeX preamble and header 439 $texSource .= &texInput($Global::TEX_SET_PREAMBLE); 440 $texSource .= &texInput($Global::TEX_SET_HEADER); 441 442 # print set header 443 my $mode = "TeX"; 444 my @PG_COMPILE_ERRORS = (); 445 if ((defined($setHeaderFileName)) and $setHeaderFileName =~ /\S/) { 446 $probSetHeader = $setHeaderFileName; 447 } 448 if (open(INPUT,"${templateDirectory}$probSetHeader")) { 449 $probSetHeader =~ /\.([^\.]*)$/; 450 my $displayMode = $1; 451 452 if ($displayMode eq 'pg') { 453 my %envir=defineProblemEnvir($mode, 0, $psvn, $Course, undef()); 454 my $input_string= join("",<INPUT>); 455 my ($PG_PROBLEM_TEXT_REF, $PG_HEADER_TEXT_REF, $PG_ANSWER_HASH_REF, $PG_FLAGS_REF); 456 457 # BEGIN fork 458 if (open TEX_PIPE, "-|") { 459 # parent: 460 local $/ = "\n"; 461 my $curr_pg_compile_error = <TEX_PIPE>; 462 chomp $curr_pg_compile_error; 463 push @PG_COMPILE_ERRORS, $curr_pg_compile_error if $curr_pg_compile_error; 464 465 undef $/; 466 $texSource .= <TEX_PIPE>; 467 } else { 468 # child: 469 $texSource = ''; # clear this at beginning of fork 470 @PG_COMPILE_ERRORS = (); # clear this as well 471 # ----- 472 my $pt = new PGtranslator; 473 $pt -> evaluate_modules( @{main::modules_to_evaluate}) ; 474 $pt -> load_extra_packages(@{main::extra_packages_to_be_loaded}); 475 # The variables in the two preceding lines are defined in PG_module_list.pl 476 # require "${courseScriptsDirectory}PG_module_list.pl"; 477 # (Modules are defined by require statement above found near the top of this file) 478 $pt->environment(\%envir); 479 $pt->initialize(); 480 $pt->set_mask(); 481 $pt->source_string($input_string); 482 $pt->unrestricted_load("${courseScriptsDirectory}PG.pl"); 483 $pt->unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl"); 484 $pt->translate(); 485 486 $PG_PROBLEM_TEXT_REF = $pt->ra_text(); 487 $PG_HEADER_TEXT_REF = $pt->r_header;#\$PG_HEADER_TEXT; 488 $PG_ANSWER_HASH_REF = $pt->rh_correct_answers; 489 $PG_FLAGS_REF = $pt->rh_flags; 490 491 $texSource .= join '', @{$PG_PROBLEM_TEXT_REF}; 492 493 # begin non-FORK code 494 # if (defined($PG_FLAGS_REF->{'error_flag'}) and $PG_FLAGS_REF->{'error_flag'} == 1) { 495 # push(@PG_COMPILE_ERRORS, qq{<A HREF="#problem0">$probSetHeader</A>} ); 496 # } 497 # end non-FORK code 498 499 # begin FORK-only code 500 my $stupid_forked_error_string; 501 if (defined($PG_FLAGS_REF->{'error_flag'}) and $PG_FLAGS_REF->{'error_flag'} ==1) { 502 $texSource = qq{<A HREF="#problem0">$probSetHeader</A>} . "\n" . $texSource; 503 } else { 504 $texSource = "\n" . $texSource; 505 } 506 # end FORK code 507 508 if (defined($Global::WARNINGS) and $Global::WARNINGS) { 509 my $warnings = '{\\bf WARNINGS:\par{\\tiny ' . $Global::WARNINGS . ' }}'; 510 $warnings =~ s|/|\\\-/|g; # allow linebreaks in the middle of URLs 511 $warnings =~ s/<br>/\\par\n/ig; # introduce breaks at linebreaks and paragraphs 512 $warnings =~ s/<p>/\\par\n/ig; 513 $warnings =~ s/\#/\\\#/g; # protect against some of the symbols which are reserved in tex 514 $warnings =~ s/\_/\\\_/g; 515 $warnings =~ s/\>/\\\>/g; 516 $warnings =~ s/\</\\\</g; 517 $texSource .= $warnings; 518 } 519 $Global::WARNINGS = ''; # reset the Global::WARNINGS parameter 520 # ----- 521 print $texSource; 522 exit; 523 } 524 # END fork 525 } else { 526 $texSource .= "Don't understand languages with extension $displayMode.<BR>\n"; 527 } 528 close INPUT; 529 } else { 530 print STDERR ( "Can't open ${templateDirectory}${probSetHeader}\n") if $debugON; 531 wwerror("$0", "\n######## Could not open the set header file: ${templateDirectory}${probSetHeader}","",""); 532 } 533 534 # Print problems 535 my @problems = sort { $a <=> $b } &getAllProblemsForProbSetRecord($psvn); 536 my @refSubmittedAnswers = (); 537 538 my $probNum; 539 foreach $probNum (@problems) { 540 my $source; 541 my $probFileName = &getProblemFileName($probNum,$psvn); 542 if (-e "${templateDirectory}$probFileName") { 543 unless (-r "${templateDirectory}$probFileName") { 544 wwerror($0, "Can't read ${templateDirectory}$probFileName"); 545 } 546 open(PROB,"<${templateDirectory}$probFileName"); 547 $source = join("",<PROB>); 548 close(PROB); 549 } 550 local($^W) =0; ##########CHANGE THIS BACK!!!! # what do you mean by that? 551 my %envir=defineProblemEnvir('TeX',$probNum,$psvn,$Course,undef()); 552 my ($PG_PROBLEM_TEXT_REF, $PG_HEADER_TEXT_REF, $PG_ANSWER_HASH_REF, $PG_FLAGS_REF,$PG_EVALUATED_ANSWERS_REF); 553 554 # BEGIN fork 555 if (open TEX_PIPE, "-|") { 556 # parent: 557 local $/ = "\n"; 558 my $curr_pg_compile_error = <TEX_PIPE>; 559 chomp $curr_pg_compile_error; 560 push @PG_COMPILE_ERRORS, $curr_pg_compile_error if $curr_pg_compile_error; 561 562 undef $/; 563 $texSource .= <TEX_PIPE>; 564 } else { 565 # child: 566 $texSource = ''; # clear this at beginning of fork 567 @PG_COMPILE_ERRORS = (); # clear this as well 568 # ----- 569 my $pt = new PGtranslator; #pt stands for problem translator; 570 $pt->environment(\%envir) ; 571 $pt->initialize(); 572 $pt-> set_mask(); 573 $pt->source_string($source); 574 $pt->unrestricted_load("${courseScriptsDirectory}PG.pl"); 575 $pt->unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl"); 576 $pt->translate(); 577 578 $PG_PROBLEM_TEXT_REF = $pt->ra_text(); 579 $PG_HEADER_TEXT_REF = $pt->r_header;#\$PG_HEADER_TEXT; 580 #$PG_ANSWER_HASH_REF = $pt->rh_correct_answers; 581 $PG_EVALUATED_ANSWERS_REF = $pt->process_answers; 582 $PG_FLAGS_REF = $pt ->rh_flags; 583 584 $texSource .= join '', @{$PG_PROBLEM_TEXT_REF}; 585 586 # begin non-FORK code 587 # if (defined($PG_FLAGS_REF->{'error_flag'}) and $PG_FLAGS_REF->{'error_flag'} ==1) { 588 # push(@PG_COMPILE_ERRORS, qq{<A HREF="#problem$probNum">$probNum</A>} ); 589 # } 590 # end non-FORK code 591 592 # begin FORK-only code 593 if (defined($PG_FLAGS_REF->{'error_flag'}) and $PG_FLAGS_REF->{'error_flag'} ==1) { 594 $texSource = qq{<A HREF="#problem$probNum">$probNum</A>} . "\n" . $texSource; 595 } else { 596 $texSource = "\n" . $texSource; 597 } 598 # end FORK code 599 600 if ($displayCorrectAnswersQ) { 601 my %correctAnswerHash = (); 602 my @correctAnswerList = (); 603 my %submittedAnswerHash = (); 604 605 if (ref($PG_EVALUATED_ANSWERS_REF) eq 'HASH') { 606 %correctAnswerHash = %$PG_EVALUATED_ANSWERS_REF; 607 } else { 608 warn "ERROR: Please pass the PG answer list as a hash not a list."; 609 } 610 611 if (%correctAnswerHash) { 612 my ($correctFlag,$normalizedCorrectAnswer, 613 $normalizedSubmittedAnswer, 614 $answerMessage) = (); 615 616 # determine the correct order for the answers 617 my @answer_entry_order = 618 (defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER})) 619 ? @{$pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}} 620 : keys %{$pt->rh_evaluated_answers}; 621 622 $texSource .= "Correct Answers:\\par\\begin{itemize}\n"; 623 foreach my $ky (@answer_entry_order) { 624 $normalizedCorrectAnswer = $correctAnswerHash{$ky}->{correct_ans}; 625 $normalizedCorrectAnswer =~ s/\^/\\\^\{\}/g; 626 $normalizedCorrectAnswer =~ s/\_/\\\_/g; 627 $texSource .= "\\item $normalizedCorrectAnswer\n"; 628 629 } 630 $texSource .= "\\end{itemize} \\par\n"; 631 } 632 } 633 634 if (defined($Global::WARNINGS) and $Global::WARNINGS) { 635 my $warnings = '{\\bf WARNINGS:\par{\\tiny ' . $Global::WARNINGS . ' }}'; 636 unless (@PG_COMPILE_ERRORS) { # prepare warnings for TeX output in this case 637 $warnings =~ s|/|\\\-/|g; # allow linebreaks in the middle of URLs 638 $warnings =~ s/<br>/\\par\n/ig; # introduce breaks at linebreaks and paragraphs 639 $warnings =~ s/<p>/\\par\n/ig; 640 $warnings =~ s/\#/\\\#/g; # protect against some of the symbols which are reserved in tex 641 $warnings =~ s/\_/\\\_/g; 642 $warnings =~ s/\>/\\\>/g; 643 $warnings =~ s/\</\\\</g; 644 $texSource .= $warnings; 645 } 646 } 647 $Global::WARNINGS = ''; #reset the Global::WARNINGS parameter 648 # ----- 649 print $texSource; 650 exit; 651 } 652 # END fork 653 } # this is the end of the foreach problem loop 654 655 # print Tex postamble 656 $texSource .= &texInput($Global::TEX_SET_FOOTER); 657 658 return \$texSource, \@PG_COMPILE_ERRORS; 659 } 660 661 ################### 662 # prepareHardcopy # 663 ################### 664 665 sub prepareHardcopy 666 { 667 my ($texFileBaseName, $targetFormat) = @_; 668 my $mimeType; 669 670 chdir $tempDirectory; 671 672 my $dviCommandLine = "$Global::externalLatexPath $texFileBaseName.tex >/dev/null 2>/dev/null"; 673 my $psCommandLine = "$Global::externalDvipsPath -o $texFileBaseName.ps $texFileBaseName.dvi >/dev/null 2>/dev/null"; 674 my $pdfCommandLine = "$Global::externalPs2pdfPath $texFileBaseName.ps $texFileBaseName.pdf"; 675 676 # make sure that you are not using old copies of the following files: 677 unlink("$texFileBaseName.dvi","$texFileBaseName.ps", "$texFileBaseName.pdf"); 678 679 # we use logPrint() for TeX->DVI errors as they are usually caused 680 if($targetFormat eq "pdf") { 681 system($dviCommandLine); -e "$texFileBaseName.dvi" or &logPrint($texFileBaseName); 682 system($psCommandLine); -e "$texFileBaseName.ps" or die "ps generation failed."; 683 system($pdfCommandLine); -e "$texFileBaseName.pdf" or die "pdf generation failed."; 684 $mimeType = "application/pdf"; 685 } elsif($targetFormat eq "ps") { 686 system($dviCommandLine); -e "$texFileBaseName.dvi" or &logPrint($texFileBaseName); 687 system($psCommandLine); -e "$texFileBaseName.ps" or die "ps generation failed."; 688 $mimeType = "application/postscript"; 689 } elsif($targetFormat eq "dvi") { 690 system($dviCommandLine); -e "$texFileBaseName.dvi" or &logPrint($texFileBaseName); 691 $mimeType = "application/x-dvi"; 692 } elsif($targetFormat eq "tex") { 693 $mimeType = "application/tex"; 694 } else { 695 die "unrecognized format: $targetFormat"; 696 } 697 698 return $mimeType; 699 } 700 701 ################## 702 # PG_error_print # 703 ################## 704 705 sub PG_error_print 706 { 707 my ($tempTexFileBaseName, $current_psvn, @errors) = @_; 708 709 # get set name and student name from psvn 710 &attachProbSetRecord($current_psvn); 711 my $userName = &getStudentLogin($current_psvn); 712 my $setName = &getSetNumber($current_psvn); 713 714 # print error page header 715 print &htmlTOP("PG compile error"); 716 print "<H3>PG error while compiling problem number", (@errors>1) ? 's ' : ' ', 717 join(', ', @errors), " in problem set $setName for $userName.</H3>"; 718 print "<h3>TeX source file:</h3>"; 719 720 # open temp tex file 721 if(open TEXINPUT, "$tempTexFileBaseName.tex") { 722 print "<pre>\n"; 723 my $lineNumber = 1; 724 while(<TEXINPUT>) { 725 if(/<A NAME/) { print $_; } 726 else { print protect_HTML("$lineNumber $_"), "\n"; } 727 $lineNumber++; 728 } 729 print "</pre>\n"; 730 close TEXINPUT; 731 } else { 732 print "<p>Unable to open TeX source file:<br><tt>$tempTexFileBaseName.tex</tt></p>"; 733 } 734 735 # print page footer 736 print &htmlBOTTOM("welcomeAction.pl", \%inputs); 737 exit; 738 } 739 740 sub logPrint { 741 my $texFileBaseName=shift; 742 print &htmlTOP("TeX Error or error in creating PostScript file"); 743 open (LOGFILE, " $texFileBaseName.log") 744 || print "<H3>Can't open log file:</H3> path= $texFileBaseName.log<BR>$!<BR><BR>" ; 745 746 747 print "<H3>TeX Error Log:</H3>"; 748 my $print_error_switch = ($debugON) ? 1: 0; 749 my $out=''; 750 #warn ord $/, ord "\n", ord "\r"; 751 #warn "length of separator = ", length($/); 752 $/ = "\n"; 753 #warn ord $/, ord "\n", ord "\r"; 754 while (<LOGFILE>) { 755 $out = $_; 756 $print_error_switch = 1 if $out =~ /^!/; # after a fatal error start printing messages 757 print protect_HTML($out)."<BR>\n" if $print_error_switch; 758 } 759 close(LOGFILE); 760 761 open (TEXFILE, "$texFileBaseName.tex") 762 || print "<H3>Can't open tex source file:</H3> path= $texFileBaseName.tex:<BR> $!<BR><BR>\n"; 763 print "<BR>\n<H3>TeX Source File:</H3><BR>\n"; 764 print "<PRE>"; 765 766 my $lineNumber = 1; 767 while (<TEXFILE>) { 768 print protect_HTML("$lineNumber $_")."\n"; 769 $lineNumber++; 770 } 771 close(TEXFILE); 772 print "</PRE>"; 773 print &htmlBOTTOM("welcomeAction.pl", \%inputs); 774 } 775 sub protect_HTML { 776 my $line = shift; 777 chomp($line); 778 $line =~s/\&/&/g; 779 $line =~s/</</g; 780 $line =~s/>/>/g; 781 $line; 782 } 783 sub selectionError { 784 print &htmlTOP("Selection error"); 785 print"<H2>Error:</H2> You must first select a problem set in order to download a hard copy!\n"; 786 print "<FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P>"; 787 print &sessionKeyInputs(\%inputs); 788 print <<"ENDOFHTML"; 789 <INPUT TYPE=SUBMIT VALUE="Return to Welcome Page"> 790 </FORM> 791 ENDOFHTML 792 print &htmlBOTTOM("welcomeAction.pl", \%inputs); 793 } 794 795 sub probSet_htmlTOP { 796 my ($title, $bg_url) = @_; 797 my $background_url = $bg_url || $Global::background_plain_url; 798 799 800 my $out = <<ENDhtmlTOP; 801 content-type: text/html 802 Expires: 0 803 804 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd"> 805 <HTML> 806 <HEAD> 807 <TITLE>$title</TITLE> 808 </HEAD> 809 <BODY BACKGROUND="$background_url"><p> 810 <P> 811 812 ENDhtmlTOP 813 $out; 814 } 815 816 sub probSet_titleBar { 817 my ($title) = @_; 818 my $title_bar = ""; 819 $title_bar .= qq{ 820 <TABLE BORDER="0" WIDTH="100%"> 821 <TR ALIGN=CENTER > 822 <TD ALIGN=LEFT > 823 <A HREF="$Global::webworkDocsURL"> 824 <IMG SRC="$Global::squareWebworkGif" BORDER=1 ALT="WeBWorK"></A> 825 </TD> 826 <TD VALIGN=MIDDLE> 827 <H2 ALIGN=CENTER> 828 $title 829 </H2> 830 </TD> 831 <TD ALIGN=RIGHT > 832 <FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P> 833 }; 834 my $inputkeys = &sessionKeyInputs(\%inputs); 835 836 $title_bar .= qq{ 837 $inputkeys 838 <INPUT TYPE=HIDDEN NAME=\"probSetKey\" VALUE=$psvn> 839 <INPUT TYPE=SUBMIT VALUE=\"Problem Sets\"> 840 </FORM> 841 </TD> 842 </TABLE> 843 }; 844 $title_bar; 845 } 846 847 sub hackerError { ## prints hacker error message 848 849 my $msg = "Attempt to hack into WeBWorK \n Remote Host is: ". remote_host()."\n"; 850 $msg .= query_string; 851 &Global::log_error('hacker error', $msg); ## log attempt 852 853 ## notify by email 854 855 my $toAdd = $Global::feedbackAddress; 856 857 my $emailMsg = "To: $toAdd 858 Subject: Attempt to hack into WeBWorK 859 860 Here are the details on the attempt to hack into weBWorK:\n 861 $msg 862 \n"; 863 864 my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>20); 865 $smtp->mail($Global::webmaster); 866 $smtp->recipient($Global::feedbackAddress); 867 $smtp->data($msg); 868 $smtp->quit; 869 870 871 # my $SENDMAIL = $Global::SENDMAIL; 872 # open (MAIL,"|$SENDMAIL"); 873 # print MAIL "$emailMsg"; 874 # close (MAIL); 875 876 print &htmlTOP("Hacker Error"), 877 "<H2>Error:Please do not try to hack into WeBWorK!</H2>", 878 startform(-action=>"${Global::cgiWebworkURL}${Global::welcomeAction_CGI}"), 879 "<p>", 880 &sessionKeyInputs(\%inputs), 881 hidden(-name=>'local_psvns', -value=>$psvn), 882 hidden(-name=>'action', -value=>'Do_problem_set'), 883 submit(-value=>"Return to Problem Set"), 884 endform(), 885 &htmlBOTTOM($0, \%inputs); 886 } 887 888 sub defineProblemEnvir { 889 my ($mode,$probNum,$psvn,$courseName,$refSubmittedAnswers) = @_; 890 my %envir=(); 891 my $loginName = &getStudentLogin($psvn); 892 ##how to put an array submittedAnswers in a hash?? 893 $envir{'refSubmittedAnswers'} = $refSubmittedAnswers if defined($refSubmittedAnswers); 894 $envir{'psvnNumber'} = $psvn; 895 $envir{'psvn'} = $psvn; 896 $envir{'studentName'} = &CL_getStudentName($loginName); 897 $envir{'studentLogin'} = $loginName; 898 $envir{'sectionName'} = &CL_getClassSection($loginName); 899 $envir{'sectionNumber'} = &CL_getClassSection($loginName); 900 $envir{'recitationName'} = &CL_getClassRecitation($loginName); 901 $envir{'recitationNumber'} = &CL_getClassRecitation($loginName); 902 $envir{'setNumber'} = &getSetNumber($psvn); 903 $envir{'questionNumber'} = $probNum; 904 $envir{'probNum'} = $probNum; 905 $envir{'openDate'} = &getOpenDate($psvn); 906 $envir{'formatedOpenDate'} = &formatDateAndTime(&getOpenDate($psvn)); 907 $envir{'formattedOpenDate'} = &formatDateAndTime(&getOpenDate($psvn)); 908 $envir{'dueDate'} = &getDueDate($psvn); 909 $envir{'formatedDueDate'} = &formatDateAndTime(&getDueDate($psvn)); 910 $envir{'formattedDueDate'} = &formatDateAndTime(&getDueDate($psvn)); 911 $envir{'answerDate'} = &getAnswerDate($psvn); 912 $envir{'formatedAnswerDate'} = &formatDateAndTime(&getAnswerDate($psvn)); 913 $envir{'formattedAnswerDate'} = &formatDateAndTime(&getAnswerDate($psvn)); 914 $envir{'problemValue'} = &getProblemValue($probNum,$psvn); 915 $envir{'fileName'} = &getProblemFileName($probNum,$psvn); 916 $envir{'probFileName'} = &getProblemFileName($probNum,$psvn); 917 $envir{'languageMode'} = $mode; 918 $envir{'displayMode'} = $mode; 919 $envir{'outputMode'} = $mode; 920 $envir{'courseName'} = $courseName; 921 $envir{'sessionKey'} = ( defined($inputs{'key'}) ) ?$inputs{'key'} : " "; 922 923 # initialize constants for PGanswermacros.pl 924 $envir{'numRelPercentTolDefault'} = getNumRelPercentTolDefault(); 925 $envir{'numZeroLevelDefault'} = getNumZeroLevelDefault(); 926 $envir{'numZeroLevelTolDefault'} = getNumZeroLevelTolDefault(); 927 $envir{'numAbsTolDefault'} = getNumAbsTolDefault(); 928 $envir{'numFormatDefault'} = getNumFormatDefault(); 929 $envir{'functRelPercentTolDefault'} = getFunctRelPercentTolDefault(); 930 $envir{'functZeroLevelDefault'} = getFunctZeroLevelDefault(); 931 $envir{'functZeroLevelTolDefault'} = getFunctZeroLevelTolDefault(); 932 $envir{'functAbsTolDefault'} = getFunctAbsTolDefault(); 933 $envir{'functNumOfPoints'} = getFunctNumOfPoints(); 934 $envir{'functVarDefault'} = getFunctVarDefault(); 935 $envir{'functLLimitDefault'} = getFunctLLimitDefault(); 936 $envir{'functULimitDefault'} = getFunctULimitDefault(); 937 $envir{'functMaxConstantOfIntegration'} = getFunctMaxConstantOfIntegration(); 938 $envir{'numOfAttempts'} = undef(); # this is defined only for problems 939 940 # defining directorys and URLs 941 $envir{'templateDirectory'} = &getCourseTemplateDirectory(); 942 $envir{'classDirectory'} = $Global::classDirectory; 943 $envir{'cgiDirectory'} = $Global::cgiDirectory; 944 $envir{'macroDirectory'} = getCourseMacroDirectory(); 945 $envir{'courseScriptsDirectory'} = getCourseScriptsDirectory(); 946 $envir{'htmlDirectory'} = getCourseHtmlDirectory(); 947 $envir{'htmlURL'} = getCourseHtmlURL(); 948 $envir{'tempDirectory'} = getCourseTempDirectory(); 949 $envir{'tempURL'} = getCourseTempURL(); 950 $envir{'scriptDirectory'} = $Global::scriptDirectory; 951 $envir{'webworkDocsURL'} = $Global::webworkDocsURL; 952 $envir{'externalTTHPath'} = $Global::externalTTHPath; 953 954 955 $envir{'inputs_ref'} = \%inputs; 956 957 958 my $seed = &getProblemSeed($probNum, $psvn); 959 $seed = 1111 unless defined($seed); 960 $envir{'problemSeed'} = $seed if defined($seed); 961 962 # here is a way to pass environment variables defined in webworkCourse.ph 963 my $k; 964 foreach $k (keys %Global::PG_environment ) { 965 $envir{$k} = $Global::PG_environment{$k}; 966 } 967 %envir; 968 } 969 970 ################################################################################ 971 # cleanup routines ############################################################# 972 ################################################################################ 973 974 BEGIN { 975 # This subroutine cleans up temporary files after the postscript copy has been created. 976 sub cleanup_downloadPS { 977 unless (defined($action) and ($action eq 'Do problem set' or $action eq 'Do_problem_set')) { 978 my $ERRORS = $save_errors; 979 unless ($debugON) { 980 eval { 981 chdir $tempDirectory; 982 unlink( 983 "#tempTexFileBaseName.dvi", 984 "$tempTexFileBaseName.ps", 985 "$tempTexFileBaseName.pdf", 986 "$tempTexFileBaseName.log", 987 "$tempTexFileBaseName.aux", 988 "$tempTexFileBaseName.tex" 989 ); 990 unlink("${tempDirectory}eps/${login_name_for_psvn}*.eps"); 991 }; 992 $ERRORS .= $ERRORS . $@; 993 } 994 my $query = query_string(); 995 $query = "" unless defined($query); 996 wwerror("$0", "ERROR: in downloadPS subroutine of welcomeAction.pl $ERRORS","","",$query) if $ERRORS; 997 } 998 } 999 } 1000 1001 END { 1002 if (defined($main::SIG_TIME_OUT) && $main::SIG_TIME_OUT == 1) { 1003 alarm(0); # turn off the alarm 1004 my $hard_copy_message = qq{Content-type: text/html\n\n 1005 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd"> 1006 <HTML><BODY BGCOLOR = "FF99CC"> 1007 <BLOCKQUOTE><H3>WeBWorK hard copy download time out.</H3>\n 1008 <H4>This download was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.</H4> This may be because the 1009 WeBWorK server is extraordinarily busy, or because there was an error in the problem, 1010 or because you tried to download a set with too many problems (more than 50).<P>\n 1011 Use the back button to return to the previous page and try again.<BR>\n 1012 If the problem is repeated you can report this to your instructor using the feedback button. 1013 <P> 1014 Because the WeBWorK server at the Unversity of Rochester is experiencing heavy use we have made downloading 1015 hard copies a low priority during the times of very heavy useage. It will be helpful if you 1016 download hard copies during times when the load is not too heavy. 1017 <P> 1018 The load is usually heaviest in the evenings , particularly a few hours before assignments 1019 are due. The best times to download hard copies are in the morning and afternoon 1020 -- or an hour after the due date and time of the previous assignment -- nobody is using the system then :-) 1021 </BLOCKQUOTE></BODY></HTML> 1022 }; 1023 my $do_problem_message = qq{Content-type: text/html\n\n 1024 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd"> 1025 <HTML><BODY BGCOLOR = "FF99CC"> 1026 <BLOCKQUOTE><H3>WeBWorK heavy useage time out.</H3>\n 1027 <H4>Your request (action = $action) was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.</H4> 1028 This is probably because the 1029 WeBWorK server is extraordinarily busy.<P>\n 1030 You should be warned that WeBWorK response will be unusually slow. If possible you should try 1031 to use WeBWorK at another time when the load is not as high. The highest useage periods are in the 1032 evening, particularly in the two hours before assignments are due.<P>\n 1033 Use the back button to return to the previous page and try again.<P>\n 1034 If the high useage problem continues you can report this to your instructor using the feedback button. 1035 <P> 1036 1037 </BLOCKQUOTE></BODY></HTML> 1038 }; 1039 if ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') { 1040 print $hard_copy_message; 1041 } else{ 1042 print $do_problem_message; 1043 } 1044 1045 1046 } 1047 1048 # begin Timing code 1049 if( $main::logTimingData == 1 ) { 1050 my $endTime = new Benchmark; 1051 my $error_str=''; 1052 1053 if ($main::SIGPIPE) { 1054 $error_str = 'broken PIPE--'; 1055 } elsif ($main::SIG_TIME_OUT) { 1056 $error_str = "TIME_OUT after $main::TIME_OUT_CONSTANT secs --"; 1057 } elsif ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') { 1058 $error_str = 'successful download -- '; 1059 } 1060 1061 &Global::logTimingInfo($main::beginTime,$endTime,$error_str.'welcomeAction.pl',$Course,$User); 1062 } 1063 # end Timing code 1064 1065 cleanup_downloadPS(); 1066 } 1067 1068 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |