[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator / Hardcopy.pm Repository:
ViewVC logotype

Diff of /trunk/webwork2/lib/WeBWorK/ContentGenerator/Hardcopy.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 736 Revision 737
… …
13=cut 13=cut
14 14
15use strict; 15use strict;
16use warnings; 16use warnings;
17use base qw(WeBWorK::ContentGenerator); 17use base qw(WeBWorK::ContentGenerator);
18#use Apache::Constants qw(:common);
19use CGI qw(); 18use CGI qw();
20use File::Path qw(rmtree); 19use File::Path qw(rmtree);
21use File::Temp qw(tempdir); 20use File::Temp qw(tempdir);
22use WeBWorK::DB::Classlist; 21use WeBWorK::DB::Classlist;
23use WeBWorK::DB::WW; 22use WeBWorK::DB::WW;
24use WeBWorK::Form; 23use WeBWorK::Form;
25use WeBWorK::Utils qw(readFile); 24use WeBWorK::Utils qw(readFile);
26 25
27sub texBlockComment(@) { return "\n".("%"x80)."\n%% ".join("", @_)."\n".("%"x80)."\n\n"; } 26sub go {
28
29sub initialize {
30 my ($self, $singleSet, undef) = @_; 27 my ($self, $singleSet) = @_;
31 28
32 my $r = $self->{r}; 29 my $r = $self->{r};
33 my $ce = $self->{courseEnvironment}; 30 my $ce = $self->{courseEnvironment};
34 my @sets = $r->param("set"); 31 my @sets = $r->param("hcSet");
32 my @users = $r->param("hcUser");
35 33
34 # add singleSet to the list of sets
36 if (length $singleSet > 0) { 35 if (length $singleSet > 0) {
37 $singleSet =~ s/^set//; 36 $singleSet =~ s/^set//;
38 unshift @sets, $singleSet; 37 unshift @sets, $singleSet unless grep { $_ eq $singleSet } @sets;
39 } 38 }
40 39
40 # default user is the effectiveUser
41 unless (@users) {
42 unshift @users, $r->param("effectiveUser");
43 }
44
41 $self->{cldb} = WeBWorK::DB::Classlist->new($ce); 45 $self->{cldb} = WeBWorK::DB::Classlist->new($ce);
46 $self->{authdb} = WeBWorK::DB::Auth->new($ce);
42 $self->{wwdb} = WeBWorK::DB::WW->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"));
43 $self->{sets} = \@sets; 51 $self->{sets} = \@sets;
52 $self->{users} = \@users;
44 $self->{errors} = []; 53 $self->{errors} = [];
45 $self->{warnings} = []; 54 $self->{warnings} = [];
55
56 # security checks - these have to be put somewhere
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);
46} 99}
100
101# -----
47 102
48sub path { 103sub path {
49 my ($self, undef, $args) = @_; 104 my ($self, undef, $args) = @_;
50 105
51 my $ce = $self->{courseEnvironment}; 106 my $ce = $self->{courseEnvironment};
… …
59} 114}
60 115
61sub title { 116sub title {
62 return "Hardcopy Generator"; 117 return "Hardcopy Generator";
63} 118}
119
120sub 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
145sub multiErrorOutput($@) {
146 my ($self, @errors) = @_;
147
148 print CGI::h2("Software Errors");
149 print CGI::p(<<EOF);
150WeBWorK has encountered one or more software errors while attempting to process these sets.
151It is likely that there are error(s) in the problem itself.
152If you are a student, contact your professor to have the error(s) corrected.
153If you are a professor, please consut the error output below for more informaiton.
154EOF
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
164sub 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::start_table({-width=>"100%"}), CGI::start_Tr({-valign=>"top"});
177
178 my $multiSet = $self->{permissionLevel} > 0;
179 my $multiUser = $self->{permissionLevel} > 0;
180
181 # set selection menu
182 {
183 print CGI::start_td();
184 print CGI::h3("Sets");
185 print CGI::start_table();
186 my @sets;
187 push @sets, $self->{wwdb}->getSet($self->{effectiveUser}->id, $_)
188 foreach ($self->{wwdb}->getSets($self->{effectiveUser}->id));
189 @sets = sort { $a->id cmp $b->id } @sets;
190 foreach my $set (@sets) {
191 my $checked = grep { $_ eq $set->id } @{$self->{sets}};
192 my $control;
193 if (time < $set->open_date) {
194 $control = "";
195 } else {
196 if ($multiSet) {
197 $control = CGI::checkbox(
198 -name=>"hcSet",
199 -value=>$set->id,
200 -label=>"",
201 -checked=>$checked
202 );
203 } else {
204 $control = CGI::radio_group(
205 -name=>"hcSet",
206 -values=>[$set->id],
207 -default=>($checked ? $set->id : "-"),
208 -labels=>{$set->id => ""}
209 );
210 }
211 }
212 print CGI::Tr(CGI::td([
213 $control,
214 $set->id,
215 ]));
216 }
217 print CGI::end_table();
218 print CGI::end_td();
219 }
220
221 # user selection menu
222 if ($multiUser) {
223 print CGI::start_td();
224 print CGI::h3("Users");
225 print CGI::start_table();
226 #print CGI::Tr(
227 # CGI::td(CGI::checkbox(-name=>"hcAllUsers", -value=>"1", -label=>"")),
228 # CGI::td({-colspan=>"2"}, "All Users"),
229 #);
230 #print CGI::Tr(CGI::td({-colspan=>"3"}, "&nbsp;"));
231 my @users;
232 push @users, $self->{cldb}->getUser($_)
233 foreach ($self->{cldb}->getUsers());
234 @users = sort { $a->last_name cmp $b->last_name } @users;
235 foreach my $user (@users) {
236 my $checked = grep { $_ eq $user->id } @{$self->{users}};
237 print CGI::Tr(CGI::td([
238 CGI::checkbox(-name=>"hcUser", -value=>$user->id, -label=>"", -checked=>$checked),
239 $user->id,
240 $user->last_name.", ".$user->first_name,
241 ]));
242 }
243 print CGI::end_table();
244 print CGI::end_td();
245 }
246
247 print CGI::end_Tr(), CGI::end_table();
248 print CGI::p({-align=>"center"},
249 CGI::submit(-name=>"generateHardcopy", -label=>"Generate Hardcopy"));
250 print CGI::end_form();
251
252 return "";
253}
254
255sub generateHardcopy($) {
256 my $self = shift;
257 my @sets = @{$self->{sets}};
258 my @users = @{$self->{users}};
259 my $multiSet = $self->{permissionLevel} > 0;
260 my $multiUser = $self->{permissionLevel} > 0;
261 # sanity checks
262 unless (@sets) {
263 die ["RETRY", "No sets were specified."];
264 }
265 unless (@users) {
266 die ["RETRY", "No users were specified."];
267 }
268
269 # determine where hardcopy is going to go
270 #my $tempDir = $self->{courseEnvironment}->{courseDirs}->{html_temp} . "/hardcopy";
271 my $tempDir = tempdir("webwork-hardcopy-XXXXXXXX", TMPDIR => 1);
272
273 # make sure tempDir exists
274 #unless (-e $tempDir) {
275 # if (system "mkdir", "-p", $tempDir) {
276 # die ["FAIL", "Failed to mkdir $tempDir", $!];
277 # }
278 #}
279
280 # determine name of PDF file
281 my $courseName = $self->{courseEnvironment}->{courseName};
282 my $fileNameSet = (@sets > 1 ? "multiset" : $sets[0]);
283 my $fileNameUser = (@users > 1 ? "multiuser" : $users[0]);
284 my $fileName = "$courseName.$fileNameUser.$fileNameSet.pdf";
285
286 # for each user ... generate TeX for each set
287 my $tex;
288 foreach my $user (@users) {
289 $tex .= $self->getMultiSetTeX(@sets);
290 }
291
292 # deal with PG errors
293 if (@{$self->{errors}}) {
294 die ["PGFAIL"];
295 }
296
297 # "try" to generate pdf
298 eval { $self->latex2pdf($tex, $tempDir, $fileName) };
299 if ($@) {
300 die ["FAIL", "Failed to generate PDF from tex", $@];
301 }
302
303 return $tempDir, $fileName;
304}
305
306# -----
307
308sub latex2pdf {
309 # this is a little ad-hoc function which I will replace with a LaTeX
310 # module at some point (or put it in Utils).
311 my ($self, $tex, $fileBase, $fileName) = @_;
312 my $finalFile = "$fileBase/$fileName";
313 my $ce = $self->{courseEnvironment};
314
315 # create a temporary directory for tex to shit in
316 my $wd = tempdir("webwork-hardcopy-XXXXXXXX", TMPDIR => 1);
317 my $texFile = "$wd/hardcopy.tex";
318 my $pdfFile = "$wd/hardcopy.pdf";
319 my $logFile = "$wd/hardcopy.log";
320
321 # write the tex file
322 local *TEX;
323 open TEX, ">", $texFile or die "Failed to open $texFile: $!\n";
324 print TEX $tex;
325 close TEX;
326
327 # call pdflatex - we don't want to chdir in the mod_perl process, as
328 # that might step on the feet of other things (esp. in Apache 2.0)
329 my $pdflatex = $ce->{externalPrograms}->{pdflatex};
330 system "cd $wd && $pdflatex $texFile" and die "Failed to call pdflatex: $!\n";
331
332 if (-e $pdfFile) {
333 # move resulting PDF file to appropriate location
334 system "/bin/mv", $pdfFile, $finalFile and die "Failed to mv: $!\n";
335 }
336
337 # remove temporary directory
338 rmtree($wd, 0, 1);
339
340 -e $finalFile or die "Failed to create $finalFile for no apparent reason.\n";
341}
342
343# -----
344
345sub texBlockComment(@) { return "\n".("%"x80)."\n%% ".join("", @_)."\n".("%"x80)."\n\n"; }
346
347sub getMultiSetTeX {
348 my ($self, @sets) = @_;
349 my $ce = $self->{courseEnvironment};
350 my $tex = "";
351
352 # the document preamble
353 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{preamble});
354
355 while (defined (my $setName = shift @sets)) {
356 $tex .= $self->getSetTeX($setName);
357 if (@sets) {
358 # divide sets, but not after the last set
359 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{setDivider});
360 }
361 }
362
363 # the document postamble
364 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{postamble});
365
366 return $tex;
367}
368
369sub getSetTeX {
370 my ($self, $setName) = @_;
371 my $ce = $self->{courseEnvironment};
372 my $wwdb = $self->{wwdb};
373 my $effectiveUserName = $self->{effectiveUser}->id;
374 my @problemNumbers = sort { $a <=> $b } $wwdb->getProblems($effectiveUserName, $setName);
375
376 # get header and footer
377 my $setHeader = $wwdb->getSet($effectiveUserName, $setName)->set_header
378 || $ce->{webworkFiles}->{hardcopySnippets}->{setHeader};
379 # database doesn't support the following yet :(
380 #my $setFooter = $wwdb->getSet($effectiveUserName, $setName)->set_footer
381 # || $ce->{webworkFiles}->{hardcopySnippets}->{setFooter};
382 # so we don't allow per-set customization, which is probably okay :)
383 my $setFooter = $ce->{webworkFiles}->{hardcopySnippets}->{setFooter};
384
385 my $tex = "";
386
387 # render header
388 $tex .= texBlockComment("BEGIN $setName : $setHeader");
389 $tex .= $self->getProblemTeX($setName, 0, $setHeader);
390
391 # render each problem
392 while (my $problemNumber = shift @problemNumbers) {
393 $tex .= texBlockComment("BEGIN $setName : $problemNumber");
394 $tex .= $self->getProblemTeX($setName, $problemNumber);
395 if (@problemNumbers) {
396 # divide problems, but not after the last problem
397 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{problemDivider});
398 }
399 }
400
401 # render footer
402 $tex .= texBlockComment("BEGIN $setName : $setFooter");
403 $tex .= $self->getProblemTeX($setName, 0, $setFooter);
404
405 return $tex;
406}
407
408sub getProblemTeX {
409 my ($self, $setName, $problemNumber, $pgFile) = @_;
410 my $r = $self->{r};
411 my $ce = $self->{courseEnvironment};
412
413 my $wwdb = $self->{wwdb};
414 my $cldb = $self->{cldb};
415 my $effectiveUser = $self->{effectiveUser};
416 my $set = $wwdb->getSet($effectiveUser->id, $setName);
417 my $psvn = $wwdb->getPSVN($effectiveUser->id, $setName);
418
419 # decide what to do about problem number
420 my $problem;
421 if ($problemNumber) {
422 $problem = $wwdb->getProblem($effectiveUser->id, $setName, $problemNumber);
423 } elsif ($pgFile) {
424 $problem = WeBWorK::Problem->new(
425 id => 0,
426 set_id => $set->id,
427 login_id => $effectiveUser->id,
428 source_file => $pgFile,
429 # the rest of Problem's fields are not needed, i think
430 );
431 }
432
433 my $pg = WeBWorK::PG->new(
434 $ce,
435 $effectiveUser,
436 $r->param('key'),
437 $set,
438 $problem,
439 $psvn,
440 {}, # no form fields!
441 { # translation options
442 displayMode => "tex",
443 showHints => 0,
444 showSolutions => 0,
445 processAnswers => 0,
446 },
447 );
448
449 if ($pg->{warnings} ne "") {
450 push @{$self->{warnings}}, {
451 set => $setName,
452 problem => $problemNumber,
453 message => $pg->{warnings},
454 };
455 }
456
457 if ($pg->{flags}->{error_flag}) {
458 push @{$self->{errors}}, {
459 set => $setName,
460 problem => $problemNumber,
461 message => $pg->{errors},
462 context => $pg->{body_text},
463 };
464 # if there was an error, body_text contains
465 # the error context, not TeX code
466 $pg->{body_text} = undef;
467 }
468
469 return $pg->{body_text};
470}
471
472sub texInclude {
473 my ($self, $texFile) = @_;
474 my $tex = "";
475
476 $tex .= texBlockComment("BEGIN: $texFile");
477 eval {
478 $tex .= readFile($texFile)
479 };
480 if ($@) {
481 $tex .= texBlockComment($@);
482 }
483
484 return $tex;
485}
486
4871;
488
489__END__
64 490
65sub body { 491sub body {
66 my $self = shift; 492 my $self = shift;
67 493
68 STUFF: { 494 STUFF: {
… …
171 ), 597 ),
172 CGI::endform(); 598 CGI::endform();
173 599
174 return ""; 600 return "";
175} 601}
176
177# -----
178
179sub latex2pdf {
180 # this is a little ad-hoc function which I will replace with a LaTeX
181 # module at some point (or put it in Utils).
182 my ($self, $tex, $fileBase, $fileName) = @_;
183 my $finalFile = "$fileBase/$fileName";
184 my $ce = $self->{courseEnvironment};
185
186 # create a temporary directory for tex to shit in
187 my $wd = tempdir("webwork-hardcopy-XXXXXXXX", TMPDIR => 1);
188 my $texFile = "$wd/hardcopy.tex";
189 my $pdfFile = "$wd/hardcopy.pdf";
190 my $logFile = "$wd/hardcopy.log";
191
192 # write the tex file
193 local *TEX;
194 open TEX, ">", $texFile or die "Failed to open $texFile: $!\n";
195 print TEX $tex;
196 close TEX;
197
198 # call pdflatex - we don't want to chdir in the mod_perl process, as
199 # that might step on the feet of other things (esp. in Apache 2.0)
200 my $pdflatex = $ce->{externalPrograms}->{pdflatex};
201 system "cd $wd && $pdflatex $texFile" and die "Failed to call pdflatex: $!\n";
202
203 if (-e $pdfFile) {
204 # move resulting PDF file to appropriate location
205 system "/bin/mv", $pdfFile, $finalFile and die "Failed to mv: $!\n";
206 }
207
208 # remove temporary directory
209 rmtree($wd, 0, 1);
210
211 -e $finalFile or die "Failed to create $finalFile for no apparent reason.\n";
212}
213
214# -----
215
216sub getMultiSetTeX {
217 my ($self, @sets) = @_;
218 my $ce = $self->{courseEnvironment};
219 my $tex = "";
220
221 # the document preamble
222 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{preamble});
223
224 while (defined (my $setName = shift @sets)) {
225 $tex .= $self->getSetTeX($setName);
226 if (@sets) {
227 # divide sets, but not after the last set
228 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{setDivider});
229 }
230 }
231
232 # the document postamble
233 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{postamble});
234
235 return $tex;
236}
237
238sub getSetTeX {
239 my ($self, $setName) = @_;
240 my $ce = $self->{courseEnvironment};
241 my $wwdb = $self->{wwdb};
242 my $effectiveUserName = $self->{r}->param("effectiveUser");
243 my @problemNumbers = sort { $a <=> $b } $wwdb->getProblems($effectiveUserName, $setName);
244
245 # get header and footer
246 my $setHeader = $wwdb->getSet($effectiveUserName, $setName)->set_header
247 || $ce->{webworkFiles}->{hardcopySnippets}->{setHeader};
248 # database doesn't support the following yet :(
249 #my $setFooter = $wwdb->getSet($effectiveUserName, $setName)->set_footer
250 # || $ce->{webworkFiles}->{hardcopySnippets}->{setFooter};
251 # so we don't allow per-set customization, which is probably okay :)
252 my $setFooter = $ce->{webworkFiles}->{hardcopySnippets}->{setFooter};
253
254 my $tex = "";
255
256 # render header
257 $tex .= texBlockComment("BEGIN $setName : $setHeader");
258 $tex .= $self->getProblemTeX($setName, 0, $setHeader);
259
260 # render each problem
261 while (my $problemNumber = shift @problemNumbers) {
262 $tex .= texBlockComment("BEGIN $setName : $problemNumber");
263 $tex .= $self->getProblemTeX($setName, $problemNumber);
264 if (@problemNumbers) {
265 # divide problems, but not after the last problem
266 $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{problemDivider});
267 }
268 }
269
270 # render footer
271 $tex .= texBlockComment("BEGIN $setName : $setFooter");
272 $tex .= $self->getProblemTeX($setName, 0, $setFooter);
273
274 return $tex;
275}
276
277sub getProblemTeX {
278 my ($self, $setName, $problemNumber, $pgFile) = @_;
279 my $r = $self->{r};
280 my $ce = $self->{courseEnvironment};
281
282 my $wwdb = $self->{wwdb};
283 my $cldb = $self->{cldb};
284 my $effectiveUser = $cldb->getUser($r->param("effectiveUser"));
285 my $set = $wwdb->getSet($effectiveUser->id, $setName);
286 my $psvn = $wwdb->getPSVN($effectiveUser->id, $setName);
287
288 # decide what to do about problem number
289 my $problem;
290 if ($problemNumber) {
291 $problem = $wwdb->getProblem($effectiveUser->id, $setName, $problemNumber);
292 } elsif ($pgFile) {
293 $problem = WeBWorK::Problem->new(
294 id => 0,
295 set_id => $set->id,
296 login_id => $effectiveUser->id,
297 source_file => $pgFile,
298 # the rest of Problem's fields are not needed, i think
299 );
300 }
301
302 my $pg = WeBWorK::PG->new(
303 $ce,
304 $effectiveUser,
305 $r->param('key'),
306 $set,
307 $problem,
308 $psvn,
309 {}, # no form fields!
310 { # translation options
311 displayMode => "tex",
312 showHints => 0,
313 showSolutions => 0,
314 processAnswers => 0,
315 },
316 );
317
318 if ($pg->{warnings} ne "") {
319 push @{$self->{warnings}}, {
320 set => $setName,
321 problem => $problemNumber,
322 message => $pg->{warnings},
323 };
324 }
325
326 if ($pg->{flags}->{error_flag}) {
327 push @{$self->{errors}}, {
328 set => $setName,
329 problem => $problemNumber,
330 message => $pg->{errors},
331 context => $pg->{body_text},
332 };
333 # if there was an error, body_text contains
334 # the error context, not TeX code
335 $pg->{body_text} = undef;
336 }
337
338 return $pg->{body_text};
339}
340
341sub texInclude {
342 my ($self, $texFile) = @_;
343 my $tex = "";
344
345 $tex .= texBlockComment("BEGIN: $texFile");
346 eval {
347 $tex .= readFile($texFile)
348 };
349 if ($@) {
350 $tex .= texBlockComment($@);
351 }
352
353 return $tex;
354}
355
3561;
Legend:
Removed from v.736  
changed lines
  Added in v.737
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9