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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 425 - (view) (download) (as text)

1 : malsyned 353 package WeBWorK::ContentGenerator::Problem;
2 : sh002i 415 use base qw(WeBWorK::ContentGenerator);
3 : malsyned 396
4 :     use strict;
5 :     use warnings;
6 : sh002i 424 use CGI qw(:html :form);
7 :     use WeBWorK::Utils qw(ref2string);
8 : sh002i 415 use WeBWorK::PG;
9 : sh002i 424 use WeBWorK::Form;
10 : malsyned 353
11 : sh002i 424 # user
12 :     # key
13 : sh002i 415 #
14 : sh002i 424 # displayMode
15 :     # showOldAnswers
16 :     # showCorrectAnswers
17 :     # showHints
18 :     # showSolutions
19 : sh002i 415 #
20 : sh002i 425 # AnSwEr# - answer blanks in problem
21 :     #
22 :     # redisplay - name of the "Redisplay" button
23 :     # processAnswers - name of "Submit Answers" button
24 : gage 392
25 : malsyned 353 sub title {
26 : sh002i 424 my ($self, $setName, $problemNumber) = @_;
27 :     my $userName = $self->{r}->param('user');
28 :     return "Problem $problemNumber of problem set $setName for $userName";
29 : malsyned 353 }
30 :    
31 :     sub body {
32 : sh002i 424 my ($self, $setName, $problemNumber) = @_;
33 :     my $courseEnv = $self->{courseEnvironment};
34 :     my $r = $self->{r};
35 :     my $userName = $r->param('user');
36 : malsyned 353
37 : sh002i 424 # fix format of setName and problem
38 :     # (i want dennis to cut "set" and "prob" off before calling me)
39 :     $setName =~ s/^set//;
40 :     $problemNumber =~ s/^prob//;
41 : gage 388
42 : sh002i 424 # get database information
43 :     my $classlist = WeBWorK::DB::Classlist->new($courseEnv);
44 :     my $wwdb = WeBWorK::DB::WW->new($courseEnv);
45 :     my $user = $classlist->getUser($userName);
46 :     my $set = $wwdb->getSet($userName, $setName);
47 :     my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
48 :     my $psvn = $wwdb->getPSVN($userName, $setName);
49 : malsyned 396
50 : sh002i 425 # set options from form fields (see comment at top of file for names)
51 : sh002i 424 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
52 :     my $showOldAnswers = $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers};
53 :     my $showCorrectAnswers = $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers};
54 :     my $showHints = $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints};
55 :     my $showSolutions = $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions};
56 : sh002i 425 my $redisplay = $r->param("redisplay");
57 : sh002i 424 my $processAnswers = $r->param("submitAnswers");
58 : gage 388
59 : sh002i 424 # coerce form fields into CGI::Vars format
60 :     my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
61 : gage 392
62 : sh002i 424 # TODO:
63 :     # 1. enforce privs for showCorrectAnswers and showSolutions
64 :     # (use $PRIV = $canPRIV && $wantPRIV -- cool syntax!)
65 :     # 2. if answers were not submitted and there are student answers in the DB,
66 :     # decode them and put them into $formFields for the translator
67 :     # 3. Latex2HTML massaging code
68 :     # 4. store submitted answers hash in database for sticky answers
69 :     # 5. deal with the results of answer evaluation and grading :p
70 :     # 6. introduce a recordAnswers option, which works on the same principle as
71 :     # the other priv-based options
72 : sh002i 425 # 7. make warnings work
73 : gage 392
74 : sh002i 424 my $pg = WeBWorK::PG->new(
75 :     $courseEnv,
76 :     $r->param('user'),
77 :     $r->param('key'),
78 :     $setName,
79 :     $problemNumber,
80 :     { # translation options
81 :     displayMode => $displayMode,
82 :     showHints => $showHints,
83 :     showSolutions => $showSolutions,
84 : sh002i 425 processAnswers => $processAnswers ? 1 : 0,
85 : sh002i 424 },
86 :     $formFields
87 :     );
88 : gage 392
89 : sh002i 425 if ($pg->{flags}->{error_flag}) {
90 :     # there was an error in translation
91 :     print h2("Software Error");
92 :     print p(<<EOF);
93 :     WeBWorK has encountered a software error while attempting to process this problem.
94 :     It is likely that there is an error in the problem itself.
95 :     If you are a student, contact your professor to have the error corrected.
96 :     If you are a professor, please consut the error output below for more informaiton.
97 :     EOF
98 :     print h3("Error messages"), blockquote(pre($pg->{errors}));
99 :     print h3("Error context"), blockquote(pre($pg->{body_text}));
100 :     return "";
101 :     }
102 : sh002i 415
103 : sh002i 425 # Previous answer results
104 :     if ($processAnswers) {
105 :     print h3("Results of your latest attempt");
106 :     print attemptResults($pg, $showCorrectAnswers, $pg->{flags}->{showPartialCorrectAnswers});
107 :     print hr();
108 :     }
109 :    
110 :     # main form
111 : sh002i 424 print startform("POST", $r->uri);
112 :     print $self->hidden_authen_fields;
113 : sh002i 425 print $self->hidden_fields(qw(displayMode showOldAnswers showCorrectAnswers showHints showSolutions));
114 :     print p($pg->{body_text});
115 :     print p(submit(-name=>"submitAnswers", -label=>"Submit Answers"));
116 :     print endform();
117 :     print hr();
118 :    
119 :     # view options
120 :     # what i'd really like to do here is:
121 :     # - preserve the answers currently in the form fields
122 :     # - display the answer summary box
123 :     # - NOT record answers UNDER ANY CIRCUMSTANCES!
124 :     print startform("POST", $r->uri);
125 :     #print $self->hidden_fields();
126 : sh002i 424 print p("View equations as: ",
127 :     radio_group(
128 :     -name => "displayMode",
129 :     -values => ['plainText', 'formattedText', 'images'],
130 :     -default => $displayMode,
131 :     -labels => {
132 :     plainText => "plain text",
133 :     formattedText => "formatted text",
134 :     images => "images",
135 :     }
136 :     ), br(),
137 :     checkbox(
138 :     -name => "showOldAnswers",
139 :     -checked => $showOldAnswers,
140 :     -label => "Show old answers",
141 :     ), br(),
142 : sh002i 425 checkbox(
143 :     -name => "showCorrectAnswers",
144 :     -checked => $showCorrectAnswers,
145 :     -label => "Show correct answers",
146 :     ), br(),
147 :     checkbox(
148 :     -name => "showHints",
149 :     -checked => $showHints,
150 :     -label => "Show hints",
151 :     ), br(),
152 :     checkbox(
153 :     -name => "showSolutions",
154 :     -checked => $showSolutions,
155 :     -label => "Show solutions",
156 :     ), br(),
157 : sh002i 424 );
158 : sh002i 425 print p(submit(-name=>"redisplay", -label=>"Redisplay Problem"));
159 : sh002i 424 print endform();
160 :     print hr();
161 : gage 392
162 : sh002i 424 # debugging stuff
163 :     print h2("debugging information");
164 :     print h3("form fields");
165 :     print ref2string($formFields);
166 :     print h3("PG object");
167 :     print ref2string($pg, {'WeBWorK::PG::Translator' => 1});
168 : gage 392
169 : sh002i 424 return "";
170 : malsyned 353 }
171 :    
172 : sh002i 425 sub attemptResults {
173 :     my $pg = shift;
174 :     my $showCorrectAnswers = shift;
175 :     my $showAttemptResults = shift;
176 :     my $problemResult = $pg->{result}; # the overall result of the problem
177 :     my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
178 :    
179 :     my $header = th("answer") . th("attempt");
180 :     $header .= $showCorrectAnswers ? th("correct") : "";
181 :     $header .= $showAttemptResults ? th("result") : "";
182 :     $header .= th("messages");
183 :     my @tableRows = ( $header );
184 :     my $numCorrect;
185 :     foreach my $name (@answerNames) {
186 :     my $answerResult = $pg->{answers}->{$name};
187 :     my $studentAnswer = $answerResult->{student_ans};
188 :     my $correctAnswer = $answerResult->{correct_ans};
189 :     my $answerScore = $answerResult->{score};
190 :     my $answerMessage = $answerResult->{ans_message};
191 :    
192 :     $numCorrect += $answerScore > 0;
193 :     my $resultString = $answerScore ? "correct :^)" : "incorrect >:(";
194 :    
195 :     my $row = td($name) . td($studentAnswer);
196 :     $row .= $showCorrectAnswers ? td($correctAnswer) : "";
197 :     $row .= $showAttemptResults ? td($resultString) : "";
198 :     $row .= $answerMessage ? td($answerMessage) : "";
199 :     push @tableRows, $row;
200 :     }
201 :    
202 :     my $scorePercent = int ($problemResult->{score} * 100) . "\%";
203 :     my $message = i($problemResult->{msg});
204 :     my $summary = "You answered $numCorrect questions out of "
205 :     . scalar @answerNames . " correct, for a score of $scorePercent.";
206 :     return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary);
207 :     }
208 :    
209 : sh002i 415 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9