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