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

Diff of /branches/gage_dev/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm

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

Revision 430 Revision 431
… …
29} 29}
30 30
31# TODO: 31# TODO:
32# :) enforce permissions for showCorrectAnswers and showSolutions 32# :) enforce permissions for showCorrectAnswers and showSolutions
33# (use $PRIV = $mustPRIV || ($canPRIV && $wantPRIV) -- cool syntax!) 33# (use $PRIV = $mustPRIV || ($canPRIV && $wantPRIV) -- cool syntax!)
34# 2. if answers were not submitted and there are student answers in the DB, 34# :) if answers were not submitted and there are student answers in the DB,
35# decode them and put them into $formFields for the translator 35# decode them and put them into $formFields for the translator
36# 3. Latex2HTML massaging code 36# 3. Latex2HTML massaging code
37# 4. store submitted answers hash in database for sticky answers 37# :) store submitted answers hash in database for sticky answers
38# 5. deal with the results of answer evaluation and grading :p 38# :) deal with the results of answer evaluation and grading :p
39# :) introduce a recordAnswers option, which works on the same principle as 39# :) introduce a recordAnswers option, which works on the same principle as
40# the other permission-based options 40# the other permission-based options
41# 7. make warnings work 41# 7. make warnings work
42 42
43sub body { 43sub body {
… …
49 # fix format of setName and problem 49 # fix format of setName and problem
50 $setName =~ s/^set//; 50 $setName =~ s/^set//;
51 $problemNumber =~ s/^prob//; 51 $problemNumber =~ s/^prob//;
52 52
53 ##### database setup ##### 53 ##### database setup #####
54 # this should probably go in initialize() or whatever it's called
54 55
55 my $classlist = WeBWorK::DB::Classlist->new($courseEnv); 56 my $classlist = WeBWorK::DB::Classlist->new($courseEnv);
56 my $wwdb = WeBWorK::DB::WW->new($courseEnv); 57 my $wwdb = WeBWorK::DB::WW->new($courseEnv);
57 my $authdb = WeBWorK::DB::Auth->new($courseEnv); 58 my $authdb = WeBWorK::DB::Auth->new($courseEnv);
58 59
59 my $user = $classlist->getUser($userName); 60 my $user = $classlist->getUser($userName);
60 my $set = $wwdb->getSet($userName, $setName); 61 my $set = $wwdb->getSet($userName, $setName);
61 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 62 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
62 my $psvn = $wwdb->getPSVN($userName, $setName);
63 my $permissionLevel = $authdb->getPermissions($userName); 63 my $permissionLevel = $authdb->getPermissions($userName);
64 64
65 ##### form processing ##### 65 ##### form processing #####
66 66
67 # set options from form fields (see comment at top of file for names) 67 # set options from form fields (see comment at top of file for names)
68 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 68 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
69 my $redisplay = $r->param("redisplay"); 69 my $redisplay = $r->param("redisplay");
70 my $submitAnswers = $r->param("submitAnswers"); 70 my $submitAnswers = $r->param("submitAnswers");
71 71
72 my %want = (
72 my $wantShowOldAnswers = $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}; 73 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
73 my $wantShowCorrectAnswers = $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}; 74 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
74 my $wantShowHints = $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}; 75 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
75 my $wantShowSolutions = $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}; 76 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
76 my $wantRecordAnswers = $r->param("recordAnswers") || 1; 77 recordAnswers => $r->param("recordAnswers") || 1,
78 );
77 79
78 # coerce form fields into CGI::Vars format 80 # coerce form fields into CGI::Vars format
79 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 81 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
80 82
81 ##### permissions ##### 83 ##### permissions #####
82 84
85 # are certain options enforced?
86 my %must = (
87 showOldAnswers => 0,
88 showCorrectAnswers => 0,
89 showHints => 0,
90 showSolutions => 0,
91 recordAnswers => mustRecordAnswers($permissionLevel),
92 );
93
83 # does the user have permission to use certain options? 94 # does the user have permission to use certain options?
95 my %can = (
84 my $canShowOldAnswers = 1; 96 showOldAnswers => 1,
85 my $canShowCorrectAnswers = canShowCorrectAnswers($permissionLevel, $set->answer_date); 97 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),
86 my $canShowHints = 1; 98 showHints => 1,
87 my $canShowSolutions = canShowSolutions($permissionLevel, $set->answer_date); 99 showSolutions => canShowSolutions($permissionLevel, $set->answer_date),
88 my $canRecordAnswers = canRecordAnswers($permissionLevel, $set->open_date, $set->due_date); 100 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
89 101 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
90 # are certain options enforced? 102 # num_correct+num_incorrect+1 -- as this happens before updating $problem
91 my $mustShowOldAnswers = 0; 103 );
92 my $mustShowCorrectAnswers = 0;
93 my $mustShowHints = 0;
94 my $mustShowSolutions = 0;
95 my $mustRecordAnswers = mustRecordAnswers($permissionLevel);
96 104
97 # final values for options 105 # final values for options
98 my $showOldAnswers = $mustShowOldAnswers || ($canShowOldAnswers && $wantShowOldAnswers ); 106 my %will;
99 my $showCorrectAnswers = $mustShowCorrectAnswers || ($canShowCorrectAnswers && $wantShowCorrectAnswers); 107 foreach(keys %must) {
100 my $showHints = $mustShowHints || ($canShowHints && $wantShowHints ); 108 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
101 my $showSolutions = $mustShowSolutions || ($canShowSolutions && $wantShowSolutions ); 109 }
102 my $recordAnswers = $mustRecordAnswers || ($canRecordAnswers && $wantRecordAnswers );
103 110
104 ##### sticky answers ##### 111 ##### sticky answers #####
105 112
106 # [TODO #2]
107
108 if (not $submitAnswers and $showOldAnswers) { 113 if (not $submitAnswers and $will{showOldAnswers}) {
109 # only do this if new answers are NOT being submitted 114 # do this only if new answers are NOT being submitted
110 my %oldAnswers = decodeAnswers($problem->last_answer); 115 my %oldAnswers = decodeAnswers($problem->last_answer);
111 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; 116 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
112 } 117 }
113 118
114 ##### translation ##### 119 ##### translation #####
… …
119 $r->param('key'), 124 $r->param('key'),
120 $setName, 125 $setName,
121 $problemNumber, 126 $problemNumber,
122 { # translation options 127 { # translation options
123 displayMode => $displayMode, 128 displayMode => $displayMode,
124 showHints => $showHints, 129 showHints => $will{showHints},
125 showSolutions => $showSolutions, 130 showSolutions => $will{showSolutions},
126 # try leaving processAnswers on all the time: 131 # try leaving processAnswers on all the time?
127 processAnswers => 1, #$submitAnswers ? 1 : 0, 132 processAnswers => 1, #$submitAnswers ? 1 : 0,
128 }, 133 },
129 $formFields 134 $formFields
130 ); 135 );
131 136
… …
143 148
144 ##### answer processing ##### 149 ##### answer processing #####
145 150
146 # if answers were submitted: 151 # if answers were submitted:
147 if ($submitAnswers) { 152 if ($submitAnswers) {
148 # store answers in DB for sticky answers [TODO #4] 153 # store answers in DB for sticky answers
149 my %answersToStore; 154 my %answersToStore;
150 my %answerHash = %{ $pg->{answers} }; 155 my %answerHash = %{ $pg->{answers} };
151 $answersToStore{$_} = $answerHash{$_}->{original_student_ans} 156 $answersToStore{$_} = $answerHash{$_}->{original_student_ans}
152 foreach (keys %answerHash); 157 foreach (keys %answerHash);
153 my $answerString = encodeAnswers(%answersToStore, 158 my $answerString = encodeAnswers(%answersToStore,
154 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); 159 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
155 $problem->last_answer($answerString); 160 $problem->last_answer($answerString);
156 $wwdb->setProblem($problem); 161 $wwdb->setProblem($problem);
157 162
158 # store score in DB if it makes sense [TODO #5] 163 # store score in DB if it makes sense
164 if ($will{recordAnswers}) {
165 # the grader makes a lot of decisions for us...
166 # all we have to do is update information from
167 # the 'state' hash in the $pg hash.
168 $problem->attempted(1);
169 $problem->status($pg->{state}->{recorded_score});
170 $problem->num_correct($pg->{state}->{num_of_correct_ans});
171 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
172 #warn "Would have stored the following:\n",
173 # $problem->toString, "\n";
174 $wwdb->setProblem($problem);
175 } else {
176 print p("Your score was not recorded for some reason. ;)");
159 177 }
160 # print the answer summary table
161 print
162 h3("Results of your latest attempt"),
163 attemptResults($pg, $showCorrectAnswers,
164 $pg->{flags}->{showPartialCorrectAnswers}),
165 hr();
166 } 178 }
167 179
168 ##### output ##### 180 ##### output #####
169 181
170 # view options 182 # attempt summary
171 # what i'd really like to do here is: 183 if ($submitAnswers or $will{showCorrectAnswers}) {
172 # - preserve the answers currently in the form fields 184 # print this if user submitted answers OR requested correct answers
173 # - display the answer summary box 185 print attemptResults($pg, $submitAnswers, $will{showCorrectAnswers},
174 # - NOT record answers UNDER ANY CIRCUMSTANCES! 186 $pg->{flags}->{showPartialCorrectAnswers});
187 }
188
189 # score summary
190 my $attempts = $problem->num_correct + $problem->num_incorrect;
191 my $attemptsNoun = $attempts != 1 ? "times" : "time";
192 my $lastScore = int ($problem->status * 100) . "%";
193 my ($attemptsLeft, $attemptsLeftNoun);
194 if ($problem->max_attempts == -1) {
195 # unlimited attempts
196 $attemptsLeft = "unlimited";
197 $attemptsLeftNoun = "attempts";
198 } else {
199 $attemptsLeft = $problem->max_attempts - $attempts;
200 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
201 }
202 print p(
203 "You have attempted this problem $attempts $attemptsNoun.", br(),
204 $problem->attempted
205 ? "Your recorded score is $lastScore." . br()
206 : "",
207 "You have $attemptsLeft $attemptsLeftNoun remaining."
208 );
209
210 # BY THE WAY..........
211 # we have to figure out some way to tell the student if their NEW answer,
212 # on THIS attempt, has been recorded. however, this is decided in part by
213 # the grader, so is there any way for us to know? we can rule out several
214 # cases where the answer is NOT being recorded, because of things decided
215 # in &canRecordAnswers...
216
217 print hr();
175 218
176 # main form 219 # main form
177 print 220 print
178 startform("POST", $r->uri), 221 startform("POST", $r->uri),
179 $self->hidden_authen_fields, 222 $self->hidden_authen_fields,
223 p(i($pg->{result}->{msg})),
180 p($pg->{body_text}), 224 p($pg->{body_text}),
181 p(submit(-name=>"submitAnswers", -label=>"Submit Answers")), 225 p(submit(-name=>"submitAnswers", -label=>"Submit Answers")),
182 viewOptions($displayMode, $showOldAnswers, $showCorrectAnswers, 226 viewOptions($displayMode, \%must, \%can, \%will),
183 $showHints, $showSolutions),
184 endform(), 227 endform(),
185 hr(); 228 hr();
186 229
187 # debugging stuff 230 # debugging stuff
188 print 231 print
… …
199 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 242 ref2string($pg, {'WeBWorK::PG::Translator' => 1});
200 243
201 return ""; 244 return "";
202} 245}
203 246
204# ----- 247##### output utilities #####
205 248
206sub translationError($$) { 249sub translationError($$) {
207 my ($error, $details) = @_; 250 my ($error, $details) = @_;
208 return 251 return
209 p(<<EOF), 252 p(<<EOF),
… …
216 h3("Error context"), blockquote(pre($details)); 259 h3("Error context"), blockquote(pre($details));
217} 260}
218 261
219sub attemptResults($$$) { 262sub attemptResults($$$) {
220 my $pg = shift; 263 my $pg = shift;
264 my $showAttemptAnswers = shift;
221 my $showCorrectAnswers = shift; 265 my $showCorrectAnswers = shift;
222 my $showAttemptResults = shift; 266 my $showAttemptResults = $showAttemptAnswers && shift;
223 my $problemResult = $pg->{result}; # the overall result of the problem 267 my $problemResult = $pg->{result}; # the overall result of the problem
224 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 268 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
225 269
226 my $header = th("answer") . th("attempt"); 270 my $header = th("answer");
271 $header .= $showAttemptAnswers ? th("attempt") : "";
227 $header .= $showCorrectAnswers ? th("correct") : ""; 272 $header .= $showCorrectAnswers ? th("correct") : "";
228 $header .= $showAttemptResults ? th("result") : ""; 273 $header .= $showAttemptResults ? th("result") : "";
229 $header .= th("messages"); 274 $header .= $showAttemptAnswers ? th("messages") : "";
230 my @tableRows = ( $header ); 275 my @tableRows = ( $header );
231 my $numCorrect; 276 my $numCorrect;
232 foreach my $name (@answerNames) { 277 foreach my $name (@answerNames) {
233 my $answerResult = $pg->{answers}->{$name}; 278 my $answerResult = $pg->{answers}->{$name};
234 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 279 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
235 my $correctAnswer = $answerResult->{correct_ans}; 280 my $correctAnswer = $answerResult->{correct_ans};
236 my $answerScore = $answerResult->{score}; 281 my $answerScore = $answerResult->{score};
237 my $answerMessage = $answerResult->{ans_message}; 282 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : "";
238 283
239 $numCorrect += $answerScore > 0; 284 $numCorrect += $answerScore > 0;
240 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 285 my $resultString = $answerScore ? "correct :^)" : "incorrect >:(";
241 286
242 my $row = td($name) . td($studentAnswer); 287 my $row = td($name);
288 $row .= $showAttemptAnswers ? td($studentAnswer) : "";
243 $row .= $showCorrectAnswers ? td($correctAnswer) : ""; 289 $row .= $showCorrectAnswers ? td($correctAnswer) : "";
244 $row .= $showAttemptResults ? td($resultString) : ""; 290 $row .= $showAttemptResults ? td($resultString) : "";
245 $row .= $answerMessage ? td($answerMessage) : ""; 291 $row .= $answerMessage ? td($answerMessage) : "";
246 push @tableRows, $row; 292 push @tableRows, $row;
247 } 293 }
248 294
295 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions";
249 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 296 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
250 my $message = i($problemResult->{msg}); 297 #my $message = i($problemResult->{msg});
251 my $summary = "You answered $numCorrect questions out of " 298 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of "
252 . scalar @answerNames . " correct, for a score of $scorePercent."; 299 . scalar @answerNames . " correct, for a score of $scorePercent.";
253 return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary); 300 #return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary);
301 return table({-border=>1}, Tr(\@tableRows)) . p($summary);
254} 302}
255 303
256sub viewOptions($$$$$) { 304sub viewOptions($\%\%\%) {
257 my ($displayMode, $showOldAnswers, $showCorrectAnswers, 305 my $displayMode = shift;
258 $showHints, $showSolutions) = @_; 306 my %must = %{ shift() };
307 my %can = %{ shift() };
308 my %will = %{ shift() };
309
310 my $optionLine;
311 $can{showOldAnswers} and $optionLine .= join "",
312 "Show: &nbsp;",
313 checkbox(
314 -name => "showOldAnswers",
315 -checked => $will{showOldAnswers},
316 -label => "Saved answers",
317 ), "&nbsp;&nbsp;";
318 $can{showCorrectAnswers} and $optionLine .= join "",
319 checkbox(
320 -name => "showCorrectAnswers",
321 -checked => $will{showCorrectAnswers},
322 -label => "Correct answers",
323 ), "&nbsp;&nbsp;";
324 $can{showHints} and $optionLine .= join "",
325 checkbox(
326 -name => "showHints",
327 -checked => $will{showHints},
328 -label => "Hints",
329 ), "&nbsp;&nbsp;";
330 $can{showSolutions} and $optionLine .= join "",
331 checkbox(
332 -name => "showSolutions",
333 -checked => $will{showSolutions},
334 -label => "Solutions",
335 ), "&nbsp;&nbsp;";
336 $optionLine and $optionLine .= join "", br();
337
259 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, 338 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
260 "View equations as: &nbsp;", 339 "View equations as: &nbsp;",
261 radio_group( 340 radio_group(
262 -name => "displayMode", 341 -name => "displayMode",
263 -values => ['plainText', 'formattedText', 'images'], 342 -values => ['plainText', 'formattedText', 'images'],
264 -default => $displayMode, 343 -default => $displayMode,
265 -labels => { 344 -labels => {
266 plainText => "plain text", 345 plainText => "plain text",
267 formattedText => "formatted text", 346 formattedText => "formatted text",
268 images => "images", 347 images => "images",
269 } 348 }
270 ), br(), 349 ), br(),
271 "Show: &nbsp;", 350 $optionLine,
272 checkbox(
273 -name => "showOldAnswers",
274 -checked => $showOldAnswers,
275 -label => "Old answers",
276 ), "&nbsp;&nbsp;",
277 checkbox(
278 -name => "showCorrectAnswers",
279 -checked => $showCorrectAnswers,
280 -label => "Correct answers",
281 ), "&nbsp;&nbsp;",
282 checkbox(
283 -name => "showHints",
284 -checked => $showHints,
285 -label => "Hints",
286 ), "&nbsp;&nbsp;",
287 checkbox(
288 -name => "showSolutions",
289 -checked => $showSolutions,
290 -label => "Solutions",
291 ), br(),
292 submit(-name=>"redisplay", -label=>"Redisplay Problem"), 351 submit(-name=>"redisplay", -label=>"Redisplay Problem"),
293 ); 352 );
294} 353}
295 354
296# ----- 355##### permission queries #####
297 356
298# this stuff should be abstracted out into the permissions system 357# this stuff should be abstracted out into the permissions system
299# however, the permission system only knows about things in the 358# however, the permission system only knows about things in the
300# course environment and the username. hmmm... 359# course environment and the username. hmmm...
301 360
361# also, i should fix these so that they have a consistent calling
362# format -- perhaps:
363# canPERM($courseEnv, $user, $set, $problem, $permissionLevel)
364
302sub canShowCorrectAnswers($$) { 365sub canShowCorrectAnswers($$) {
303 my ($permissionLevel, $answerDate) = @_; 366 my ($permissionLevel, $answerDate) = @_;
304 return $permissionLevel > 0 || time > $answerDate; 367 return $permissionLevel > 0 || time > $answerDate;
305} 368}
306 369
307sub canShowSolutions($$) { 370sub canShowSolutions($$) {
308 my ($permissionLevel, $answerDate) = @_; 371 my ($permissionLevel, $answerDate) = @_;
309 return canShowCorrectAnswers($permissionLevel, $answerDate); 372 return canShowCorrectAnswers($permissionLevel, $answerDate);
310} 373}
311 374
312sub canRecordAnswers($$$) { 375sub canRecordAnswers($$$$$) {
313 my ($permissionLevel, $openDate, $dueDate) = @_; 376 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
314 return $permissionLevel > 0 || (time >= $openDate && time <= $dueDate); 377 my $permHigh = $permissionLevel > 0;
378 my $timeOK = time >= $openDate && time <= $dueDate;
379 my $attemptsOK = $attempts <= $maxAttempts;
380 return $permHigh || ($timeOK && $attemptsOK);
315} 381}
316 382
317sub mustRecordAnswers($) { 383sub mustRecordAnswers($) {
318 my ($permissionLevel) = @_; 384 my ($permissionLevel) = @_;
319 return $permissionLevel == 0; 385 return $permissionLevel == 0;
Legend:
Removed from v.430  
changed lines
  Added in v.431
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9