Parent Directory
| 
Revision Log
1. fixed some formatting in Problem 2. hardcopy allows correct answers, hints, solutions to be shown 3. privileged users are allowed to view/download "not yet open" sets -sam
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::ContentGenerator::Hardcopy; 7 8 =head1 NAME 9 10 WeBWorK::ContentGenerator::Hardcopy - generate a PDF version of one or more 11 problem sets. 12 13 =cut 14 15 use strict; 16 use warnings; 17 use base qw(WeBWorK::ContentGenerator); 18 use CGI qw(); 19 use File::Path qw(rmtree); 20 use File::Temp qw(tempdir); 21 use WeBWorK::DB::Classlist; 22 use WeBWorK::DB::WW; 23 use WeBWorK::Form; 24 use WeBWorK::Utils qw(readFile); 25 26 sub go { 27 my ($self, $singleSet) = @_; 28 29 my $r = $self->{r}; 30 my $ce = $self->{courseEnvironment}; 31 my @sets = $r->param("hcSet"); 32 my @users = $r->param("hcUser"); 33 34 # add singleSet to the list of sets 35 if (length $singleSet > 0) { 36 $singleSet =~ s/^set//; 37 unshift @sets, $singleSet unless grep { $_ eq $singleSet } @sets; 38 } 39 40 # default user is the effectiveUser 41 unless (@users) { 42 unshift @users, $r->param("effectiveUser"); 43 } 44 45 $self->{cldb} = WeBWorK::DB::Classlist->new($ce); 46 $self->{authdb} = WeBWorK::DB::Auth->new($ce); 47 $self->{wwdb} = WeBWorK::DB::WW->new($ce); 48 $self->{user} = $self->{cldb}->getUser($r->param("user")); 49 $self->{permissionLevel} = $self->{authdb}->getPermissions($r->param("user")); 50 $self->{effectiveUser} = $self->{cldb}->getUser($r->param("effectiveUser")); 51 $self->{sets} = \@sets; 52 $self->{users} = \@users; 53 $self->{errors} = []; 54 $self->{warnings} = []; 55 56 # security checks 57 my $multiSet = $self->{permissionLevel} > 0; 58 my $multiUser = $self->{permissionLevel} > 0; 59 if (@sets > 1 and not $multiSet) { 60 $self->{generationError} = ["SIMPLE", "You are not permitted to generate hardcopy for multiple sets. Please select a single set and try again."]; 61 } 62 if (@users > 1 and not $multiUser) { 63 $self->{generationError} = ["SIMPLE", "You are not permitted to generate hardcopy for multiple users. Please select a single user and try again."]; 64 } 65 if ($users[0] ne $self->{effectiveUser}->id and not $multiUser) { 66 $self->{generationError} = ["SIMPLE", "You are not permitted to generate hardcopy for other users."]; 67 } 68 69 unless ($self->{generationError}) { 70 if ($r->param("generateHardcopy")) { 71 my ($tempDir, $fileName) = eval { $self->generateHardcopy() }; 72 if ($@) { 73 $self->{generationError} = $@; 74 } else { 75 my $filePath = "$tempDir/$fileName"; 76 77 $r->content_type("application/x-pdf"); 78 # as per RFC2183: 79 $r->header_out("Content-Disposition", "attachment; filename=$fileName"); 80 $r->send_http_header(); 81 82 local *INPUTFILE; 83 open INPUTFILE, "<", $filePath 84 or die "Failed to read $filePath: $!"; 85 my $buf; 86 while (read INPUTFILE, $buf, 16384) { 87 print $buf; 88 } 89 close INPUTFILE; 90 91 return; 92 } 93 } 94 } 95 96 $r->content_type("text/html"); 97 $r->send_http_header(); 98 $self->template($ce->{templates}->{system}, $singleSet); 99 } 100 101 # ----- 102 103 sub path { 104 my ($self, undef, $args) = @_; 105 106 my $ce = $self->{courseEnvironment}; 107 my $root = $ce->{webworkURLs}->{root}; 108 my $courseName = $ce->{courseName}; 109 return $self->pathMacro($args, 110 "Home" => "$root", 111 $courseName => "$root/$courseName", 112 "Hardcopy Generator" => "", 113 ); 114 } 115 116 sub title { 117 return "Hardcopy Generator"; 118 } 119 120 sub body { 121 my $self = shift; 122 123 if ($self->{generationError}) { 124 if (ref $self->{generationError} eq "ARRAY") { 125 my ($disposition, @rest) = @{$self->{generationError}}; 126 if ($disposition eq "PGFAIL") { 127 print $self->multiErrorOutput(@{$self->{errors}}); 128 return ""; 129 } elsif ($disposition eq "FAIL") { 130 print $self->errorOutput(@rest); 131 return ""; 132 } elsif ($disposition eq "RETRY") { 133 print $self->errorOutput(@rest); 134 } else { # a "simple" error 135 print CGI::p(CGI::font({-color=>"red"}, @rest)); 136 } 137 } else { 138 # not something we were expecting... 139 die $self->{generationError}; 140 } 141 } 142 $self->displayForm(); 143 } 144 145 sub multiErrorOutput($@) { 146 my ($self, @errors) = @_; 147 148 print CGI::h2("Software Errors"); 149 print CGI::p(<<EOF); 150 WeBWorK has encountered one or more software errors while attempting to process these sets. 151 It is likely that there are error(s) in the problem itself. 152 If you are a student, contact your professor to have the error(s) corrected. 153 If you are a professor, please consut the error output below for more informaiton. 154 EOF 155 foreach my $error (@errors) { 156 print CGI::h3("Set: ", $error->{set}, ", Problem: ", $error->{problem}); 157 print CGI::h4("Error messages"), CGI::blockquote(CGI::pre($error->{message})); 158 print CGI::h4("Error context"), CGI::blockquote(CGI::pre($error->{context})); 159 } 160 } 161 162 # ----- 163 164 sub displayForm($) { 165 my $self = shift; 166 my $r = $self->{r}; 167 168 print CGI::start_p(), "Select the problem sets for which to generate hardcopy versions."; 169 if ($self->{permissionLevel} > 0) { 170 print "You may also select multiple users from the users list. You will receive hardcopy for each (set, user) pair."; 171 } 172 print CGI::end_p(); 173 174 print CGI::start_form(-method=>"POST", -action=>$r->uri); 175 print $self->hidden_authen_fields(); 176 print CGI::h3("Options"); 177 print CGI::p("You may choose to show any of the following data. Correct answers and solutions are only available to privileged users or after the answer date of the problem set."); 178 print CGI::p( 179 CGI::checkbox( 180 -name => "showCorrectAnswers", 181 -checked => $r->param("showCorrectAnswers") || 0, 182 -label => "Correct answers", 183 ), CGI::br(), 184 CGI::checkbox( 185 -name => "showHints", 186 -checked => $r->param("showHints") || 0, 187 -label => "Hints", 188 ), CGI::br(), 189 CGI::checkbox( 190 -name => "showSolutions", 191 -checked => $r->param("showSolutions") || 0, 192 -label => "Solutions", 193 ), 194 ); 195 print CGI::start_table({-width=>"100%"}), CGI::start_Tr({-valign=>"top"}); 196 197 my $multiSet = $self->{permissionLevel} > 0; 198 my $multiUser = $self->{permissionLevel} > 0; 199 my $preOpenSets = $self->{permissionLevel} > 0; 200 201 # set selection menu 202 { 203 print CGI::start_td(); 204 print CGI::h3("Sets"); 205 print CGI::start_table(); 206 my @sets; 207 push @sets, $self->{wwdb}->getSet($self->{effectiveUser}->id, $_) 208 foreach ($self->{wwdb}->getSets($self->{effectiveUser}->id)); 209 @sets = sort { $a->id cmp $b->id } @sets; 210 foreach my $set (@sets) { 211 my $checked = grep { $_ eq $set->id } @{$self->{sets}}; 212 my $control; 213 if (time < $set->open_date and not $preOpenSets) { 214 $control = ""; 215 } else { 216 if ($multiSet) { 217 $control = CGI::checkbox( 218 -name=>"hcSet", 219 -value=>$set->id, 220 -label=>"", 221 -checked=>$checked 222 ); 223 } else { 224 $control = CGI::radio_group( 225 -name=>"hcSet", 226 -values=>[$set->id], 227 -default=>($checked ? $set->id : "-"), 228 -labels=>{$set->id => ""} 229 ); 230 } 231 } 232 print CGI::Tr(CGI::td([ 233 $control, 234 $set->id, 235 ])); 236 } 237 print CGI::end_table(); 238 print CGI::end_td(); 239 } 240 241 # user selection menu 242 if ($multiUser) { 243 print CGI::start_td(); 244 print CGI::h3("Users"); 245 print CGI::start_table(); 246 #print CGI::Tr( 247 # CGI::td(CGI::checkbox(-name=>"hcAllUsers", -value=>"1", -label=>"")), 248 # CGI::td({-colspan=>"2"}, "All Users"), 249 #); 250 #print CGI::Tr(CGI::td({-colspan=>"3"}, " ")); 251 my @users; 252 push @users, $self->{cldb}->getUser($_) 253 foreach ($self->{cldb}->getUsers()); 254 @users = sort { $a->last_name cmp $b->last_name } @users; 255 foreach my $user (@users) { 256 my $checked = grep { $_ eq $user->id } @{$self->{users}}; 257 print CGI::Tr(CGI::td([ 258 CGI::checkbox(-name=>"hcUser", -value=>$user->id, -label=>"", -checked=>$checked), 259 $user->id, 260 $user->last_name.", ".$user->first_name, 261 ])); 262 } 263 print CGI::end_table(); 264 print CGI::end_td(); 265 } 266 267 print CGI::end_Tr(), CGI::end_table(); 268 print CGI::p({-align=>"center"}, 269 CGI::submit(-name=>"generateHardcopy", -label=>"Generate Hardcopy")); 270 print CGI::end_form(); 271 272 return ""; 273 } 274 275 sub generateHardcopy($) { 276 my $self = shift; 277 my @sets = @{$self->{sets}}; 278 my @users = @{$self->{users}}; 279 my $multiSet = $self->{permissionLevel} > 0; 280 my $multiUser = $self->{permissionLevel} > 0; 281 # sanity checks 282 unless (@sets) { 283 die ["RETRY", "No sets were specified."]; 284 } 285 unless (@users) { 286 die ["RETRY", "No users were specified."]; 287 } 288 289 # determine where hardcopy is going to go 290 #my $tempDir = $self->{courseEnvironment}->{courseDirs}->{html_temp} . "/hardcopy"; 291 my $tempDir = tempdir("webwork-hardcopy-XXXXXXXX", TMPDIR => 1); 292 293 # make sure tempDir exists 294 #unless (-e $tempDir) { 295 # if (system "mkdir", "-p", $tempDir) { 296 # die ["FAIL", "Failed to mkdir $tempDir", $!]; 297 # } 298 #} 299 300 # determine name of PDF file 301 my $courseName = $self->{courseEnvironment}->{courseName}; 302 my $fileNameSet = (@sets > 1 ? "multiset" : $sets[0]); 303 my $fileNameUser = (@users > 1 ? "multiuser" : $users[0]); 304 my $fileName = "$courseName.$fileNameUser.$fileNameSet.pdf"; 305 306 # for each user ... generate TeX for each set 307 my $tex; 308 foreach my $user (@users) { 309 $tex .= $self->getMultiSetTeX(@sets); 310 } 311 312 # deal with PG errors 313 if (@{$self->{errors}}) { 314 die ["PGFAIL"]; 315 } 316 317 # "try" to generate pdf 318 eval { $self->latex2pdf($tex, $tempDir, $fileName) }; 319 if ($@) { 320 die ["FAIL", "Failed to generate PDF from tex", $@]; 321 } 322 323 return $tempDir, $fileName; 324 } 325 326 # ----- 327 328 sub latex2pdf { 329 # this is a little ad-hoc function which I will replace with a LaTeX 330 # module at some point (or put it in Utils). 331 my ($self, $tex, $fileBase, $fileName) = @_; 332 my $finalFile = "$fileBase/$fileName"; 333 my $ce = $self->{courseEnvironment}; 334 335 # create a temporary directory for tex to shit in 336 my $wd = tempdir("webwork-hardcopy-XXXXXXXX", TMPDIR => 1); 337 my $texFile = "$wd/hardcopy.tex"; 338 my $pdfFile = "$wd/hardcopy.pdf"; 339 my $logFile = "$wd/hardcopy.log"; 340 341 # write the tex file 342 local *TEX; 343 open TEX, ">", $texFile or die "Failed to open $texFile: $!\n"; 344 print TEX $tex; 345 close TEX; 346 347 # call pdflatex - we don't want to chdir in the mod_perl process, as 348 # that might step on the feet of other things (esp. in Apache 2.0) 349 my $pdflatex = $ce->{externalPrograms}->{pdflatex}; 350 my $pdflatexResult = system "cd $wd && $pdflatex $texFile"; 351 if ($pdflatexResult) { 352 # something bad happened 353 my $textErrorMessage = "Call to $pdflatex failed: $!\n"; 354 if (-e $logFile) { 355 $textErrorMessage .= "pdflatex ran, but did not succeed. This suggests an error in the TeX\n"; 356 $textErrorMessage .= "version of one of the problems, or a problem with the pdflatex system.\n"; 357 my $logFileContents = eval { readFile($logFile) }; 358 if ($@) { 359 $textErrorMessage .= "Additionally, the pdflatex log file could not be read, though it exists.\n"; 360 } else { 361 $textErrorMessage .= "The contents of the TeX log are as follows:\n\n"; 362 $textErrorMessage .= "$logFileContents\n\n"; 363 } 364 } else { 365 $textErrorMessage .= "No log file was created, suggesting that pdflatex never ran. Check the WeBWorK\n"; 366 $textErrorMessage .= "configuration to ensure that the path to pdflatex is correct.\n"; 367 } 368 die $textErrorMessage; 369 } 370 371 if (-e $pdfFile) { 372 # move resulting PDF file to appropriate location 373 system "/bin/mv", $pdfFile, $finalFile and die "Failed to mv: $!\n"; 374 } 375 376 # remove temporary directory 377 rmtree($wd, 0, 1); 378 379 -e $finalFile or die "Failed to create $finalFile for no apparent reason.\n"; 380 } 381 382 # ----- 383 384 sub texBlockComment(@) { return "\n".("%"x80)."\n%% ".join("", @_)."\n".("%"x80)."\n\n"; } 385 386 sub getMultiSetTeX { 387 my ($self, @sets) = @_; 388 my $ce = $self->{courseEnvironment}; 389 my $tex = ""; 390 391 # the document preamble 392 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{preamble}); 393 394 while (defined (my $setName = shift @sets)) { 395 $tex .= $self->getSetTeX($setName); 396 if (@sets) { 397 # divide sets, but not after the last set 398 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{setDivider}); 399 } 400 } 401 402 # the document postamble 403 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{postamble}); 404 405 return $tex; 406 } 407 408 sub getSetTeX { 409 my ($self, $setName) = @_; 410 my $ce = $self->{courseEnvironment}; 411 my $wwdb = $self->{wwdb}; 412 my $effectiveUserName = $self->{effectiveUser}->id; 413 my @problemNumbers = sort { $a <=> $b } $wwdb->getProblems($effectiveUserName, $setName); 414 415 # get header and footer 416 my $setHeader = $wwdb->getSet($effectiveUserName, $setName)->set_header 417 || $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; 418 # database doesn't support the following yet :( 419 #my $setFooter = $wwdb->getSet($effectiveUserName, $setName)->set_footer 420 # || $ce->{webworkFiles}->{hardcopySnippets}->{setFooter}; 421 # so we don't allow per-set customization, which is probably okay :) 422 my $setFooter = $ce->{webworkFiles}->{hardcopySnippets}->{setFooter}; 423 424 my $tex = ""; 425 426 # render header 427 $tex .= texBlockComment("BEGIN $setName : $setHeader"); 428 $tex .= $self->getProblemTeX($setName, 0, $setHeader); 429 430 # render each problem 431 while (my $problemNumber = shift @problemNumbers) { 432 $tex .= texBlockComment("BEGIN $setName : $problemNumber"); 433 $tex .= $self->getProblemTeX($setName, $problemNumber); 434 if (@problemNumbers) { 435 # divide problems, but not after the last problem 436 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{problemDivider}); 437 } 438 } 439 440 # render footer 441 $tex .= texBlockComment("BEGIN $setName : $setFooter"); 442 $tex .= $self->getProblemTeX($setName, 0, $setFooter); 443 444 return $tex; 445 } 446 447 sub getProblemTeX { 448 my ($self, $setName, $problemNumber, $pgFile) = @_; 449 my $r = $self->{r}; 450 my $ce = $self->{courseEnvironment}; 451 452 my $wwdb = $self->{wwdb}; 453 my $cldb = $self->{cldb}; 454 my $authdb = $self->{authdb}; 455 my $effectiveUser = $self->{effectiveUser}; 456 my $permissionLevel = $self->{permissionLevel}; 457 my $set = $wwdb->getSet($effectiveUser->id, $setName); 458 my $psvn = $wwdb->getPSVN($effectiveUser->id, $setName); 459 460 # decide what to do about problem number 461 my $problem; 462 if ($problemNumber) { 463 $problem = $wwdb->getProblem($effectiveUser->id, $setName, $problemNumber); 464 } elsif ($pgFile) { 465 $problem = WeBWorK::Problem->new( 466 id => 0, 467 set_id => $set->id, 468 login_id => $effectiveUser->id, 469 source_file => $pgFile, 470 # the rest of Problem's fields are not needed, i think 471 ); 472 } 473 474 # figure out if we're allowed to get solutions and call PG->new accordingly. 475 my $showCorrectAnswers = $r->param("showCorrectAnswers") || 0; 476 my $showHints = $r->param("showHints") || 0; 477 my $showSolutions = $r->param("showSolutions") || 0; 478 unless ($permissionLevel > 0 or time > $set->answer_date) { 479 $showCorrectAnswers = 0; 480 $showSolutions = 0; 481 } 482 483 my $pg = WeBWorK::PG->new( 484 $ce, 485 $effectiveUser, 486 $r->param('key'), 487 $set, 488 $problem, 489 $psvn, 490 {}, # no form fields! 491 { # translation options 492 displayMode => "tex", 493 showHints => $showHints, 494 showSolutions => $showSolutions, 495 processAnswers => $showCorrectAnswers, 496 }, 497 ); 498 499 if ($pg->{warnings} ne "") { 500 push @{$self->{warnings}}, { 501 set => $setName, 502 problem => $problemNumber, 503 message => $pg->{warnings}, 504 }; 505 } 506 507 if ($pg->{flags}->{error_flag}) { 508 push @{$self->{errors}}, { 509 set => $setName, 510 problem => $problemNumber, 511 message => $pg->{errors}, 512 context => $pg->{body_text}, 513 }; 514 # if there was an error, body_text contains 515 # the error context, not TeX code 516 $pg->{body_text} = undef; 517 } else { 518 # append list of correct answers to body text 519 if ($showCorrectAnswers && $problemNumber != 0) { 520 my $correctTeX = "Correct Answers:\\par\\begin{itemize}\n"; 521 foreach my $ansName (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}) { 522 my $correctAnswer = $pg->{answers}->{$ansName}->{correct_ans}; 523 $correctAnswer =~ s/\^/\\\^\{\}/g; 524 $correctAnswer =~ s/\_/\\\_/g; 525 $correctTeX .= "\\item $correctAnswer\n"; 526 } 527 $correctTeX .= "\\end{itemize} \\par\n"; 528 $pg->{body_text} .= $correctTeX; 529 } 530 } 531 warn "BODY TEXT=\n", $pg->{body_text}, "\n\n"; 532 return $pg->{body_text}; 533 } 534 535 sub texInclude { 536 my ($self, $texFile) = @_; 537 my $tex = ""; 538 539 $tex .= texBlockComment("BEGIN: $texFile"); 540 eval { 541 $tex .= readFile($texFile) 542 }; 543 if ($@) { 544 $tex .= texBlockComment($@); 545 } 546 547 return $tex; 548 } 549 550 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |