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