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