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

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

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

Revision 429 Revision 755
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);
7use WeBWorK::Utils qw(ref2string encodeAnswers decodeAnswers); 17use CGI qw();
18use File::Temp qw(tempdir);
19use WeBWorK::Form;
8use WeBWorK::PG; 20use WeBWorK::PG;
9use WeBWorK::Form; 21use WeBWorK::PG::IO;
22use WeBWorK::Utils qw(writeLog encodeAnswers decodeAnswers ref2string);
10 23
24############################################################
25#
11# user 26# user
27# effectiveUser
12# key 28# key
13# 29#
14# displayMode 30# displayMode
15# showOldAnswers 31# showOldAnswers
16# showCorrectAnswers 32# showCorrectAnswers
… …
19# 35#
20# AnSwEr# - answer blanks in problem 36# AnSwEr# - answer blanks in problem
21# 37#
22# redisplay - name of the "Redisplay Problem" button 38# redisplay - name of the "Redisplay Problem" button
23# submitAnswers - name of "Submit Answers" button 39# submitAnswers - name of "Submit Answers" button
40#
41############################################################
24 42
25sub title { 43sub 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) = @_; 44 my ($self, $setName, $problemNumber) = @_;
45 my $courseEnv = $self->{courseEnvironment}; 45 my $courseEnv = $self->{courseEnvironment};
46 my $r = $self->{r}; 46 my $r = $self->{r};
47 my $userName = $r->param('user'); 47 my $userName = $r->param('user');
48 48 my $effectiveUserName = $r->param('effectiveUser');
49 # fix format of setName and problem
50 $setName =~ s/^set//;
51 $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);
57 my $effectiveUser = $cldb->getUser($effectiveUserName);
60 my $set = $wwdb->getSet($userName, $setName); 58 my $set = $wwdb->getSet($effectiveUserName, $setName);
61 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 59 my $problem = $wwdb->getProblem($effectiveUserName, $setName, $problemNumber);
62 my $psvn = $wwdb->getPSVN($userName, $setName); 60 my $psvn = $wwdb->getPSVN($effectiveUserName, $setName);
63 my $permissionLevel = $authdb->getPermissions($userName); 61 my $permissionLevel = $authdb->getPermissions($userName);
64 62
63 $self->{cldb} = $cldb;
64 $self->{wwdb} = $wwdb;
65 $self->{authdb} = $authdb;
66
67 $self->{userName} = $userName;
68 $self->{user} = $user;
69 $self->{effectiveUser} = $effectiveUser;
70 $self->{set} = $set;
71 $self->{problem} = $problem;
72 $self->{permissionLevel} = $permissionLevel;
73
65 ##### form processing ##### 74 ##### form processing #####
66 75
67 # set options from form fields (see comment at top of file for names) 76 # set options from form fields (see comment at top of file for names)
68 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 77 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
69 my $redisplay = $r->param("redisplay"); 78 my $redisplay = $r->param("redisplay");
70 my $submitAnswers = $r->param("submitAnswers"); 79 my $submitAnswers = $r->param("submitAnswers");
71
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; 80 my $checkAnswers = $r->param("checkAnswers");
81 my $previewAnswers = $r->param("previewAnswers");
77 82
78 # coerce form fields into CGI::Vars format 83 # coerce form fields into CGI::Vars format
79 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 84 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
80 85
86 $self->{displayMode} = $displayMode;
87 $self->{redisplay} = $redisplay;
88 $self->{submitAnswers} = $submitAnswers;
89 $self->{checkAnswers} = $checkAnswers;
90 $self->{previewAnswers} = $previewAnswers;
91 $self->{formFields} = $formFields;
92
81 ##### permissions ##### 93 ##### permissions #####
82 94
95 # are we allowed to view this problem?
96 $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0;
97 return unless $self->{isOpen};
98
99 # what does the user want to do?
100 my %want = (
101 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
102 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
103 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
104 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
105 recordAnswers => $submitAnswers,
106 checkAnswers => $checkAnswers,
107 );
108
109 # are certain options enforced?
110 my %must = (
111 showOldAnswers => 0,
112 showCorrectAnswers => 0,
113 showHints => 0,
114 showSolutions => 0,
115 recordAnswers => mustRecordAnswers($permissionLevel),
116 checkAnswers => 0,
117 );
118
83 # does the user have permission to use certain options? 119 # does the user have permission to use certain options?
120 my %can = (
84 my $canShowOldAnswers = 1; 121 showOldAnswers => 1,
85 my $canShowCorrectAnswers = canShowCorrectAnswers($permissionLevel, $set->answer_date); 122 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),
86 my $canShowHints = 1; 123 showHints => 1,
87 my $canShowSolutions = canShowSolutions($permissionLevel, $set->answer_date); 124 showSolutions => canShowSolutions($permissionLevel, $set->answer_date),
125 # attempts=num_correct+num_incorrect+1, as this happens before updating $problem
88 my $canRecordAnswers = canRecordAnswers($permissionLevel, $set->open_date, $set->due_date); 126 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
89 127 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
90 # are certain options enforced? 128 checkAnswers => canCheckAnswers($permissionLevel, $set->open_date,
91 my $mustShowOldAnswers = 0; 129 $set->due_date, $set->answer_date, $problem->max_attempts,
92 my $mustShowCorrectAnswers = 0; 130 $problem->num_correct + $problem->num_incorrect + 1),
93 my $mustShowHints = 0; 131 );
94 my $mustShowSolutions = 0;
95 my $mustRecordAnswers = mustRecordAnswers($permissionLevel);
96 132
97 # final values for options 133 # final values for options
98 my $showOldAnswers = $mustShowOldAnswers || ($canShowOldAnswers && $wantShowOldAnswers ); 134 my %will;
99 my $showCorrectAnswers = $mustShowCorrectAnswers || ($canShowCorrectAnswers && $wantShowCorrectAnswers); 135 foreach (keys %must) {
100 my $showHints = $mustShowHints || ($canShowHints && $wantShowHints ); 136 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
101 my $showSolutions = $mustShowSolutions || ($canShowSolutions && $wantShowSolutions ); 137 }
102 my $recordAnswers = $mustRecordAnswers || ($canRecordAnswers && $wantRecordAnswers );
103 138
104 ##### sticky answers ##### 139 ##### sticky answers #####
105 140
106 # [TODO #2]
107
108 if (not $submitAnswers and $showOldAnswers) { 141 if (not $submitAnswers and $will{showOldAnswers}) {
109 # only do this if new answers are NOT being submitted 142 # do this only if new answers are NOT being submitted
110 my %oldAnswers = decodeAnswers($problem->last_answer); 143 my %oldAnswers = decodeAnswers($problem->last_answer);
111 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; 144 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
112 } 145 }
113 146
114 ##### translation ##### 147 ##### translation #####
115 148
116 my $pg = WeBWorK::PG->new( 149 my $pg = WeBWorK::PG->new(
117 $courseEnv, 150 $courseEnv,
118 $r->param('user'), 151 $effectiveUser,
119 $r->param('key'), 152 $r->param('key'),
120 $setName, 153 $set,
121 $problemNumber, 154 $problem,
155 $psvn,
156 $formFields,
122 { # translation options 157 { # translation options
123 displayMode => $displayMode, 158 displayMode => $displayMode,
124 showHints => $showHints, 159 showHints => $will{showHints},
125 showSolutions => $showSolutions, 160 showSolutions => $will{showSolutions},
126 # try leaving processAnswers on all the time: 161 refreshMath2img => $will{showHints} || $will{showSolutions},
127 processAnswers => 1, #$submitAnswers ? 1 : 0, 162 processAnswers => 1,
128 }, 163 },
129 $formFields
130 ); 164 );
131 165
132 # handle any errors in translation 166 ##### fix hint/solution options #####
167
168 $can{showHints} &&= $pg->{flags}->{hintExists};
169 $can{showSolutions} &&= $pg->{flags}->{solutionExists};
170
171 ##### store fields #####
172
173 $self->{want} = \%want;
174 $self->{must} = \%must;
175 $self->{can} = \%can;
176 $self->{will} = \%will;
177
178 $self->{pg} = $pg;
179}
180
181sub if_warnings($$) {
182 my ($self, $arg) = @_;
183 return 0 unless $self->{isOpen};
184 return $self->{pg}->{warnings} ne "";
185}
186
187sub if_errors($$) {
188 my ($self, $arg) = @_;
189 return 0 unless $self->{isOpen};
190 return $self->{pg}->{flags}->{error_flag};
191}
192
193sub head {
194 my $self = shift;
195 return "" unless $self->{isOpen};
196 return $self->{pg}->{head_text} if $self->{pg}->{head_text};
197}
198
199sub path {
200 my $self = shift;
201 my $args = $_[-1];
202 my $setName = $self->{set}->id;
203 my $problemNumber = $self->{problem}->id;
204
205 my $ce = $self->{courseEnvironment};
206 my $root = $ce->{webworkURLs}->{root};
207 my $courseName = $ce->{courseName};
208 return $self->pathMacro($args,
209 "Home" => "$root",
210 $courseName => "$root/$courseName",
211 $setName => "$root/$courseName/$setName",
212 "Problem $problemNumber" => "",
213 );
214}
215
216sub siblings {
217 my $self = shift;
218 my $setName = $self->{set}->id;
219 my $problemNumber = $self->{problem}->id;
220
221 my $ce = $self->{courseEnvironment};
222 my $root = $ce->{webworkURLs}->{root};
223 my $courseName = $ce->{courseName};
224
225 print CGI::strong("Problems"), CGI::br();
226
227 my $wwdb = $self->{wwdb};
228 my $effectiveUser = $self->{r}->param("effectiveUser");
229 my @problems;
230 push @problems, $wwdb->getProblem($effectiveUser, $setName, $_)
231 foreach ($wwdb->getProblems($effectiveUser, $setName));
232 foreach my $problem (sort { $a->id <=> $b->id } @problems) {
233 print CGI::a({-href=>"$root/$courseName/$setName/".$problem->id."/?"
234 . $self->url_authen_args . "&displayMode=" . $self->{displayMode}},
235 "Problem ".$problem->id), CGI::br();
236 }
237}
238
239sub nav {
240 my $self = shift;
241 my $args = $_[-1];
242 my $setName = $self->{set}->id;
243 my $problemNumber = $self->{problem}->id;
244
245 my $ce = $self->{courseEnvironment};
246 my $root = $ce->{webworkURLs}->{root};
247 my $courseName = $ce->{courseName};
248
249 my $wwdb = $self->{wwdb};
250 my $effectiveUser = $self->{r}->param("effectiveUser");
251 my $tail = "&displayMode=".$self->{displayMode};
252
253 my @links = ("Problem List" , "$root/$courseName/$setName", "ProbList");
254
255 my $prevProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber-1);
256 my $nextProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber+1);
257 unshift @links, "Previous Problem" , ($prevProblem
258 ? "$root/$courseName/$setName/".$prevProblem->id
259 : "") , "Prev";
260 push @links, "Next Problem" , ($nextProblem
261 ? "$root/$courseName/$setName/".$nextProblem->id
262 : "") , "Next";
263
264 return $self->navMacro($args, $tail, @links);
265}
266
267sub title {
268 my $self = shift;
269 my $setName = $self->{set}->id;
270 my $problemNumber = $self->{problem}->id;
271
272 return "$setName : Problem $problemNumber";
273}
274
275sub body {
276 my $self = shift;
277
278 return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open."))
279 unless $self->{isOpen};
280
281 # unpack some useful variables
282 my $r = $self->{r};
283 my $wwdb = $self->{wwdb};
284 my $set = $self->{set};
285 my $problem = $self->{problem};
286 my $permissionLevel = $self->{permissionLevel};
287 my $submitAnswers = $self->{submitAnswers};
288 my $checkAnswers = $self->{checkAnswers};
289 my $previewAnswers = $self->{previewAnswers};
290 my %want = %{ $self->{want} };
291 my %can = %{ $self->{can} };
292 my %must = %{ $self->{must} };
293 my %will = %{ $self->{will} };
294 my $pg = $self->{pg};
295
296 ##### translation errors? #####
297
133 if ($pg->{flags}->{error_flag}) { 298 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}); 299 return $self->errorOutput($pg->{errors}, $pg->{body_text});
138
139 return "";
140 } 300 }
141
142 # massage LaTeX2HTML [TODO #3]
143 301
144 ##### answer processing ##### 302 ##### answer processing #####
145 303
146 # if answers were submitted: 304 # if answers were submitted:
147 if ($submitAnswers) { 305 if ($submitAnswers) {
148 # store answers in DB for sticky answers [TODO #4] 306 # store answers in DB for sticky answers
149 my %answersToStore; 307 my %answersToStore;
150 my %answerHash = %{ $pg->{answers} }; 308 my %answerHash = %{ $pg->{answers} };
151 $answersToStore{$_} = $answerHash{$_}->{original_student_ans} 309 $answersToStore{$_} = $answerHash{$_}->{original_student_ans}
152 foreach (keys %answerHash); 310 foreach (keys %answerHash);
153 my $answerString = encodeAnswers(%answersToStore, 311 my $answerString = encodeAnswers(%answersToStore,
154 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); 312 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
155 $problem->last_answer($answerString); 313 $problem->last_answer($answerString);
156 $wwdb->setProblem($problem); 314 $wwdb->setProblem($problem);
157 315
158 # store score in DB if it makes sense [TODO #5] 316 # store state in DB if it makes sense
317 if ($will{recordAnswers}) {
318 $problem->attempted(1);
319 $problem->status($pg->{state}->{recorded_score});
320 $problem->num_correct($pg->{state}->{num_of_correct_ans});
321 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
322 $wwdb->setProblem($problem);
323 # write to the transaction log, just to make sure
324 writeLog($self->{courseEnvironment}, "transaction",
325 $problem->id."\t".
326 $problem->set_id."\t".
327 $problem->login_id."\t".
328 $problem->source_file."\t".
329 $problem->value."\t".
330 $problem->max_attempts."\t".
331 $problem->problem_seed."\t".
332 $problem->status."\t".
333 $problem->attempted."\t".
334 $problem->last_answer."\t".
335 $problem->num_correct."\t".
336 $problem->num_incorrect
337 );
159 338 }
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 } 339 }
167 340
168 ##### output ##### 341 ##### output #####
342 print CGI::start_div({class=>"problemHeader"});
343 # attempt summary
344 if ($submitAnswers or $will{showCorrectAnswers}) {
345 # print this if user submitted answers OR requested correct answers
346 print $self->attemptResults($pg, $submitAnswers,
347 $will{showCorrectAnswers},
348 $pg->{flags}->{showPartialCorrectAnswers}, 1, 0);
349 } elsif ($checkAnswers) {
350 # print this if user previewed answers
351 print $self->attemptResults($pg, 1, 0, 1, 1, 0);
352 # show attempt answers
353 # don't show correct answers
354 # show attempt results (correctness)
355 # don't show attempt previews
356 } elsif ($previewAnswers) {
357 # print this if user previewed answers
358 print $self->attemptResults($pg, 1, 0, 0, 0, 1);
359 # show attempt answers
360 # don't show correct answers
361 # don't show attempt results (correctness)
362 # show attempt previews
363 }
169 364
170 # view options 365 print CGI::end_div();
171 # what i'd really like to do here is:
172 # - preserve the answers currently in the form fields
173 # - display the answer summary box
174 # - NOT record answers UNDER ANY CIRCUMSTANCES!
175 366
367 print CGI::start_div({class=>"problem"});
368 #print CGI::hr();
176 # main form 369 # main form
177 print 370 print
178 startform("POST", $r->uri), 371 CGI::startform("POST", $r->uri),
179 $self->hidden_authen_fields, 372 $self->hidden_authen_fields,
180 p($pg->{body_text}), 373 CGI::p($pg->{body_text}),
181 p(submit(-name=>"submitAnswers", -label=>"Submit Answers")), 374 CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})),
182 viewOptions($displayMode, $showOldAnswers, $showCorrectAnswers, 375 CGI::p(
183 $showHints, $showSolutions), 376 ($can{recordAnswers}
377 ? CGI::submit(-name=>"submitAnswers",
378 -label=>"Submit Answers")
379 : ""),
380 ($can{checkAnswers}
381 ? CGI::submit(-name=>"checkAnswers",
382 -label=>"Check Answers")
383 : ""),
384 CGI::submit(-name=>"previewAnswers",
385 -label=>"Preview Answers"),
386 );
387 # score summary
388 my $attempts = $problem->num_correct + $problem->num_incorrect;
389 my $attemptsNoun = $attempts != 1 ? "times" : "time";
390 my $lastScore = int ($problem->status * 100) . "%";
391 my ($attemptsLeft, $attemptsLeftNoun);
392 if ($problem->max_attempts == -1) {
393 # unlimited attempts
394 $attemptsLeft = "unlimited";
395 $attemptsLeftNoun = "attempts";
396 } else {
397 $attemptsLeft = $problem->max_attempts - $attempts;
398 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
399 }
400
401 my $setClosed = 0;
402 my $setClosedMessage;
403 if (time < $set->open_date or time > $set->due_date) {
404 $setClosed = 1;
405 $setClosedMessage = "This problem set is closed.";
406 if ($permissionLevel > 0) {
407 $setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded.";
408 } else {
409 $setClosedMessage .= " Additional attempts will not be recorded.";
410 }
411 }
412 print CGI::p(
413 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
414 $problem->attempted
415 ? "Your recorded score is $lastScore." . CGI::br()
416 : "",
417 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
418 );
419
420
421 print
422 $self->viewOptions(),
184 endform(), 423 CGI::endform();
185 hr(); 424
425 print CGI::end_div();
426 # feedback form
427 my $ce = $self->{courseEnvironment};
428 my $root = $ce->{webworkURLs}->{root};
429 my $courseName = $ce->{courseName};
430 my $feedbackURL = "$root/$courseName/feedback/";
431 print
432 CGI::startform("POST", $feedbackURL),
433 $self->hidden_authen_fields,
434 CGI::hidden("module", __PACKAGE__),
435 CGI::hidden("set", $set->id),
436 CGI::hidden("problem", $problem->id),
437 CGI::hidden("displayMode", $self->{displayMode}),
438 CGI::hidden("showOldAnswers", $will{showOldAnswers}),
439 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),
440 CGI::hidden("showHints", $will{showHints}),
441 CGI::hidden("showSolutions", $will{showSolutions}),
442 CGI::p({-align=>"right"},
443 CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback")
444 ),
445 CGI::endform();
446
447 # warning output
448 if ($pg->{warnings} ne "") {
449 print CGI::hr(), $self->warningOutput($pg->{warnings});
450 }
186 451
187 # debugging stuff 452 # debugging stuff
453 if (0) {
188 print 454 print
455 CGI::hr(),
189 h2("debugging information"), 456 CGI::h2("debugging information"),
190 h3("form fields"), 457 CGI::h3("form fields"),
191 ref2string($formFields), 458 ref2string($self->{formFields}),
192 h3("user object"), 459 CGI::h3("user object"),
193 ref2string($user), 460 ref2string($self->{user}),
194 h3("set object"), 461 CGI::h3("set object"),
195 ref2string($set), 462 ref2string($set),
196 h3("problem object"), 463 CGI::h3("problem object"),
197 ref2string($problem), 464 ref2string($problem),
198 h3("PG object"), 465 CGI::h3("PG object"),
199 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 466 ref2string($pg, {'WeBWorK::PG::Translator' => 1});
467 }
200 468
201 return ""; 469 return "";
202} 470}
203 471
204# ----- 472##### output utilities #####
205 473
206sub translationError($$) {
207 my ($error, $details) = @_;
208 return
209 p(<<EOF),
210WeBWorK has encountered a software error while attempting to process this problem.
211It is likely that there is an error in the problem itself.
212If 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.
214EOF
215 h3("Error messages"), blockquote(pre($error)),
216 h3("Error context"), blockquote(pre($details));
217}
218
219sub attemptResults($$$) { 474sub attemptResults($$$$$$) {
475 my $self = shift;
220 my $pg = shift; 476 my $pg = shift;
477 my $showAttemptAnswers = shift;
221 my $showCorrectAnswers = shift; 478 my $showCorrectAnswers = shift;
479 my $showAttemptResults = $showAttemptAnswers && shift;
480 my $showSummary = shift;
222 my $showAttemptResults = shift; 481 my $showAttemptPreview = shift || 0;
223 my $problemResult = $pg->{result}; # the overall result of the problem 482 my $problemResult = $pg->{result}; # the overall result of the problem
224 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 483 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
225 484
226 my $header = th("answer") . th("attempt"); 485 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
486
487 my $header = CGI::th("Part");
488 $header .= $showAttemptAnswers ? CGI::th("Entered") : "";
489 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : "";
227 $header .= $showCorrectAnswers ? th("correct") : ""; 490 $header .= $showCorrectAnswers ? CGI::th("Correct") : "";
228 $header .= $showAttemptResults ? th("result") : ""; 491 $header .= $showAttemptResults ? CGI::th("Result") : "";
229 $header .= th("messages"); 492 $header .= $showMessages ? CGI::th("messages") : "";
230 my @tableRows = ( $header ); 493 my @tableRows = ( $header );
231 my $numCorrect; 494 my $numCorrect;
232 foreach my $name (@answerNames) { 495 foreach my $name (@answerNames) {
233 my $answerResult = $pg->{answers}->{$name}; 496 my $answerResult = $pg->{answers}->{$name};
234 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 497 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
498 my $preview = ($showAttemptPreview
499 ? $self->previewAnswer($answerResult)
500 : "");
235 my $correctAnswer = $answerResult->{correct_ans}; 501 my $correctAnswer = $answerResult->{correct_ans};
236 my $answerScore = $answerResult->{score}; 502 my $answerScore = $answerResult->{score};
237 my $answerMessage = $answerResult->{ans_message}; 503 my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
238 504
239 $numCorrect += $answerScore > 0; 505 $numCorrect += $answerScore > 0;
240 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 506 my $resultString = $answerScore ? "correct" : "incorrect";
241 507
242 my $row = td($name) . td($studentAnswer); 508 # get rid of the goofy prefix on the answer names (supposedly, the format
509 # of the answer names is changeable. this only fixes it for "AnSwEr"
510 $name =~ s/^AnSwEr//;
511
512 my $row = CGI::td($name);
513 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
514 $row .= $showAttemptPreview ? CGI::td($preview) : "";
243 $row .= $showCorrectAnswers ? td($correctAnswer) : ""; 515 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
244 $row .= $showAttemptResults ? td($resultString) : ""; 516 $row .= $showAttemptResults ? CGI::td($resultString) : "";
245 $row .= $answerMessage ? td($answerMessage) : ""; 517 $row .= $answerMessage ? CGI::td($answerMessage) : "";
246 push @tableRows, $row; 518 push @tableRows, $row;
247 } 519 }
248 520
521 my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
249 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 522 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
250 my $message = i($problemResult->{msg});
251 my $summary = "You answered $numCorrect questions out of " 523 my $summary = "On this attempt, you answered $numCorrect out of "
252 . scalar @answerNames . " correct, for a score of $scorePercent."; 524 . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
253 return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary); 525 return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . ($showSummary ? CGI::p($summary) : "");
254} 526}
255 527
256sub viewOptions($$$$$) { 528sub viewOptions($) {
257 my ($displayMode, $showOldAnswers, $showCorrectAnswers, 529 my $self = shift;
258 $showHints, $showSolutions) = @_; 530 my $displayMode = $self->{displayMode};
531 my %must = %{ $self->{must} };
532 my %can = %{ $self->{can} };
533 my %will = %{ $self->{will} };
534
535 my $optionLine;
536 $can{showOldAnswers} and $optionLine .= join "",
537 "Show: &nbsp;",
538 CGI::checkbox(
539 -name => "showOldAnswers",
540 -checked => $will{showOldAnswers},
541 -label => "Saved answers",
542 ), "&nbsp;&nbsp;";
543 $can{showCorrectAnswers} and $optionLine .= join "",
544 CGI::checkbox(
545 -name => "showCorrectAnswers",
546 -checked => $will{showCorrectAnswers},
547 -label => "Correct answers",
548 ), "&nbsp;&nbsp;";
549 $can{showHints} and $optionLine .= join "",
550 CGI::checkbox(
551 -name => "showHints",
552 -checked => $will{showHints},
553 -label => "Hints",
554 ), "&nbsp;&nbsp;";
555 $can{showSolutions} and $optionLine .= join "",
556 CGI::checkbox(
557 -name => "showSolutions",
558 -checked => $will{showSolutions},
559 -label => "Solutions",
560 ), "&nbsp;&nbsp;";
561 $optionLine and $optionLine .= join "", CGI::br();
562
259 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, 563 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
260 "View equations as: &nbsp;", 564 "View equations as: &nbsp;",
261 radio_group( 565 CGI::radio_group(
262 -name => "displayMode", 566 -name => "displayMode",
263 -values => ['plainText', 'formattedText', 'images'], 567 -values => ['plainText', 'formattedText', 'images'],
264 -default => $displayMode, 568 -default => $displayMode,
265 -labels => { 569 -labels => {
266 plainText => "plain text", 570 plainText => "plain text",
267 formattedText => "formatted text", 571 formattedText => "formatted text",
268 images => "images", 572 images => "images",
269 } 573 }
270 ), br(), 574 ), CGI::br(),
271 "Show: &nbsp;", 575 $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"), 576 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
293 ); 577 );
294} 578}
295 579
296# ----- 580sub previewAnswer($$) {
581 my ($self, $answerResult) = @_;
582 my $ce = $self->{courseEnvironment};
583 my $effectiveUser = $self->{effectiveUser};
584 my $set = $self->{set};
585 my $problem = $self->{problem};
586 my $displayMode = $self->{displayMode};
587
588 # note: right now, we have to do things completely differently when we are
589 # rendering math from INSIDE the translator and from OUTSIDE the translator.
590 # so we'll just deal with each case explicitly here. there's some code
591 # duplication that can be dealt with later by abstracting out tth/dvipng/etc.
592
593 my $tex = $answerResult->{preview_latex_string};
594
595 return "" unless $tex;
596
597 if ($displayMode eq "plainText") {
598 return $tex;
599 } elsif ($displayMode eq "formattedText") {
600 my $tthCommand = $ce->{externalPrograms}->{tth}
601 . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
602 . "\\(".$tex."\\)\n"
603 . "END_OF_INPUT\n";
604
605 # call tth
606 my $result = `$tthCommand`;
607 if ($?) {
608 return "<b>[tth failed: $? $@]</b>";
609 }
610 return $result;
611 } elsif ($displayMode eq "images") {
612 # how are we going to name this?
613 my $targetPathCommon = "/png/"
614 . $effectiveUser->id . "."
615 . $set->id . "."
616 . $problem->id . "."
617 . $answerResult->{ans_name} . ".png";
618
619 # figure out where to put things
620 my $wd = tempdir("webwork-dvipng-XXXXXXXX", DIR => $ce->{courseDirs}->{html_temp});
621 my $latex = $ce->{externalPrograms}->{latex};
622 my $dvipng = $ce->{externalPrograms}->{dvipng};
623 my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
624 # should use surePathToTmpFile, but we have to
625 # isolate it from the problem enivronment first
626 my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
627
628 # call dvipng to generate a preview
629 warn $tex;
630 dvipng($wd, $latex, $dvipng, $tex, $targetPath);
631 if (-e $targetPath) {
632 return "<img src=\"$targetURL\" alt=\"$tex\" />";
633 } else {
634 return "<b>[math2img failed]</b>";
635 }
636 }
637}
638
639##### permission queries #####
297 640
298# this stuff should be abstracted out into the permissions system 641# this stuff should be abstracted out into the permissions system
299# however, the permission system only knows about things in the 642# however, the permission system only knows about things in the
300# course environment and the username. hmmm... 643# course environment and the username. hmmm...
301 644
645# also, i should fix these so that they have a consistent calling
646# format -- perhaps:
647# canPERM($courseEnv, $user, $set, $problem, $permissionLevel)
648
302sub canShowCorrectAnswers($$) { 649sub canShowCorrectAnswers($$) {
303 my ($permissionLevel, $answerDate) = @_; 650 my ($permissionLevel, $answerDate) = @_;
304 return $permissionLevel > 0 || time > $answerDate; 651 return $permissionLevel > 0 || time > $answerDate;
305} 652}
306 653
307sub canShowSolutions($$) { 654sub canShowSolutions($$) {
308 my ($permissionLevel, $answerDate) = @_; 655 my ($permissionLevel, $answerDate) = @_;
309 return canShowCorrectAnswers($permissionLevel, $answerDate); 656 return canShowCorrectAnswers($permissionLevel, $answerDate);
310} 657}
311 658
312sub canRecordAnswers($$$) { 659sub canRecordAnswers($$$$$) {
313 my ($permissionLevel, $openDate, $dueDate) = @_; 660 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
314 return $permissionLevel > 0 || (time >= $openDate && time <= $dueDate); 661 my $permHigh = $permissionLevel > 0;
662 my $timeOK = time >= $openDate && time <= $dueDate;
663 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
664 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK);
665 return $recordAnswers;
666}
667
668sub canCheckAnswers($$$$$) {
669 my ($permissionLevel, $openDate, $dueDate, $answerDate, $maxAttempts, $attempts) = @_;
670 return time >= $answerDate or canRecordAnswers($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts);
315} 671}
316 672
317sub mustRecordAnswers($) { 673sub mustRecordAnswers($) {
318 my ($permissionLevel) = @_; 674 my ($permissionLevel) = @_;
319 return $permissionLevel == 0; 675 return $permissionLevel == 0;
Legend:
Removed from v.429  
changed lines
  Added in v.755
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9