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

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

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

Revision 622 Revision 623
… …
13 13
14use strict; 14use strict;
15use warnings; 15use warnings;
16use base qw(WeBWorK::ContentGenerator); 16use base qw(WeBWorK::ContentGenerator);
17use CGI qw(); 17use CGI qw();
18use File::Temp qw(tempdir);
18use WeBWorK::Form; 19use WeBWorK::Form;
19use WeBWorK::PG; 20use WeBWorK::PG;
21use WeBWorK::PG::IO;
20use WeBWorK::Utils qw(writeLog encodeAnswers decodeAnswers ref2string); 22use WeBWorK::Utils qw(writeLog encodeAnswers decodeAnswers ref2string);
21 23
22############################################################ 24############################################################
23# 25#
24# user 26# user
… …
59 61
60 # set options from form fields (see comment at top of file for names) 62 # set options from form fields (see comment at top of file for names)
61 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 63 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
62 my $redisplay = $r->param("redisplay"); 64 my $redisplay = $r->param("redisplay");
63 my $submitAnswers = $r->param("submitAnswers"); 65 my $submitAnswers = $r->param("submitAnswers");
66 my $previewAnswers = $r->param("previewAnswers");
64 67
65 # coerce form fields into CGI::Vars format 68 # coerce form fields into CGI::Vars format
66 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 69 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
67 70
68 ##### permissions ##### 71 ##### permissions #####
… …
140 $self->{user} = $user; 143 $self->{user} = $user;
141 $self->{set} = $set; 144 $self->{set} = $set;
142 $self->{problem} = $problem; 145 $self->{problem} = $problem;
143 $self->{permissionLevel} = $permissionLevel; 146 $self->{permissionLevel} = $permissionLevel;
144 147
145 $self->{displayMode} = $displayMode; 148 $self->{displayMode} = $displayMode;
146 $self->{redisplay} = $redisplay; 149 $self->{redisplay} = $redisplay;
147 $self->{submitAnswers} = $submitAnswers; 150 $self->{submitAnswers} = $submitAnswers;
151 $self->{previewAnswers} = $previewAnswers;
148 $self->{formFields} = $formFields; 152 $self->{formFields} = $formFields;
149 153
150 $self->{want} = \%want; 154 $self->{want} = \%want;
151 $self->{must} = \%must; 155 $self->{must} = \%must;
152 $self->{can} = \%can; 156 $self->{can} = \%can;
153 $self->{will} = \%will; 157 $self->{will} = \%will;
… …
253 my $wwdb = $self->{wwdb}; 257 my $wwdb = $self->{wwdb};
254 my $set = $self->{set}; 258 my $set = $self->{set};
255 my $problem = $self->{problem}; 259 my $problem = $self->{problem};
256 my $permissionLevel = $self->{permissionLevel}; 260 my $permissionLevel = $self->{permissionLevel};
257 my $submitAnswers = $self->{submitAnswers}; 261 my $submitAnswers = $self->{submitAnswers};
262 my $previewAnswers = $self->{previewAnswers};
258 my %will = %{ $self->{will} }; 263 my %will = %{ $self->{will} };
259 my $pg = $self->{pg}; 264 my $pg = $self->{pg};
260 265
261 ##### translation errors? ##### 266 ##### translation errors? #####
262 267
… …
306 ##### output ##### 311 ##### output #####
307 312
308 # attempt summary 313 # attempt summary
309 if ($submitAnswers or $will{showCorrectAnswers}) { 314 if ($submitAnswers or $will{showCorrectAnswers}) {
310 # print this if user submitted answers OR requested correct answers 315 # print this if user submitted answers OR requested correct answers
311 print attemptResults($pg, $submitAnswers, $will{showCorrectAnswers}, 316 print $self->attemptResults($pg, $submitAnswers, $will{showCorrectAnswers},
312 $pg->{flags}->{showPartialCorrectAnswers}); 317 $pg->{flags}->{showPartialCorrectAnswers});
318 } elsif ($previewAnswers) {
319 # print this if user previewed answers
320 print $self->attemptResults($pg, 1, 0, 0);
321 # don't show correctness
322 # don't show correct answers
313 } 323 }
314 324
315 # score summary 325 # score summary
316 my $attempts = $problem->num_correct + $problem->num_incorrect; 326 my $attempts = $problem->num_correct + $problem->num_incorrect;
317 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 327 my $attemptsNoun = $attempts != 1 ? "times" : "time";
… …
357 CGI::startform("POST", $r->uri), 367 CGI::startform("POST", $r->uri),
358 $self->hidden_authen_fields, 368 $self->hidden_authen_fields,
359 $self->viewOptions, 369 $self->viewOptions,
360 CGI::p(CGI::i($pg->{result}->{msg})), 370 CGI::p(CGI::i($pg->{result}->{msg})),
361 CGI::p($pg->{body_text}), 371 CGI::p($pg->{body_text}),
372 CGI::p(
362 CGI::p(CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers")), 373 CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers"),
374 CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers"),
375 ),
363 CGI::endform(); 376 CGI::endform();
364 377
365 # warning output 378 # warning output
366 if ($pg->{warnings} ne "") { 379 if ($pg->{warnings} ne "") {
367 print CGI::hr(), warningOutput($pg->{warnings}); 380 print CGI::hr(), warningOutput($pg->{warnings});
368 } 381 }
369 382
370 # debugging stuff 383 # debugging stuff
371 #print 384 print
372 # hr(), 385 CGI::hr(),
373 # h2("debugging information"), 386 CGI::h2("debugging information"),
374 # h3("form fields"), 387 CGI::h3("form fields"),
375 # ref2string($formFields), 388 ref2string($self->{formFields}),
376 # h3("user object"), 389 CGI::h3("user object"),
377 # ref2string($user), 390 ref2string($self->{user}),
378 # h3("set object"), 391 CGI::h3("set object"),
379 # ref2string($set), 392 ref2string($set),
380 # h3("problem object"), 393 CGI::h3("problem object"),
381 # ref2string($problem), 394 ref2string($problem),
382 # h3("PG object"), 395 CGI::h3("PG object"),
383 # ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 396 ref2string($pg, {'WeBWorK::PG::Translator' => 1});
384 397
385 return ""; 398 return "";
386} 399}
387 400
388##### output utilities ##### 401##### output utilities #####
… …
417 CGI::h3("Warning messages"), 430 CGI::h3("Warning messages"),
418 CGI::blockquote(CGI::pre($warnings)), 431 CGI::blockquote(CGI::pre($warnings)),
419 ; 432 ;
420} 433}
421 434
422sub attemptResults($$$) { 435sub attemptResults($$$$$) {
436 my $self = shift;
423 my $pg = shift; 437 my $pg = shift;
424 my $showAttemptAnswers = shift; 438 my $showAttemptAnswers = shift;
425 my $showCorrectAnswers = shift; 439 my $showCorrectAnswers = shift;
426 my $showAttemptResults = $showAttemptAnswers && shift; 440 my $showAttemptResults = $showAttemptAnswers && shift;
427 my $problemResult = $pg->{result}; # the overall result of the problem 441 my $problemResult = $pg->{result}; # the overall result of the problem
428 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 442 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
429 443
430 my $header = CGI::th("answer"); 444 my $header = CGI::th("answer");
431 $header .= $showAttemptAnswers ? CGI::th("attempt") : ""; 445 $header .= $showAttemptAnswers ? CGI::th("attempt") : "";
446 $header .= $showAttemptAnswers ? CGI::th("preview") : "";
432 $header .= $showCorrectAnswers ? CGI::th("correct") : ""; 447 $header .= $showCorrectAnswers ? CGI::th("correct") : "";
433 $header .= $showAttemptResults ? CGI::th("result") : ""; 448 $header .= $showAttemptResults ? CGI::th("result") : "";
434 $header .= $showAttemptAnswers ? CGI::th("messages") : ""; 449 $header .= $showAttemptAnswers ? CGI::th("messages") : "";
435 my @tableRows = ( $header ); 450 my @tableRows = ( $header );
436 my $numCorrect; 451 my $numCorrect;
437 foreach my $name (@answerNames) { 452 foreach my $name (@answerNames) {
438 my $answerResult = $pg->{answers}->{$name}; 453 my $answerResult = $pg->{answers}->{$name};
439 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 454 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
455 my $preview = $self->previewAnswer($answerResult);
440 my $correctAnswer = $answerResult->{correct_ans}; 456 my $correctAnswer = $answerResult->{correct_ans};
441 my $answerScore = $answerResult->{score}; 457 my $answerScore = $answerResult->{score};
442 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; 458 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : "";
443 459
444 $numCorrect += $answerScore > 0; 460 $numCorrect += $answerScore > 0;
… …
448 # of the answer names is changeable. this only fixes 464 # of the answer names is changeable. this only fixes
449 $name =~ s/^AnSwEr//; 465 $name =~ s/^AnSwEr//;
450 466
451 my $row = CGI::td($name); 467 my $row = CGI::td($name);
452 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : ""; 468 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
469 $row .= $showAttemptAnswers ? CGI::td($preview) : "";
453 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : ""; 470 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
454 $row .= $showAttemptResults ? CGI::td($resultString) : ""; 471 $row .= $showAttemptResults ? CGI::td($resultString) : "";
455 $row .= $answerMessage ? CGI::td($answerMessage) : ""; 472 $row .= $answerMessage ? CGI::td($answerMessage) : "";
456 push @tableRows, $row; 473 push @tableRows, $row;
457 } 474 }
… …
513 $optionLine, 530 $optionLine,
514 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"), 531 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
515 ); 532 );
516} 533}
517 534
535sub previewAnswer($$) {
536 my ($self, $answerResult) = @_;
537 my $ce = $self->{courseEnvironment};
538 my $user = $self->{user};
539 my $set = $self->{set};
540 my $problem = $self->{problem};
541
542 # how are we going to name this?
543 my $targetPathCommon = "/png/"
544 . $user->id . "."
545 . $set->id . "."
546 . $problem->id . "."
547 . $answerResult->{ans_name} . ".png";
548
549 # figure out where to put things
550 my $wd = tempdir("webwork-dvipng-XXXXXXXX", DIR => $ce->{courseDirs}->{html_temp});
551 my $latex = $ce->{externalPrograms}->{latex};
552 my $dvipng = $ce->{externalPrograms}->{dvipng};
553 my $tex = $answerResult->{preview_latex_string};
554 my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
555 # should use surePathToTmpFile, but we have to
556 # isolate it from the problem enivronment first
557 my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
558
559 # call dvipng to generate a preview
560 dvipng($wd, $latex, $dvipng, $tex, $targetPath);
561 if (-e $targetPath) {
562 return "<img src=\"$targetURL\" alt=\"$tex\" />";
563 } else {
564 return "<b>[math2img failed]</b>";
565 }
566}
567
518##### permission queries ##### 568##### permission queries #####
519 569
520# this stuff should be abstracted out into the permissions system 570# this stuff should be abstracted out into the permissions system
521# however, the permission system only knows about things in the 571# however, the permission system only knows about things in the
522# course environment and the username. hmmm... 572# course environment and the username. hmmm...
Legend:
Removed from v.622  
changed lines
  Added in v.623
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9