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