[system] / trunk / webwork-modperl / lib / WeBWorK / ContentGenerator / Problem.pm Repository:
ViewVC logotype

Annotation of /trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : sh002i 449 ################################################################################
2 :     # WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester
3 :     # $Id$
4 :     ################################################################################
5 :    
6 : malsyned 353 package WeBWorK::ContentGenerator::Problem;
7 : malsyned 396
8 :     use strict;
9 :     use warnings;
10 : sh002i 449 use base qw(WeBWorK::ContentGenerator);
11 :     use CGI qw();
12 : sh002i 429 use WeBWorK::Utils qw(ref2string encodeAnswers decodeAnswers);
13 : sh002i 415 use WeBWorK::PG;
14 : sh002i 424 use WeBWorK::Form;
15 : malsyned 353
16 : sh002i 449 # TODO:
17 :     # :) enforce permissions for showCorrectAnswers and showSolutions
18 :     # (use $PRIV = $canPRIV && ($wantPRIV || $mustPRIV) -- cool syntax!)
19 :     # :) if answers were not submitted and there are student answers in the DB,
20 :     # decode them and put them into $formFields for the translator
21 :     # :) store submitted answers hash in database for sticky answers
22 :     # :) deal with the results of answer evaluation and grading :p
23 :     # :) introduce a recordAnswers option, which works on the same principle as
24 :     # the other permission-based options
25 :     # 7. make warnings work
26 :    
27 :     ############################################################
28 :     #
29 : sh002i 424 # user
30 :     # key
31 : sh002i 415 #
32 : sh002i 424 # displayMode
33 :     # showOldAnswers
34 :     # showCorrectAnswers
35 :     # showHints
36 :     # showSolutions
37 : sh002i 415 #
38 : sh002i 425 # AnSwEr# - answer blanks in problem
39 :     #
40 : sh002i 429 # redisplay - name of the "Redisplay Problem" button
41 :     # submitAnswers - name of "Submit Answers" button
42 : sh002i 449 #
43 :     ############################################################
44 : gage 392
45 : sh002i 449 sub initialize {
46 : sh002i 424 my ($self, $setName, $problemNumber) = @_;
47 :     my $courseEnv = $self->{courseEnvironment};
48 :     my $r = $self->{r};
49 :     my $userName = $r->param('user');
50 : malsyned 353
51 : sh002i 424 # fix format of setName and problem
52 :     $setName =~ s/^set//;
53 :     $problemNumber =~ s/^prob//;
54 : gage 388
55 : sh002i 429 ##### database setup #####
56 :    
57 : sh002i 449 my $cldb = WeBWorK::DB::Classlist->new($courseEnv);
58 :     my $wwdb = WeBWorK::DB::WW->new($courseEnv);
59 :     my $authdb = WeBWorK::DB::Auth->new($courseEnv);
60 : sh002i 429
61 : sh002i 449 my $user = $cldb->getUser($userName);
62 :     my $set = $wwdb->getSet($userName, $setName);
63 :     my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
64 : sh002i 429 my $permissionLevel = $authdb->getPermissions($userName);
65 : malsyned 396
66 : sh002i 429 ##### form processing #####
67 :    
68 : sh002i 425 # set options from form fields (see comment at top of file for names)
69 : sh002i 424 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
70 : sh002i 425 my $redisplay = $r->param("redisplay");
71 : sh002i 429 my $submitAnswers = $r->param("submitAnswers");
72 : gage 388
73 : sh002i 449 # coerce form fields into CGI::Vars format
74 :     my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
75 :    
76 :     ##### permissions #####
77 :    
78 :     # what does the user want to do?
79 : sh002i 431 my %want = (
80 :     showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
81 :     showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
82 :     showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
83 :     showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
84 :     recordAnswers => $r->param("recordAnswers") || 1,
85 :     );
86 : sh002i 429
87 : sh002i 431 # are certain options enforced?
88 :     my %must = (
89 :     showOldAnswers => 0,
90 :     showCorrectAnswers => 0,
91 :     showHints => 0,
92 :     showSolutions => 0,
93 :     recordAnswers => mustRecordAnswers($permissionLevel),
94 :     );
95 :    
96 : sh002i 429 # does the user have permission to use certain options?
97 : sh002i 431 my %can = (
98 :     showOldAnswers => 1,
99 :     showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),
100 :     showHints => 1,
101 :     showSolutions => canShowSolutions($permissionLevel, $set->answer_date),
102 :     recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
103 :     $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
104 :     # num_correct+num_incorrect+1 -- as this happens before updating $problem
105 :     );
106 : sh002i 429
107 :     # final values for options
108 : sh002i 431 my %will;
109 :     foreach(keys %must) {
110 :     $will{$_} = $can{$_} && ($want{$_} || $must{$_});
111 :     }
112 : sh002i 429
113 :     ##### sticky answers #####
114 :    
115 : sh002i 431 if (not $submitAnswers and $will{showOldAnswers}) {
116 :     # do this only if new answers are NOT being submitted
117 : sh002i 429 my %oldAnswers = decodeAnswers($problem->last_answer);
118 :     $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
119 :     }
120 :    
121 :     ##### translation #####
122 :    
123 : sh002i 424 my $pg = WeBWorK::PG->new(
124 :     $courseEnv,
125 :     $r->param('user'),
126 :     $r->param('key'),
127 :     $setName,
128 :     $problemNumber,
129 :     { # translation options
130 : sh002i 434 displayMode => $displayMode,
131 :     showHints => $will{showHints},
132 :     showSolutions => $will{showSolutions},
133 :     refreshMath2img => $will{showHints} || $will{showSolutions},
134 : sh002i 431 # try leaving processAnswers on all the time?
135 : sh002i 434 processAnswers => 1, #$submitAnswers ? 1 : 0,
136 : sh002i 424 },
137 :     $formFields
138 :     );
139 : gage 392
140 : sh002i 449 ##### store fields #####
141 :    
142 :     $self->{cldb} = $cldb;
143 :     $self->{wwdb} = $wwdb;
144 :     $self->{authdb} = $authdb;
145 :    
146 :     $self->{user} = $user;
147 :     $self->{set} = $set;
148 :     $self->{problem} = $problem;
149 :     $self->{permissionLevel} = $permissionLevel;
150 :    
151 :     $self->{displayMode} = $displayMode;
152 :     $self->{redisplay} = $redisplay;
153 :     $self->{submitAnswers} = $submitAnswers;
154 :     $self->{formFields} = $formFields;
155 :    
156 :     $self->{want} = \%want;
157 :     $self->{must} = \%must;
158 :     $self->{can} = \%can;
159 :     $self->{will} = \%will;
160 :    
161 :     $self->{pg} = $pg;
162 :     }
163 :    
164 :     sub title {
165 :     my $self = shift;
166 :     #return "Set " . $self->{set}->id . " problem " . $self->{problem}->id;
167 :     return "hold on a sec";
168 :     }
169 :    
170 :     sub body {
171 :     my $self = shift;
172 :    
173 :     #$self->prepare(@_);
174 :    
175 :     # unpack some useful variables
176 :     my $r = $self->{r};
177 :     my $wwdb = $self->{wwdb};
178 :     my $set = $self->{set};
179 :     my $problem = $self->{problem};
180 :     my $submitAnswers = $self->{submitAnswers};
181 :     my %will = %{ $self->{will} };
182 :     my $pg = $self->{pg};
183 :    
184 :     ##### translation errors? #####
185 :    
186 : sh002i 425 if ($pg->{flags}->{error_flag}) {
187 : sh002i 449 print translationError($pg->{errors}, $pg->{body_text});
188 : sh002i 425 return "";
189 :     }
190 : sh002i 415
191 : sh002i 429 ##### answer processing #####
192 :    
193 :     # if answers were submitted:
194 :     if ($submitAnswers) {
195 : sh002i 431 # store answers in DB for sticky answers
196 : sh002i 429 my %answersToStore;
197 :     my %answerHash = %{ $pg->{answers} };
198 :     $answersToStore{$_} = $answerHash{$_}->{original_student_ans}
199 :     foreach (keys %answerHash);
200 :     my $answerString = encodeAnswers(%answersToStore,
201 :     @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
202 :     $problem->last_answer($answerString);
203 :     $wwdb->setProblem($problem);
204 :    
205 : sh002i 449 # store state in DB if it makes sense
206 : sh002i 431 if ($will{recordAnswers}) {
207 :     $problem->attempted(1);
208 :     $problem->status($pg->{state}->{recorded_score});
209 :     $problem->num_correct($pg->{state}->{num_of_correct_ans});
210 :     $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
211 :     #warn "Would have stored the following:\n",
212 :     # $problem->toString, "\n";
213 :     $wwdb->setProblem($problem);
214 :     }
215 : sh002i 425 }
216 :    
217 : sh002i 429 ##### output #####
218 : sh002i 425
219 : sh002i 431 # attempt summary
220 :     if ($submitAnswers or $will{showCorrectAnswers}) {
221 :     # print this if user submitted answers OR requested correct answers
222 :     print attemptResults($pg, $submitAnswers, $will{showCorrectAnswers},
223 :     $pg->{flags}->{showPartialCorrectAnswers});
224 :     }
225 : gage 392
226 : sh002i 431 # score summary
227 :     my $attempts = $problem->num_correct + $problem->num_incorrect;
228 :     my $attemptsNoun = $attempts != 1 ? "times" : "time";
229 :     my $lastScore = int ($problem->status * 100) . "%";
230 :     my ($attemptsLeft, $attemptsLeftNoun);
231 :     if ($problem->max_attempts == -1) {
232 :     # unlimited attempts
233 :     $attemptsLeft = "unlimited";
234 :     $attemptsLeftNoun = "attempts";
235 :     } else {
236 :     $attemptsLeft = $problem->max_attempts - $attempts;
237 :     $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
238 :     }
239 : sh002i 449 print CGI::p(
240 :     "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
241 : sh002i 431 $problem->attempted
242 : sh002i 449 ? "Your recorded score is $lastScore." . CGI::br()
243 : sh002i 431 : "",
244 :     "You have $attemptsLeft $attemptsLeftNoun remaining."
245 :     );
246 :    
247 :     # BY THE WAY..........
248 :     # we have to figure out some way to tell the student if their NEW answer,
249 :     # on THIS attempt, has been recorded. however, this is decided in part by
250 :     # the grader, so is there any way for us to know? we can rule out several
251 :     # cases where the answer is NOT being recorded, because of things decided
252 :     # in &canRecordAnswers...
253 :    
254 : sh002i 449 print CGI::hr();
255 : sh002i 431
256 : sh002i 429 # main form
257 :     print
258 : sh002i 449 CGI::startform("POST", $r->uri),
259 : sh002i 429 $self->hidden_authen_fields,
260 : sh002i 449 CGI::p(CGI::i($pg->{result}->{msg})),
261 :     CGI::p($pg->{body_text}),
262 :     CGI::p(CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers")),
263 :     $self->viewOptions,
264 :     CGI::endform();
265 : sh002i 429
266 : sh002i 424 # debugging stuff
267 : sh002i 435 #print
268 :     # hr(),
269 :     # h2("debugging information"),
270 :     # h3("form fields"),
271 :     # ref2string($formFields),
272 :     # h3("user object"),
273 :     # ref2string($user),
274 :     # h3("set object"),
275 :     # ref2string($set),
276 :     # h3("problem object"),
277 :     # ref2string($problem),
278 :     # h3("PG object"),
279 :     # ref2string($pg, {'WeBWorK::PG::Translator' => 1});
280 : gage 392
281 : sh002i 424 return "";
282 : malsyned 353 }
283 :    
284 : sh002i 431 ##### output utilities #####
285 : sh002i 429
286 :     sub translationError($$) {
287 :     my ($error, $details) = @_;
288 :     return
289 : sh002i 449 CGI::h2("Software Error"),
290 :     CGI::p(<<EOF),
291 : sh002i 429 WeBWorK has encountered a software error while attempting to process this problem.
292 :     It is likely that there is an error in the problem itself.
293 :     If you are a student, contact your professor to have the error corrected.
294 :     If you are a professor, please consut the error output below for more informaiton.
295 :     EOF
296 : sh002i 449 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)),
297 :     CGI::h3("Error context"), CGI::blockquote(CGI::pre($details));
298 : sh002i 429 }
299 :    
300 :     sub attemptResults($$$) {
301 : sh002i 425 my $pg = shift;
302 : sh002i 431 my $showAttemptAnswers = shift;
303 : sh002i 425 my $showCorrectAnswers = shift;
304 : sh002i 431 my $showAttemptResults = $showAttemptAnswers && shift;
305 : sh002i 425 my $problemResult = $pg->{result}; # the overall result of the problem
306 :     my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
307 :    
308 : sh002i 449 my $header = CGI::th("answer");
309 :     $header .= $showAttemptAnswers ? CGI::th("attempt") : "";
310 :     $header .= $showCorrectAnswers ? CGI::th("correct") : "";
311 :     $header .= $showAttemptResults ? CGI::th("result") : "";
312 :     $header .= $showAttemptAnswers ? CGI::th("messages") : "";
313 : sh002i 425 my @tableRows = ( $header );
314 :     my $numCorrect;
315 :     foreach my $name (@answerNames) {
316 :     my $answerResult = $pg->{answers}->{$name};
317 : sh002i 429 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
318 : sh002i 425 my $correctAnswer = $answerResult->{correct_ans};
319 :     my $answerScore = $answerResult->{score};
320 : sh002i 431 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : "";
321 : sh002i 425
322 :     $numCorrect += $answerScore > 0;
323 :     my $resultString = $answerScore ? "correct :^)" : "incorrect >:(";
324 :    
325 : sh002i 449 my $row = CGI::td($name);
326 :     $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
327 :     $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
328 :     $row .= $showAttemptResults ? CGI::td($resultString) : "";
329 :     $row .= $answerMessage ? CGI::td($answerMessage) : "";
330 : sh002i 425 push @tableRows, $row;
331 :     }
332 :    
333 : sh002i 431 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions";
334 : sh002i 425 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
335 : sh002i 431 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of "
336 : sh002i 425 . scalar @answerNames . " correct, for a score of $scorePercent.";
337 : sh002i 449 return CGI::table({-border=>1}, CGI::tr(\@tableRows)) . CGI::p($summary);
338 : sh002i 425 }
339 :    
340 : sh002i 449 sub viewOptions($) {
341 :     my $self = shift;
342 :     my $displayMode = $self->{displayMode};
343 :     my %must = %{ $self->{must} };
344 :     my %can = %{ $self->{can} };
345 :     my %will = %{ $self->{will} };
346 : sh002i 431
347 :     my $optionLine;
348 :     $can{showOldAnswers} and $optionLine .= join "",
349 : sh002i 429 "Show: &nbsp;",
350 : sh002i 449 CGI::checkbox(
351 : sh002i 429 -name => "showOldAnswers",
352 : sh002i 431 -checked => $will{showOldAnswers},
353 :     -label => "Saved answers",
354 :     ), "&nbsp;&nbsp;";
355 :     $can{showCorrectAnswers} and $optionLine .= join "",
356 : sh002i 449 CGI::checkbox(
357 : sh002i 429 -name => "showCorrectAnswers",
358 : sh002i 431 -checked => $will{showCorrectAnswers},
359 : sh002i 429 -label => "Correct answers",
360 : sh002i 431 ), "&nbsp;&nbsp;";
361 :     $can{showHints} and $optionLine .= join "",
362 : sh002i 449 CGI::checkbox(
363 : sh002i 429 -name => "showHints",
364 : sh002i 431 -checked => $will{showHints},
365 : sh002i 429 -label => "Hints",
366 : sh002i 431 ), "&nbsp;&nbsp;";
367 :     $can{showSolutions} and $optionLine .= join "",
368 : sh002i 449 CGI::checkbox(
369 : sh002i 429 -name => "showSolutions",
370 : sh002i 431 -checked => $will{showSolutions},
371 : sh002i 429 -label => "Solutions",
372 : sh002i 431 ), "&nbsp;&nbsp;";
373 : sh002i 449 $optionLine and $optionLine .= join "", CGI::br();
374 : sh002i 431
375 : sh002i 449 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
376 : sh002i 431 "View equations as: &nbsp;",
377 : sh002i 449 CGI::radio_group(
378 : sh002i 431 -name => "displayMode",
379 :     -values => ['plainText', 'formattedText', 'images'],
380 :     -default => $displayMode,
381 :     -labels => {
382 :     plainText => "plain text",
383 :     formattedText => "formatted text",
384 :     images => "images",
385 :     }
386 : sh002i 449 ), CGI::br(),
387 : sh002i 431 $optionLine,
388 : sh002i 449 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
389 : sh002i 429 );
390 :     }
391 :    
392 : sh002i 431 ##### permission queries #####
393 : sh002i 429
394 :     # this stuff should be abstracted out into the permissions system
395 :     # however, the permission system only knows about things in the
396 :     # course environment and the username. hmmm...
397 :    
398 : sh002i 431 # also, i should fix these so that they have a consistent calling
399 :     # format -- perhaps:
400 :     # canPERM($courseEnv, $user, $set, $problem, $permissionLevel)
401 :    
402 : sh002i 429 sub canShowCorrectAnswers($$) {
403 :     my ($permissionLevel, $answerDate) = @_;
404 :     return $permissionLevel > 0 || time > $answerDate;
405 :     }
406 :    
407 :     sub canShowSolutions($$) {
408 :     my ($permissionLevel, $answerDate) = @_;
409 :     return canShowCorrectAnswers($permissionLevel, $answerDate);
410 :     }
411 :    
412 : sh002i 431 sub canRecordAnswers($$$$$) {
413 :     my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
414 :     my $permHigh = $permissionLevel > 0;
415 :     my $timeOK = time >= $openDate && time <= $dueDate;
416 :     my $attemptsOK = $attempts <= $maxAttempts;
417 :     return $permHigh || ($timeOK && $attemptsOK);
418 : sh002i 429 }
419 :    
420 :     sub mustRecordAnswers($) {
421 :     my ($permissionLevel) = @_;
422 :     return $permissionLevel == 0;
423 :     }
424 :    
425 : sh002i 415 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9