[system] / branches / rel-2-2-dev / webwork2 / lib / WeBWorK / ContentGenerator / Problem.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-2-dev/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm

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

Revision 1387 Revision 1539
… …
9=head1 NAME 9=head1 NAME
10 10
11WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. 11WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem.
12 12
13=cut 13=cut
14my $timer0_ON=1; # times pg translation phase 14
15use strict; 15use strict;
16use warnings; 16use warnings;
17use CGI qw(); 17use CGI qw();
18use File::Path qw(rmtree); 18use File::Path qw(rmtree);
19use WeBWorK::Form; 19use WeBWorK::Form;
… …
21use WeBWorK::PG::ImageGenerator; 21use WeBWorK::PG::ImageGenerator;
22use WeBWorK::PG::IO; 22use WeBWorK::PG::IO;
23use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory); 23use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory);
24use WeBWorK::DB::Utils qw(global2user user2global findDefaults); 24use WeBWorK::DB::Utils qw(global2user user2global findDefaults);
25use WeBWorK::Timing; 25use WeBWorK::Timing;
26
27my $timer0_ON=0; # times pg translation phase
26 28
27############################################################ 29############################################################
28# 30#
29# user 31# user
30# effectiveUser 32# effectiveUser
… …
40# 42#
41# redisplay - name of the "Redisplay Problem" button 43# redisplay - name of the "Redisplay Problem" button
42# submitAnswers - name of "Submit Answers" button 44# submitAnswers - name of "Submit Answers" button
43# checkAnswers - name of the "Check Answers" button 45# checkAnswers - name of the "Check Answers" button
44# previewAnswers - name of the "Preview Answers" button 46# previewAnswers - name of the "Preview Answers" button
47#
48# FIXME: this table is heinously out of date
45# 49#
46############################################################ 50############################################################
51
52sub templateName {
53 "problem";
54}
47 55
48sub pre_header_initialize { 56sub pre_header_initialize {
49 my ($self, $setName, $problemNumber) = @_; 57 my ($self, $setName, $problemNumber) = @_;
50 my $r = $self->{r}; 58 my $r = $self->{r};
51 my $courseEnv = $self->{ce}; 59 my $courseEnv = $self->{ce};
… …
160 #$self->{edit_mode} = $editMode; 168 #$self->{edit_mode} = $editMode;
161 #$self->{current_problem_source} = (defined($override_problem_source) ) ? 169 #$self->{current_problem_source} = (defined($override_problem_source) ) ?
162 170
163 # coerce form fields into CGI::Vars format 171 # coerce form fields into CGI::Vars format
164 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 172 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
173
165 174
166 $self->{displayMode} = $displayMode; 175 $self->{displayMode} = $displayMode;
167 $self->{redisplay} = $redisplay; 176 $self->{redisplay} = $redisplay;
168 $self->{submitAnswers} = $submitAnswers; 177 $self->{submitAnswers} = $submitAnswers;
169 $self->{checkAnswers} = $checkAnswers; 178 $self->{checkAnswers} = $checkAnswers;
… …
205 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, 214 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
206 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), 215 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
207 # attempts=num_correct+num_incorrect+1, as this happens before updating $problem 216 # attempts=num_correct+num_incorrect+1, as this happens before updating $problem
208 checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date), 217 checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date),
209 ); 218 );
219 #########################################################
220 # more complicated logic for showing check answer button:
221 #########################################################
222 # checkAnswers button shows up after due date -- once a student can't record anymore
223 # checkAnswers button always shows up when an instructor or TA is acting
224 # as someone else (the $user and $effectiveUserName aren't the same).
225 $can{checkAnswers} = ($can{checkAnswers} && not $can{recordAnswers} ) ||
226 ( defined($userName) and defined($effectiveUserName) and
227 ($userName ne $effectiveUserName)
228 );
229 #########################################################
230 # more complicated logif for showing "submit answer" button
231 #########################################################
232 # We hide the submit answer button if someone is acting as a student
233 # This prevents errors where you accidently submit the answer for a student
234 # Not sure whether this a feature or a bug
210 235
236 $can{recordAnswers} = ($can{recordAnswers} and not
237 ( defined($userName) and defined($effectiveUserName) and
238 ($userName ne $effectiveUserName)
239 )
240 );
211 # final values for options 241 # final values for options
212 my %will; 242 my %will;
213 foreach (keys %must) { 243 foreach (keys %must) {
214 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 244 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
215 } 245 }
… …
412 my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); 442 my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id);
413 if (defined $pureProblem) { 443 if (defined $pureProblem) {
414 # store answers in DB for sticky answers 444 # store answers in DB for sticky answers
415 my %answersToStore; 445 my %answersToStore;
416 my %answerHash = %{ $pg->{answers} }; 446 my %answerHash = %{ $pg->{answers} };
417 $answersToStore{$_} = $answerHash{$_}->{original_student_ans} 447 $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!!
418 foreach (keys %answerHash); 448 foreach (keys %answerHash);
449 # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating
450 # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs
451 # however we need to store them. Fortunately they are still in the input form.
452 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}};
453
454 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names);
455
456 # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order
457 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names);
419 my $answerString = encodeAnswers(%answersToStore, 458 my $answerString = encodeAnswers(%answersToStore,
420 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); 459 @answer_order);
421 460
422 # store last answer to database 461 # store last answer to database
423 $problem->last_answer($answerString); 462 $problem->last_answer($answerString);
424 $pureProblem->last_answer($answerString); 463 $pureProblem->last_answer($answerString);
425 $db->putUserProblem($pureProblem); 464 $db->putUserProblem($pureProblem);
… …
504 print CGI::p(CGI::i("Problem saved to: ", $problem->source_file)); 543 print CGI::p(CGI::i("Problem saved to: ", $problem->source_file));
505 } 544 }
506 } 545 }
507 546
508 # attempt summary 547 # attempt summary
509 if ($submitAnswers or $will{showCorrectAnswers}) { 548 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything.
549 # until after the due date
550 # do I need to check $wills{howCorrectAnswers} to make preflight work??
551 if (($pg->{flags}->{showPartialCorrectAnswers}>= 0 and $submitAnswers) ) {
510 # print this if user submitted answers OR requested correct answers 552 # print this if user submitted answers OR requested correct answers
553
511 print $self->attemptResults($pg, $submitAnswers, 554 print $self->attemptResults($pg, 1,
512 $will{showCorrectAnswers}, 555 $will{showCorrectAnswers},
513 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); 556 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1);
514 } elsif ($checkAnswers) { 557 } elsif ($checkAnswers) {
515 # print this if user previewed answers 558 # print this if user previewed answers
559 print "ANSWERS ONLY CHECKED -- ",CGI::br(),"ANSWERS NOT RECORDED", CGI::br();
516 print $self->attemptResults($pg, 1, 0, 1, 1, 1); 560 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1);
517 # show attempt answers 561 # show attempt answers
518 # don't show correct answers 562 # show correct answers if asked
519 # show attempt results (correctness) 563 # show attempt results (correctness)
520 # don't show attempt previews 564 # show attempt previews
521 } elsif ($previewAnswers) { 565 } elsif ($previewAnswers) {
522 # print this if user previewed answers 566 # print this if user previewed answers
523 print $self->attemptResults($pg, 1, 0, 0, 0, 1); 567 print "PREVIEW ONLY -- NOT RECORDED",CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1);
524 # show attempt answers 568 # show attempt answers
525 # don't show correct answers 569 # don't show correct answers
526 # don't show attempt results (correctness) 570 # don't show attempt results (correctness)
527 # show attempt previews 571 # show attempt previews
528 } 572 }
… …
536 CGI::startform("POST", $r->uri), 580 CGI::startform("POST", $r->uri),
537 $self->hidden_authen_fields, 581 $self->hidden_authen_fields,
538 CGI::p($pg->{body_text}), 582 CGI::p($pg->{body_text}),
539 CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})), 583 CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})),
540 CGI::p( 584 CGI::p(
585 ($can{showCorrectAnswers}
586 ? CGI::checkbox(
587 -name => "showCorrectAnswers",
588 -checked => $will{showCorrectAnswers},
589 -label => "Show correct answers",
590 ) ." "
591 : "" ),
592 ($can{showHints}
593 ? CGI::checkbox(
594 -name => "showHints",
595 -checked => $will{showHints},
596 -label => "Show Hints",
597 ) . " "
598 : " " ),
599 ($can{showSolutions}
600 ? CGI::checkbox(
601 -name => "showSolutions",
602 -checked => $will{showSolutions},
603 -label => "Show Solutions",
604 ) . " "
605 : " " ),CGI::br(),
606 CGI::submit(-name=>"previewAnswers",
607 -label=>"Preview Answers"),
541 ($can{recordAnswers} 608 ($can{recordAnswers}
542 ? CGI::submit(-name=>"submitAnswers", 609 ? CGI::submit(-name=>"submitAnswers",
543 -label=>"Submit Answers") 610 -label=>"Submit Answers")
544 : ""), 611 : ""),
545 ($can{checkAnswers} 612 ( $can{checkAnswers}
546 ? CGI::submit(-name=>"checkAnswers", 613 ? CGI::submit(-name=>"checkAnswers",
547 -label=>"Check Answers") 614 -label=>"Check Answers")
548 : ""), 615 : ""),
549 CGI::submit(-name=>"previewAnswers",
550 -label=>"Preview Answers"),
551 ); 616 );
552 print CGI::end_div(); 617 print CGI::end_div();
553 618
554 print CGI::start_div({class=>"scoreSummary"}); 619 print CGI::start_div({class=>"scoreSummary"});
555 620
… …
591 # save state for viewOptions 656 # save state for viewOptions
592 print CGI::hidden( 657 print CGI::hidden(
593 -name => "showOldAnswers", 658 -name => "showOldAnswers",
594 -value => $will{showOldAnswers} 659 -value => $will{showOldAnswers}
595 ), 660 ),
596 CGI::hidden( 661
597 -name => "showCorrectAnswers",
598 -value => $will{showCorrectAnswers}
599 ),
600 CGI::hidden(
601 -name => "showHints",
602 -value => $will{showHints}),
603 CGI::hidden(
604 -name => "showSolutions",
605 -value => $will{showSolutions},
606 ),
607 CGI::hidden( 662 CGI::hidden(
608 -name => "displayMode", 663 -name => "displayMode",
609 -value => $self->{displayMode} 664 -value => $self->{displayMode}
610 ); 665 );
611 666
… …
619 674
620 print CGI::start_div({class=>"problemFooter"}); 675 print CGI::start_div({class=>"problemFooter"});
621 676
622 # arguments for answer inspection button 677 # arguments for answer inspection button
623 my $prof_url = $ce->{webworkURLs}->{oldProf}; 678 my $prof_url = $ce->{webworkURLs}->{oldProf};
679 my $webworkURL = $ce->{webworkURLs}->{root};
624 my $cgi_url = $prof_url; 680 my $cgi_url = $prof_url;
625 $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl 681 $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl
626 my $authen_args = $self->url_authen_args(); 682 my $authen_args = $self->url_authen_args();
627 my $showPastAnswersURL = "$cgi_url/showPastAnswers.pl"; 683 my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/";
628 684
629 # print answer inspection button 685 # print answer inspection button
630 if ($self->{permissionLevel} > 0) { 686 if ($self->{permissionLevel} > 0) {
631 print "\n", 687 print "\n",
632 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", 688 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n",
633 $self->hidden_authen_fields,"\n", 689 $self->hidden_authen_fields,"\n",
634 CGI::hidden(-name => 'course', -value=>$courseName), "\n", 690 CGI::hidden(-name => 'course', -value=>$courseName), "\n",
635 CGI::hidden(-name => 'probNum', -value=>$problem->problem_id), "\n", 691 CGI::hidden(-name => 'problemNumber', -value=>$problem->problem_id), "\n",
636 CGI::hidden(-name => 'setNum', -value=>$problem->set_id), "\n", 692 CGI::hidden(-name => 'setName', -value=>$problem->set_id), "\n",
637 CGI::hidden(-name => 'User', -value=>$problem->user_id), "\n", 693 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n",
638 CGI::p( {-align=>"left"}, 694 CGI::p( {-align=>"left"},
639 CGI::submit(-name => 'action', -value=>'Show Past Answers') 695 CGI::submit(-name => 'action', -value=>'Show Past Answers')
640 ), "\n", 696 ), "\n",
641 CGI::endform(); 697 CGI::endform();
642 } 698 }
… …
659 CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", 715 CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n",
660 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", 716 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n",
661 CGI::hidden("showHints", $will{showHints}),"\n", 717 CGI::hidden("showHints", $will{showHints}),"\n",
662 CGI::hidden("showSolutions", $will{showSolutions}),"\n", 718 CGI::hidden("showSolutions", $will{showSolutions}),"\n",
663 CGI::p({-align=>"left"}, 719 CGI::p({-align=>"left"},
664 CGI::submit(-name=>"feedbackForm", -label=>"Contact instructor") 720 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor")
665 ), 721 ),
666 CGI::endform(),"\n"; 722 CGI::endform(),"\n";
667 723
668 # FIXME print editor link 724 # FIXME print editor link
669 # print editor link if the user is an instructor AND the file is not in temporary editing mode 725 # print editor link if the user is an instructor AND the file is not in temporary editing mode
… …
716 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 772 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
717 773
718 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 774 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview";
719 my $imgGen = WeBWorK::PG::ImageGenerator->new( 775 my $imgGen = WeBWorK::PG::ImageGenerator->new(
720 tempDir => $ce->{webworkDirs}->{tmp}, 776 tempDir => $ce->{webworkDirs}->{tmp},
721 dir => $ce->{courseDirs}->{html_temp},
722 url => $ce->{courseURLs}->{html_temp},
723 basename => $basename,
724 latex => $ce->{externalPrograms}->{latex}, 777 latex => $ce->{externalPrograms}->{latex},
725 dvipng => $ce->{externalPrograms}->{dvipng}, 778 dvipng => $ce->{externalPrograms}->{dvipng},
779 useCache => 1,
780 cacheDir => $ce->{webworkDirs}->{equationCache},
781 cacheURL => $ce->{webworkURLs}->{equationCache},
782 cacheDB => $ce->{webworkFiles}->{equationCacheDB},
726 ); 783 );
727 784
728 my $header; 785 my $header;
729 #$header .= CGI::th("Part"); 786 #$header .= CGI::th("Part");
730 $header .= $showAttemptAnswers ? CGI::th("Entered") : ""; 787 $header .= $showAttemptAnswers ? CGI::th("Entered") : "";
… …
741 ? $self->previewAnswer($answerResult, $imgGen) 798 ? $self->previewAnswer($answerResult, $imgGen)
742 : ""); 799 : "");
743 my $correctAnswer = $answerResult->{correct_ans}; 800 my $correctAnswer = $answerResult->{correct_ans};
744 my $answerScore = $answerResult->{score}; 801 my $answerScore = $answerResult->{score};
745 my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; 802 my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
746 803 #FIXME --Can we be sure that $answerScore is an integer-- could the problem give partial credit?
747 $numCorrect += $answerScore > 0; 804 $numCorrect += $answerScore > 0;
748 my $resultString = $answerScore ? "correct" : "incorrect"; 805 my $resultString = $answerScore ? "correct" : "incorrect";
749 806
750 # get rid of the goofy prefix on the answer names (supposedly, the format 807 # get rid of the goofy prefix on the answer names (supposedly, the format
751 # of the answer names is changeable. this only fixes it for "AnSwEr" 808 # of the answer names is changeable. this only fixes it for "AnSwEr"
752 $name =~ s/^AnSwEr//; 809 #$name =~ s/^AnSwEr//;
753 810
754 my $row; 811 my $row;
755 #$row .= CGI::td($name); 812 #$row .= CGI::td($name);
756 $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : ""; 813 $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : "";
757 $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : ""; 814 $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : "";
… …
762 } 819 }
763 820
764 # render equation images 821 # render equation images
765 $imgGen->render(refresh => 1); 822 $imgGen->render(refresh => 1);
766 823
767 my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; 824# my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
768 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); 825 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100);
826# FIXME -- I left the old code in in case we have to back out.
769 my $summary = "On this attempt, you answered $numCorrect out of " 827# my $summary = "On this attempt, you answered $numCorrect out of "
770 . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; 828# . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
771 return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); 829 my $summary = "";
830 if (scalar @answerNames == 1) {
831 if ($numCorrect == scalar @answerNames) {
832 $summary .= "The above answer is correct.";
833 } else {
834 $summary .= "The above answer is NOT correct.";
835 }
836 } else {
837 if ($numCorrect == scalar @answerNames) {
838 $summary .= "All of the above answers are correct.";
839 } else {
840 $summary .= "At least one of the above answers is NOT correct.";
841 }
842 }
843 #FIXME there must be a better way to force refresh.
844 my $refresh_warning = 'Hold down shift and click "refresh" or "reload" to update answer preview images.';
845 return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) .
846 CGI::div({style=>'color:red; font-size:10pt'},$refresh_warning) .
847 ($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
772} 848}
773sub nbsp { 849sub nbsp {
774 my $str = shift; 850 my $str = shift;
775 ($str =~/\S/) ? $str : ' ' ; # returns non-breaking space for empty strings 851 ($str =~/\S/) ? $str : ' ' ; # returns non-breaking space for empty strings
776 # tricky cases: $str =0; 852 # tricky cases: $str =0;
… …
789 CGI::checkbox( 865 CGI::checkbox(
790 -name => "showOldAnswers", 866 -name => "showOldAnswers",
791 -checked => $will{showOldAnswers}, 867 -checked => $will{showOldAnswers},
792 -label => "Saved answers", 868 -label => "Saved answers",
793 ), "  ".CGI::br(); 869 ), "  ".CGI::br();
794 $can{showCorrectAnswers} and $optionLine .= join "", 870
795 CGI::checkbox(
796 -name => "showCorrectAnswers",
797 -checked => $will{showCorrectAnswers},
798 -label => "Correct answers",
799 ), "  ".CGI::br();
800 $can{showHints} and $optionLine .= join "",
801 CGI::checkbox(
802 -name => "showHints",
803 -checked => $will{showHints},
804 -label => "Hints",
805 ), "  ".CGI::br();
806 $can{showSolutions} and $optionLine .= join "",
807 CGI::checkbox(
808 -name => "showSolutions",
809 -checked => $will{showSolutions},
810 -label => "Solutions",
811 ), "  ".CGI::br();
812 $optionLine and $optionLine .= join "", CGI::br(); 871 $optionLine and $optionLine .= join "", CGI::br();
813 872
814 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"}, 873 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"},
815 "View equations as:    ".CGI::br(), 874 "View equations as:    ".CGI::br(),
816 CGI::radio_group( 875 CGI::radio_group(
Legend:
Removed from v.1387  
changed lines
  Added in v.1539
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9