[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 448 Revision 449
1################################################################################
2# WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester
3# $Id$
4################################################################################
5
1package WeBWorK::ContentGenerator::Problem; 6package WeBWorK::ContentGenerator::Problem;
2use base qw(WeBWorK::ContentGenerator);
3 7
4use strict; 8use strict;
5use warnings; 9use warnings;
6use CGI qw(:html :form); 10use base qw(WeBWorK::ContentGenerator);
11use CGI qw();
7use WeBWorK::Utils qw(ref2string encodeAnswers decodeAnswers); 12use WeBWorK::Utils qw(ref2string encodeAnswers decodeAnswers);
8use WeBWorK::PG; 13use WeBWorK::PG;
9use WeBWorK::Form; 14use WeBWorK::Form;
10 15
16# 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#
11# user 29# user
12# key 30# key
13# 31#
14# displayMode 32# displayMode
15# showOldAnswers 33# showOldAnswers
… …
19# 37#
20# AnSwEr# - answer blanks in problem 38# AnSwEr# - answer blanks in problem
21# 39#
22# redisplay - name of the "Redisplay Problem" button 40# redisplay - name of the "Redisplay Problem" button
23# submitAnswers - name of "Submit Answers" button 41# submitAnswers - name of "Submit Answers" button
42#
43############################################################
24 44
25sub title { 45sub initialize {
26 my ($self, $setName, $problemNumber) = @_;
27 my $userName = $self->{r}->param('user');
28 return "Problem $problemNumber of problem set $setName for $userName";
29}
30
31# TODO:
32# :) enforce permissions for showCorrectAnswers and showSolutions
33# (use $PRIV = $mustPRIV || ($canPRIV && $wantPRIV) -- cool syntax!)
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
36# :) store submitted answers hash in database for sticky answers
37# :) deal with the results of answer evaluation and grading :p
38# :) introduce a recordAnswers option, which works on the same principle as
39# the other permission-based options
40# 7. make warnings work
41
42sub body {
43 my ($self, $setName, $problemNumber) = @_; 46 my ($self, $setName, $problemNumber) = @_;
44 my $courseEnv = $self->{courseEnvironment}; 47 my $courseEnv = $self->{courseEnvironment};
45 my $r = $self->{r}; 48 my $r = $self->{r};
46 my $userName = $r->param('user'); 49 my $userName = $r->param('user');
47 50
48 # fix format of setName and problem 51 # fix format of setName and problem
49 $setName =~ s/^set//; 52 $setName =~ s/^set//;
50 $problemNumber =~ s/^prob//; 53 $problemNumber =~ s/^prob//;
51 54
52 ##### database setup ##### 55 ##### database setup #####
53 # this should probably go in initialize() or whatever it's called
54 56
55 my $classlist = WeBWorK::DB::Classlist->new($courseEnv); 57 my $cldb = WeBWorK::DB::Classlist->new($courseEnv);
56 my $wwdb = WeBWorK::DB::WW->new($courseEnv); 58 my $wwdb = WeBWorK::DB::WW->new($courseEnv);
57 my $authdb = WeBWorK::DB::Auth->new($courseEnv); 59 my $authdb = WeBWorK::DB::Auth->new($courseEnv);
58 60
59 my $user = $classlist->getUser($userName); 61 my $user = $cldb->getUser($userName);
60 my $set = $wwdb->getSet($userName, $setName); 62 my $set = $wwdb->getSet($userName, $setName);
61 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 63 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
62 my $permissionLevel = $authdb->getPermissions($userName); 64 my $permissionLevel = $authdb->getPermissions($userName);
63 65
64 ##### form processing ##### 66 ##### form processing #####
65 67
66 # set options from form fields (see comment at top of file for names) 68 # set options from form fields (see comment at top of file for names)
67 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 69 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
68 my $redisplay = $r->param("redisplay"); 70 my $redisplay = $r->param("redisplay");
69 my $submitAnswers = $r->param("submitAnswers"); 71 my $submitAnswers = $r->param("submitAnswers");
70 72
73 # 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?
71 my %want = ( 79 my %want = (
72 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, 80 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
73 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, 81 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
74 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, 82 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
75 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, 83 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
76 recordAnswers => $r->param("recordAnswers") || 1, 84 recordAnswers => $r->param("recordAnswers") || 1,
77 ); 85 );
78
79 # coerce form fields into CGI::Vars format
80 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
81
82 ##### permissions #####
83 86
84 # are certain options enforced? 87 # are certain options enforced?
85 my %must = ( 88 my %must = (
86 showOldAnswers => 0, 89 showOldAnswers => 0,
87 showCorrectAnswers => 0, 90 showCorrectAnswers => 0,
… …
132 processAnswers => 1, #$submitAnswers ? 1 : 0, 135 processAnswers => 1, #$submitAnswers ? 1 : 0,
133 }, 136 },
134 $formFields 137 $formFields
135 ); 138 );
136 139
137 # handle any errors in translation 140 ##### 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
164sub title {
165 my $self = shift;
166 #return "Set " . $self->{set}->id . " problem " . $self->{problem}->id;
167 return "hold on a sec";
168}
169
170sub 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
138 if ($pg->{flags}->{error_flag}) { 186 if ($pg->{flags}->{error_flag}) {
139 # there was an error in translation
140 print
141 h2("Software Error"),
142 translationError($pg->{errors}, $pg->{body_text}); 187 print translationError($pg->{errors}, $pg->{body_text});
143
144 return ""; 188 return "";
145 } 189 }
146 190
147 ##### answer processing ##### 191 ##### answer processing #####
148 192
… …
156 my $answerString = encodeAnswers(%answersToStore, 200 my $answerString = encodeAnswers(%answersToStore,
157 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); 201 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
158 $problem->last_answer($answerString); 202 $problem->last_answer($answerString);
159 $wwdb->setProblem($problem); 203 $wwdb->setProblem($problem);
160 204
161 # store score in DB if it makes sense 205 # store state in DB if it makes sense
162 if ($will{recordAnswers}) { 206 if ($will{recordAnswers}) {
163 # the grader makes a lot of decisions for us...
164 # all we have to do is update information from
165 # the 'state' hash in the $pg hash.
166 $problem->attempted(1); 207 $problem->attempted(1);
167 $problem->status($pg->{state}->{recorded_score}); 208 $problem->status($pg->{state}->{recorded_score});
168 $problem->num_correct($pg->{state}->{num_of_correct_ans}); 209 $problem->num_correct($pg->{state}->{num_of_correct_ans});
169 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 210 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
170 #warn "Would have stored the following:\n", 211 #warn "Would have stored the following:\n",
171 # $problem->toString, "\n"; 212 # $problem->toString, "\n";
172 $wwdb->setProblem($problem); 213 $wwdb->setProblem($problem);
173 } else {
174 print p("Your score was not recorded for some reason. ;)");
175 } 214 }
176 } 215 }
177 216
178 ##### output ##### 217 ##### output #####
179 218
… …
195 $attemptsLeftNoun = "attempts"; 234 $attemptsLeftNoun = "attempts";
196 } else { 235 } else {
197 $attemptsLeft = $problem->max_attempts - $attempts; 236 $attemptsLeft = $problem->max_attempts - $attempts;
198 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 237 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
199 } 238 }
200 print p( 239 print CGI::p(
201 "You have attempted this problem $attempts $attemptsNoun.", br(), 240 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
202 $problem->attempted 241 $problem->attempted
203 ? "Your recorded score is $lastScore." . br() 242 ? "Your recorded score is $lastScore." . CGI::br()
204 : "", 243 : "",
205 "You have $attemptsLeft $attemptsLeftNoun remaining." 244 "You have $attemptsLeft $attemptsLeftNoun remaining."
206 ); 245 );
207 246
208 # BY THE WAY.......... 247 # BY THE WAY..........
… …
210 # on THIS attempt, has been recorded. however, this is decided in part by 249 # on THIS attempt, has been recorded. however, this is decided in part by
211 # the grader, so is there any way for us to know? we can rule out several 250 # the grader, so is there any way for us to know? we can rule out several
212 # cases where the answer is NOT being recorded, because of things decided 251 # cases where the answer is NOT being recorded, because of things decided
213 # in &canRecordAnswers... 252 # in &canRecordAnswers...
214 253
215 print hr(); 254 print CGI::hr();
216 255
217 # main form 256 # main form
218 print 257 print
219 startform("POST", $r->uri), 258 CGI::startform("POST", $r->uri),
220 $self->hidden_authen_fields, 259 $self->hidden_authen_fields,
221 p(i($pg->{result}->{msg})), 260 CGI::p(CGI::i($pg->{result}->{msg})),
222 p($pg->{body_text}), 261 CGI::p($pg->{body_text}),
223 p(submit(-name=>"submitAnswers", -label=>"Submit Answers")), 262 CGI::p(CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers")),
224 viewOptions($displayMode, \%must, \%can, \%will), 263 $self->viewOptions,
225 endform(); 264 CGI::endform();
226 265
227 # debugging stuff 266 # debugging stuff
228 #print 267 #print
229 # hr(), 268 # hr(),
230 # h2("debugging information"), 269 # h2("debugging information"),
… …
245##### output utilities ##### 284##### output utilities #####
246 285
247sub translationError($$) { 286sub translationError($$) {
248 my ($error, $details) = @_; 287 my ($error, $details) = @_;
249 return 288 return
289 CGI::h2("Software Error"),
250 p(<<EOF), 290 CGI::p(<<EOF),
251WeBWorK has encountered a software error while attempting to process this problem. 291WeBWorK has encountered a software error while attempting to process this problem.
252It is likely that there is an error in the problem itself. 292It is likely that there is an error in the problem itself.
253If you are a student, contact your professor to have the error corrected. 293If you are a student, contact your professor to have the error corrected.
254If you are a professor, please consut the error output below for more informaiton. 294If you are a professor, please consut the error output below for more informaiton.
255EOF 295EOF
256 h3("Error messages"), blockquote(pre($error)), 296 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)),
257 h3("Error context"), blockquote(pre($details)); 297 CGI::h3("Error context"), CGI::blockquote(CGI::pre($details));
258} 298}
259 299
260sub attemptResults($$$) { 300sub attemptResults($$$) {
261 my $pg = shift; 301 my $pg = shift;
262 my $showAttemptAnswers = shift; 302 my $showAttemptAnswers = shift;
263 my $showCorrectAnswers = shift; 303 my $showCorrectAnswers = shift;
264 my $showAttemptResults = $showAttemptAnswers && shift; 304 my $showAttemptResults = $showAttemptAnswers && shift;
265 my $problemResult = $pg->{result}; # the overall result of the problem 305 my $problemResult = $pg->{result}; # the overall result of the problem
266 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 306 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
267 307
268 my $header = th("answer"); 308 my $header = CGI::th("answer");
269 $header .= $showAttemptAnswers ? th("attempt") : ""; 309 $header .= $showAttemptAnswers ? CGI::th("attempt") : "";
270 $header .= $showCorrectAnswers ? th("correct") : ""; 310 $header .= $showCorrectAnswers ? CGI::th("correct") : "";
271 $header .= $showAttemptResults ? th("result") : ""; 311 $header .= $showAttemptResults ? CGI::th("result") : "";
272 $header .= $showAttemptAnswers ? th("messages") : ""; 312 $header .= $showAttemptAnswers ? CGI::th("messages") : "";
273 my @tableRows = ( $header ); 313 my @tableRows = ( $header );
274 my $numCorrect; 314 my $numCorrect;
275 foreach my $name (@answerNames) { 315 foreach my $name (@answerNames) {
276 my $answerResult = $pg->{answers}->{$name}; 316 my $answerResult = $pg->{answers}->{$name};
277 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 317 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
… …
280 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; 320 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : "";
281 321
282 $numCorrect += $answerScore > 0; 322 $numCorrect += $answerScore > 0;
283 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 323 my $resultString = $answerScore ? "correct :^)" : "incorrect >:(";
284 324
285 my $row = td($name); 325 my $row = CGI::td($name);
286 $row .= $showAttemptAnswers ? td($studentAnswer) : ""; 326 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
287 $row .= $showCorrectAnswers ? td($correctAnswer) : ""; 327 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
288 $row .= $showAttemptResults ? td($resultString) : ""; 328 $row .= $showAttemptResults ? CGI::td($resultString) : "";
289 $row .= $answerMessage ? td($answerMessage) : ""; 329 $row .= $answerMessage ? CGI::td($answerMessage) : "";
290 push @tableRows, $row; 330 push @tableRows, $row;
291 } 331 }
292 332
293 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions"; 333 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions";
294 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 334 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
295 #my $message = i($problemResult->{msg});
296 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of " 335 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of "
297 . scalar @answerNames . " correct, for a score of $scorePercent."; 336 . scalar @answerNames . " correct, for a score of $scorePercent.";
298 #return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary);
299 return table({-border=>1}, Tr(\@tableRows)) . p($summary); 337 return CGI::table({-border=>1}, CGI::tr(\@tableRows)) . CGI::p($summary);
300} 338}
301 339
302sub viewOptions($\%\%\%) { 340sub viewOptions($) {
303 my $displayMode = shift; 341 my $self = shift;
342 my $displayMode = $self->{displayMode};
304 my %must = %{ shift() }; 343 my %must = %{ $self->{must} };
305 my %can = %{ shift() }; 344 my %can = %{ $self->{can} };
306 my %will = %{ shift() }; 345 my %will = %{ $self->{will} };
307 346
308 my $optionLine; 347 my $optionLine;
309 $can{showOldAnswers} and $optionLine .= join "", 348 $can{showOldAnswers} and $optionLine .= join "",
310 "Show: &nbsp;", 349 "Show: &nbsp;",
311 checkbox( 350 CGI::checkbox(
312 -name => "showOldAnswers", 351 -name => "showOldAnswers",
313 -checked => $will{showOldAnswers}, 352 -checked => $will{showOldAnswers},
314 -label => "Saved answers", 353 -label => "Saved answers",
315 ), "&nbsp;&nbsp;"; 354 ), "&nbsp;&nbsp;";
316 $can{showCorrectAnswers} and $optionLine .= join "", 355 $can{showCorrectAnswers} and $optionLine .= join "",
317 checkbox( 356 CGI::checkbox(
318 -name => "showCorrectAnswers", 357 -name => "showCorrectAnswers",
319 -checked => $will{showCorrectAnswers}, 358 -checked => $will{showCorrectAnswers},
320 -label => "Correct answers", 359 -label => "Correct answers",
321 ), "&nbsp;&nbsp;"; 360 ), "&nbsp;&nbsp;";
322 $can{showHints} and $optionLine .= join "", 361 $can{showHints} and $optionLine .= join "",
323 checkbox( 362 CGI::checkbox(
324 -name => "showHints", 363 -name => "showHints",
325 -checked => $will{showHints}, 364 -checked => $will{showHints},
326 -label => "Hints", 365 -label => "Hints",
327 ), "&nbsp;&nbsp;"; 366 ), "&nbsp;&nbsp;";
328 $can{showSolutions} and $optionLine .= join "", 367 $can{showSolutions} and $optionLine .= join "",
329 checkbox( 368 CGI::checkbox(
330 -name => "showSolutions", 369 -name => "showSolutions",
331 -checked => $will{showSolutions}, 370 -checked => $will{showSolutions},
332 -label => "Solutions", 371 -label => "Solutions",
333 ), "&nbsp;&nbsp;"; 372 ), "&nbsp;&nbsp;";
334 $optionLine and $optionLine .= join "", br(); 373 $optionLine and $optionLine .= join "", CGI::br();
335 374
336 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, 375 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
337 "View equations as: &nbsp;", 376 "View equations as: &nbsp;",
338 radio_group( 377 CGI::radio_group(
339 -name => "displayMode", 378 -name => "displayMode",
340 -values => ['plainText', 'formattedText', 'images'], 379 -values => ['plainText', 'formattedText', 'images'],
341 -default => $displayMode, 380 -default => $displayMode,
342 -labels => { 381 -labels => {
343 plainText => "plain text", 382 plainText => "plain text",
344 formattedText => "formatted text", 383 formattedText => "formatted text",
345 images => "images", 384 images => "images",
346 } 385 }
347 ), br(), 386 ), CGI::br(),
348 $optionLine, 387 $optionLine,
349 submit(-name=>"redisplay", -label=>"Redisplay Problem"), 388 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
350 ); 389 );
351} 390}
352 391
353##### permission queries ##### 392##### permission queries #####
354 393
Legend:
Removed from v.448  
changed lines
  Added in v.449
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9