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