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