Parent Directory
| 
Revision Log
Changed pdf generation process in welcomeAction.pl to use ghostscript directly rather than calling ps2pdf. Removed $Global::externalPs2pdfPath and added $Global::externalGsPath.
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::externalGsPath -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$texFileBaseName.pdf -c save pop -f $texFileBaseName.ps"; 675 # my $pdfCommandLine = "$Global::externalPs2pdfPath $texFileBaseName.ps $texFileBaseName.pdf"; 676 677 # make sure that you are not using old copies of the following files: 678 unlink("$texFileBaseName.dvi","$texFileBaseName.ps", "$texFileBaseName.pdf"); 679 680 # we use logPrint() for TeX->DVI errors as they are usually caused 681 if($targetFormat eq "pdf") { 682 system($dviCommandLine); -e "$texFileBaseName.dvi" or &logPrint($texFileBaseName); 683 system($psCommandLine); -e "$texFileBaseName.ps" or die "ps generation failed."; 684 system($pdfCommandLine); -e "$texFileBaseName.pdf" or die "pdf generation failed."; 685 $mimeType = "application/pdf"; 686 } elsif($targetFormat eq "ps") { 687 system($dviCommandLine); -e "$texFileBaseName.dvi" or &logPrint($texFileBaseName); 688 system($psCommandLine); -e "$texFileBaseName.ps" or die "ps generation failed."; 689 $mimeType = "application/postscript"; 690 } elsif($targetFormat eq "dvi") { 691 system($dviCommandLine); -e "$texFileBaseName.dvi" or &logPrint($texFileBaseName); 692 $mimeType = "application/x-dvi"; 693 } elsif($targetFormat eq "tex") { 694 $mimeType = "application/tex"; 695 } else { 696 die "unrecognized format: $targetFormat"; 697 } 698 699 return $mimeType; 700 } 701 702 ################## 703 # PG_error_print # 704 ################## 705 706 sub PG_error_print 707 { 708 my ($tempTexFileBaseName, $current_psvn, @errors) = @_; 709 710 # get set name and student name from psvn 711 &attachProbSetRecord($current_psvn); 712 my $userName = &getStudentLogin($current_psvn); 713 my $setName = &getSetNumber($current_psvn); 714 715 # print error page header 716 print &htmlTOP("PG compile error"); 717 print "<H3>PG error while compiling problem number", (@errors>1) ? 's ' : ' ', 718 join(', ', @errors), " in problem set $setName for $userName.</H3>"; 719 print "<h3>TeX source file:</h3>"; 720 721 # open temp tex file 722 if(open TEXINPUT, "$tempTexFileBaseName.tex") { 723 print "<pre>\n"; 724 my $lineNumber = 1; 725 while(<TEXINPUT>) { 726 if(/<A NAME/) { print $_; } 727 else { print protect_HTML("$lineNumber $_"), "\n"; } 728 $lineNumber++; 729 } 730 print "</pre>\n"; 731 close TEXINPUT; 732 } else { 733 print "<p>Unable to open TeX source file:<br><tt>$tempTexFileBaseName.tex</tt></p>"; 734 } 735 736 # print page footer 737 print &htmlBOTTOM("welcomeAction.pl", \%inputs); 738 exit; 739 } 740 741 sub logPrint { 742 my $texFileBaseName=shift; 743 print &htmlTOP("TeX Error or error in creating PostScript file"); 744 open (LOGFILE, " $texFileBaseName.log") 745 || print "<H3>Can't open log file:</H3> path= $texFileBaseName.log<BR>$!<BR><BR>" ; 746 747 748 print "<H3>TeX Error Log:</H3>"; 749 my $print_error_switch = ($debugON) ? 1: 0; 750 my $out=''; 751 #warn ord $/, ord "\n", ord "\r"; 752 #warn "length of separator = ", length($/); 753 $/ = "\n"; 754 #warn ord $/, ord "\n", ord "\r"; 755 while (<LOGFILE>) { 756 $out = $_; 757 $print_error_switch = 1 if $out =~ /^!/; # after a fatal error start printing messages 758 print protect_HTML($out)."<BR>\n" if $print_error_switch; 759 } 760 close(LOGFILE); 761 762 open (TEXFILE, "$texFileBaseName.tex") 763 || print "<H3>Can't open tex source file:</H3> path= $texFileBaseName.tex:<BR> $!<BR><BR>\n"; 764 print "<BR>\n<H3>TeX Source File:</H3><BR>\n"; 765 print "<PRE>"; 766 767 my $lineNumber = 1; 768 while (<TEXFILE>) { 769 print protect_HTML("$lineNumber $_")."\n"; 770 $lineNumber++; 771 } 772 close(TEXFILE); 773 print "</PRE>"; 774 print &htmlBOTTOM("welcomeAction.pl", \%inputs); 775 } 776 sub protect_HTML { 777 my $line = shift; 778 chomp($line); 779 $line =~s/\&/&/g; 780 $line =~s/</</g; 781 $line =~s/>/>/g; 782 $line; 783 } 784 sub selectionError { 785 print &htmlTOP("Selection error"); 786 print"<H2>Error:</H2> You must first select a problem set in order to download a hard copy!\n"; 787 print "<FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P>"; 788 print &sessionKeyInputs(\%inputs); 789 print <<"ENDOFHTML"; 790 <INPUT TYPE=SUBMIT VALUE="Return to Welcome Page"> 791 </FORM> 792 ENDOFHTML 793 print &htmlBOTTOM("welcomeAction.pl", \%inputs); 794 } 795 796 sub probSet_htmlTOP { 797 my ($title, $bg_url) = @_; 798 my $background_url = $bg_url || $Global::background_plain_url; 799 800 801 my $out = <<ENDhtmlTOP; 802 content-type: text/html 803 Expires: 0 804 805 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd"> 806 <HTML> 807 <HEAD> 808 <TITLE>$title</TITLE> 809 </HEAD> 810 <BODY BACKGROUND="$background_url"><p> 811 <P> 812 813 ENDhtmlTOP 814 $out; 815 } 816 817 sub probSet_titleBar { 818 my ($title) = @_; 819 my $title_bar = ""; 820 $title_bar .= qq{ 821 <TABLE BORDER="0" WIDTH="100%"> 822 <TR ALIGN=CENTER > 823 <TD ALIGN=LEFT > 824 <A HREF="$Global::webworkDocsURL"> 825 <IMG SRC="$Global::squareWebworkGif" BORDER=1 ALT="WeBWorK"></A> 826 </TD> 827 <TD VALIGN=MIDDLE> 828 <H2 ALIGN=CENTER> 829 $title 830 </H2> 831 </TD> 832 <TD ALIGN=RIGHT > 833 <FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P> 834 }; 835 my $inputkeys = &sessionKeyInputs(\%inputs); 836 837 $title_bar .= qq{ 838 $inputkeys 839 <INPUT TYPE=HIDDEN NAME=\"probSetKey\" VALUE=$psvn> 840 <INPUT TYPE=SUBMIT VALUE=\"Problem Sets\"> 841 </FORM> 842 </TD> 843 </TABLE> 844 }; 845 $title_bar; 846 } 847 848 sub hackerError { ## prints hacker error message 849 850 my $msg = "Attempt to hack into WeBWorK \n Remote Host is: ". remote_host()."\n"; 851 $msg .= query_string; 852 &Global::log_error('hacker error', $msg); ## log attempt 853 854 ## notify by email 855 856 my $toAdd = $Global::feedbackAddress; 857 858 my $emailMsg = "To: $toAdd 859 Subject: Attempt to hack into WeBWorK 860 861 Here are the details on the attempt to hack into weBWorK:\n 862 $msg 863 \n"; 864 865 my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>20); 866 $smtp->mail($Global::webmaster); 867 $smtp->recipient($Global::feedbackAddress); 868 $smtp->data($msg); 869 $smtp->quit; 870 871 872 # my $SENDMAIL = $Global::SENDMAIL; 873 # open (MAIL,"|$SENDMAIL"); 874 # print MAIL "$emailMsg"; 875 # close (MAIL); 876 877 print &htmlTOP("Hacker Error"), 878 "<H2>Error:Please do not try to hack into WeBWorK!</H2>", 879 startform(-action=>"${Global::cgiWebworkURL}${Global::welcomeAction_CGI}"), 880 "<p>", 881 &sessionKeyInputs(\%inputs), 882 hidden(-name=>'local_psvns', -value=>$psvn), 883 hidden(-name=>'action', -value=>'Do_problem_set'), 884 submit(-value=>"Return to Problem Set"), 885 endform(), 886 &htmlBOTTOM($0, \%inputs); 887 } 888 889 sub defineProblemEnvir { 890 my ($mode,$probNum,$psvn,$courseName,$refSubmittedAnswers) = @_; 891 my %envir=(); 892 my $loginName = &getStudentLogin($psvn); 893 ##how to put an array submittedAnswers in a hash?? 894 $envir{'refSubmittedAnswers'} = $refSubmittedAnswers if defined($refSubmittedAnswers); 895 $envir{'psvnNumber'} = $psvn; 896 $envir{'psvn'} = $psvn; 897 $envir{'studentName'} = &CL_getStudentName($loginName); 898 $envir{'studentLogin'} = $loginName; 899 $envir{'sectionName'} = &CL_getClassSection($loginName); 900 $envir{'sectionNumber'} = &CL_getClassSection($loginName); 901 $envir{'recitationName'} = &CL_getClassRecitation($loginName); 902 $envir{'recitationNumber'} = &CL_getClassRecitation($loginName); 903 $envir{'setNumber'} = &getSetNumber($psvn); 904 $envir{'questionNumber'} = $probNum; 905 $envir{'probNum'} = $probNum; 906 $envir{'openDate'} = &getOpenDate($psvn); 907 $envir{'formatedOpenDate'} = &formatDateAndTime(&getOpenDate($psvn)); 908 $envir{'formattedOpenDate'} = &formatDateAndTime(&getOpenDate($psvn)); 909 $envir{'dueDate'} = &getDueDate($psvn); 910 $envir{'formatedDueDate'} = &formatDateAndTime(&getDueDate($psvn)); 911 $envir{'formattedDueDate'} = &formatDateAndTime(&getDueDate($psvn)); 912 $envir{'answerDate'} = &getAnswerDate($psvn); 913 $envir{'formatedAnswerDate'} = &formatDateAndTime(&getAnswerDate($psvn)); 914 $envir{'formattedAnswerDate'} = &formatDateAndTime(&getAnswerDate($psvn)); 915 $envir{'problemValue'} = &getProblemValue($probNum,$psvn); 916 $envir{'fileName'} = &getProblemFileName($probNum,$psvn); 917 $envir{'probFileName'} = &getProblemFileName($probNum,$psvn); 918 $envir{'languageMode'} = $mode; 919 $envir{'displayMode'} = $mode; 920 $envir{'outputMode'} = $mode; 921 $envir{'courseName'} = $courseName; 922 $envir{'sessionKey'} = ( defined($inputs{'key'}) ) ?$inputs{'key'} : " "; 923 924 # initialize constants for PGanswermacros.pl 925 $envir{'numRelPercentTolDefault'} = getNumRelPercentTolDefault(); 926 $envir{'numZeroLevelDefault'} = getNumZeroLevelDefault(); 927 $envir{'numZeroLevelTolDefault'} = getNumZeroLevelTolDefault(); 928 $envir{'numAbsTolDefault'} = getNumAbsTolDefault(); 929 $envir{'numFormatDefault'} = getNumFormatDefault(); 930 $envir{'functRelPercentTolDefault'} = getFunctRelPercentTolDefault(); 931 $envir{'functZeroLevelDefault'} = getFunctZeroLevelDefault(); 932 $envir{'functZeroLevelTolDefault'} = getFunctZeroLevelTolDefault(); 933 $envir{'functAbsTolDefault'} = getFunctAbsTolDefault(); 934 $envir{'functNumOfPoints'} = getFunctNumOfPoints(); 935 $envir{'functVarDefault'} = getFunctVarDefault(); 936 $envir{'functLLimitDefault'} = getFunctLLimitDefault(); 937 $envir{'functULimitDefault'} = getFunctULimitDefault(); 938 $envir{'functMaxConstantOfIntegration'} = getFunctMaxConstantOfIntegration(); 939 $envir{'numOfAttempts'} = undef(); # this is defined only for problems 940 941 # defining directorys and URLs 942 $envir{'templateDirectory'} = &getCourseTemplateDirectory(); 943 $envir{'classDirectory'} = $Global::classDirectory; 944 $envir{'cgiDirectory'} = $Global::cgiDirectory; 945 $envir{'macroDirectory'} = getCourseMacroDirectory(); 946 $envir{'courseScriptsDirectory'} = getCourseScriptsDirectory(); 947 $envir{'htmlDirectory'} = getCourseHtmlDirectory(); 948 $envir{'htmlURL'} = getCourseHtmlURL(); 949 $envir{'tempDirectory'} = getCourseTempDirectory(); 950 $envir{'tempURL'} = getCourseTempURL(); 951 $envir{'scriptDirectory'} = $Global::scriptDirectory; 952 $envir{'webworkDocsURL'} = $Global::webworkDocsURL; 953 $envir{'externalTTHPath'} = $Global::externalTTHPath; 954 955 956 $envir{'inputs_ref'} = \%inputs; 957 958 959 my $seed = &getProblemSeed($probNum, $psvn); 960 $seed = 1111 unless defined($seed); 961 $envir{'problemSeed'} = $seed if defined($seed); 962 963 # here is a way to pass environment variables defined in webworkCourse.ph 964 my $k; 965 foreach $k (keys %Global::PG_environment ) { 966 $envir{$k} = $Global::PG_environment{$k}; 967 } 968 %envir; 969 } 970 971 ################################################################################ 972 # cleanup routines ############################################################# 973 ################################################################################ 974 975 BEGIN { 976 # This subroutine cleans up temporary files after the postscript copy has been created. 977 sub cleanup_downloadPS { 978 unless (defined($action) and ($action eq 'Do problem set' or $action eq 'Do_problem_set')) { 979 my $ERRORS = $save_errors; 980 unless ($debugON) { 981 eval { 982 chdir $tempDirectory; 983 unlink( 984 "#tempTexFileBaseName.dvi", 985 "$tempTexFileBaseName.ps", 986 "$tempTexFileBaseName.pdf", 987 "$tempTexFileBaseName.log", 988 "$tempTexFileBaseName.aux", 989 "$tempTexFileBaseName.tex" 990 ); 991 unlink("${tempDirectory}eps/${login_name_for_psvn}*.eps"); 992 }; 993 $ERRORS .= $ERRORS . $@; 994 } 995 my $query = query_string(); 996 $query = "" unless defined($query); 997 wwerror("$0", "ERROR: in downloadPS subroutine of welcomeAction.pl $ERRORS","","",$query) if $ERRORS; 998 } 999 } 1000 } 1001 1002 END { 1003 if (defined($main::SIG_TIME_OUT) && $main::SIG_TIME_OUT == 1) { 1004 alarm(0); # turn off the alarm 1005 my $hard_copy_message = qq{Content-type: text/html\n\n 1006 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd"> 1007 <HTML><BODY BGCOLOR = "FF99CC"> 1008 <BLOCKQUOTE><H3>WeBWorK hard copy download time out.</H3>\n 1009 <H4>This download was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.</H4> This may be because the 1010 WeBWorK server is extraordinarily busy, or because there was an error in the problem, 1011 or because you tried to download a set with too many problems (more than 50).<P>\n 1012 Use the back button to return to the previous page and try again.<BR>\n 1013 If the problem is repeated you can report this to your instructor using the feedback button. 1014 <P> 1015 Because the WeBWorK server at the Unversity of Rochester is experiencing heavy use we have made downloading 1016 hard copies a low priority during the times of very heavy useage. It will be helpful if you 1017 download hard copies during times when the load is not too heavy. 1018 <P> 1019 The load is usually heaviest in the evenings , particularly a few hours before assignments 1020 are due. The best times to download hard copies are in the morning and afternoon 1021 -- or an hour after the due date and time of the previous assignment -- nobody is using the system then :-) 1022 </BLOCKQUOTE></BODY></HTML> 1023 }; 1024 my $do_problem_message = qq{Content-type: text/html\n\n 1025 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd"> 1026 <HTML><BODY BGCOLOR = "FF99CC"> 1027 <BLOCKQUOTE><H3>WeBWorK heavy useage time out.</H3>\n 1028 <H4>Your request (action = $action) was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.</H4> 1029 This is probably because the 1030 WeBWorK server is extraordinarily busy.<P>\n 1031 You should be warned that WeBWorK response will be unusually slow. If possible you should try 1032 to use WeBWorK at another time when the load is not as high. The highest useage periods are in the 1033 evening, particularly in the two hours before assignments are due.<P>\n 1034 Use the back button to return to the previous page and try again.<P>\n 1035 If the high useage problem continues you can report this to your instructor using the feedback button. 1036 <P> 1037 1038 </BLOCKQUOTE></BODY></HTML> 1039 }; 1040 if ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') { 1041 print $hard_copy_message; 1042 } else{ 1043 print $do_problem_message; 1044 } 1045 1046 1047 } 1048 1049 # begin Timing code 1050 if( $main::logTimingData == 1 ) { 1051 my $endTime = new Benchmark; 1052 my $error_str=''; 1053 1054 if ($main::SIGPIPE) { 1055 $error_str = 'broken PIPE--'; 1056 } elsif ($main::SIG_TIME_OUT) { 1057 $error_str = "TIME_OUT after $main::TIME_OUT_CONSTANT secs --"; 1058 } elsif ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') { 1059 $error_str = 'successful download -- '; 1060 } 1061 1062 &Global::logTimingInfo($main::beginTime,$endTime,$error_str.'welcomeAction.pl',$Course,$User); 1063 } 1064 # end Timing code 1065 1066 cleanup_downloadPS(); 1067 } 1068 1069 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |