[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 434 Revision 671
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
12# key 27# key
13# 28#
14# displayMode 29# displayMode
15# showOldAnswers 30# showOldAnswers
… …
19# 34#
20# AnSwEr# - answer blanks in problem 35# AnSwEr# - answer blanks in problem
21# 36#
22# redisplay - name of the "Redisplay Problem" button 37# redisplay - name of the "Redisplay Problem" button
23# submitAnswers - name of "Submit Answers" button 38# submitAnswers - name of "Submit Answers" button
39#
40############################################################
24 41
25sub title { 42sub 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# :) 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) = @_; 43 my ($self, $setName, $problemNumber) = @_;
44 my $courseEnv = $self->{courseEnvironment}; 44 my $courseEnv = $self->{courseEnvironment};
45 my $r = $self->{r}; 45 my $r = $self->{r};
46 my $userName = $r->param('user'); 46 my $userName = $r->param('user');
47 47
48 # fix format of setName and problem
49 $setName =~ s/^set//;
50 $problemNumber =~ s/^prob//;
51
52 ##### database setup ##### 48 ##### database setup #####
53 # this should probably go in initialize() or whatever it's called
54 49
55 my $classlist = WeBWorK::DB::Classlist->new($courseEnv); 50 my $cldb = WeBWorK::DB::Classlist->new($courseEnv);
56 my $wwdb = WeBWorK::DB::WW->new($courseEnv); 51 my $wwdb = WeBWorK::DB::WW->new($courseEnv);
57 my $authdb = WeBWorK::DB::Auth->new($courseEnv); 52 my $authdb = WeBWorK::DB::Auth->new($courseEnv);
58 53
59 my $user = $classlist->getUser($userName); 54 my $user = $cldb->getUser($userName);
60 my $set = $wwdb->getSet($userName, $setName); 55 my $set = $wwdb->getSet($userName, $setName);
61 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 56 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
57 my $psvn = $wwdb->getPSVN($userName, $setName);
62 my $permissionLevel = $authdb->getPermissions($userName); 58 my $permissionLevel = $authdb->getPermissions($userName);
63 59
64 ##### form processing ##### 60 ##### form processing #####
65 61
66 # set options from form fields (see comment at top of file for names) 62 # set options from form fields (see comment at top of file for names)
67 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 63 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
68 my $redisplay = $r->param("redisplay"); 64 my $redisplay = $r->param("redisplay");
69 my $submitAnswers = $r->param("submitAnswers"); 65 my $submitAnswers = $r->param("submitAnswers");
66 my $previewAnswers = $r->param("previewAnswers");
70 67
68 # coerce form fields into CGI::Vars format
69 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
70
71 ##### permissions #####
72
73 # what does the user want to do?
71 my %want = ( 74 my %want = (
72 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, 75 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
73 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, 76 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
74 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, 77 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
75 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, 78 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
76 recordAnswers => $r->param("recordAnswers") || 1, 79 recordAnswers => $r->param("recordAnswers") || 1,
77 ); 80 );
78
79 # coerce form fields into CGI::Vars format
80 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
81
82 ##### permissions #####
83 81
84 # are certain options enforced? 82 # are certain options enforced?
85 my %must = ( 83 my %must = (
86 showOldAnswers => 0, 84 showOldAnswers => 0,
87 showCorrectAnswers => 0, 85 showCorrectAnswers => 0,
… …
101 # num_correct+num_incorrect+1 -- as this happens before updating $problem 99 # num_correct+num_incorrect+1 -- as this happens before updating $problem
102 ); 100 );
103 101
104 # final values for options 102 # final values for options
105 my %will; 103 my %will;
106 foreach(keys %must) { 104 foreach (keys %must) {
107 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 105 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
106 #warn "$_: can? $can{$_} want? $want{$_} must? $must{$_} will? $will{$_}\n";
108 } 107 }
109 108
110 ##### sticky answers ##### 109 ##### sticky answers #####
111 110
112 if (not $submitAnswers and $will{showOldAnswers}) { 111 if (not $submitAnswers and $will{showOldAnswers}) {
… …
117 116
118 ##### translation ##### 117 ##### translation #####
119 118
120 my $pg = WeBWorK::PG->new( 119 my $pg = WeBWorK::PG->new(
121 $courseEnv, 120 $courseEnv,
122 $r->param('user'), 121 $user,
123 $r->param('key'), 122 $r->param('key'),
124 $setName, 123 $set,
125 $problemNumber, 124 $problem,
125 $psvn,
126 $formFields,
126 { # translation options 127 { # translation options
127 displayMode => $displayMode, 128 displayMode => $displayMode,
128 showHints => $will{showHints}, 129 showHints => $will{showHints},
129 showSolutions => $will{showSolutions}, 130 showSolutions => $will{showSolutions},
130 refreshMath2img => $will{showHints} || $will{showSolutions}, 131 refreshMath2img => $will{showHints} || $will{showSolutions},
131 # try leaving processAnswers on all the time? 132 # try leaving processAnswers on all the time?
132 processAnswers => 1, #$submitAnswers ? 1 : 0, 133 processAnswers => 1, #$submitAnswers ? 1 : 0,
133 }, 134 },
134 $formFields
135 ); 135 );
136 136
137 # 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->{previewAnswers} = $previewAnswers;
152 $self->{formFields} = $formFields;
153
154 $self->{want} = \%want;
155 $self->{must} = \%must;
156 $self->{can} = \%can;
157 $self->{will} = \%will;
158
159 $self->{pg} = $pg;
160}
161
162sub if_warnings($$) {
163 my ($self, $arg) = @_;
164 return $self->{pg}->{warnings} ne "";
165}
166
167sub if_errors($$) {
168 my ($self, $arg) = @_;
169 return $self->{pg}->{flags}->{error_flag};
170}
171
172sub head {
173 my $self = shift;
174
175 return $self->{pg}->{head_text} if $self->{pg}->{head_text};
176}
177
178sub path {
179 my $self = shift;
180 my $args = $_[-1];
181 my $setName = $self->{set}->id;
182 my $problemNumber = $self->{problem}->id;
183
184 my $ce = $self->{courseEnvironment};
185 my $root = $ce->{webworkURLs}->{root};
186 my $courseName = $ce->{courseName};
187 return $self->pathMacro($args,
188 "Home" => "$root",
189 $courseName => "$root/$courseName",
190 $setName => "$root/$courseName/$setName",
191 "Problem $problemNumber" => "",
192 );
193}
194
195sub siblings {
196 my $self = shift;
197 my $setName = $self->{set}->id;
198 my $problemNumber = $self->{problem}->id;
199
200 my $ce = $self->{courseEnvironment};
201 my $root = $ce->{webworkURLs}->{root};
202 my $courseName = $ce->{courseName};
203
204 print CGI::strong("Problems"), CGI::br();
205
206 my $wwdb = $self->{wwdb};
207 my $user = $self->{r}->param("user");
208 my @problems;
209 push @problems, $wwdb->getProblem($user, $setName, $_)
210 foreach ($wwdb->getProblems($user, $setName));
211 foreach my $problem (sort { $a->id <=> $b->id } @problems) {
212 print CGI::a({-href=>"$root/$courseName/$setName/".$problem->id."/?"
213 . $self->url_authen_args}, "Problem ".$problem->id), CGI::br();
214 }
215}
216
217sub nav {
218 my $self = shift;
219 my $args = $_[-1];
220 my $setName = $self->{set}->id;
221 my $problemNumber = $self->{problem}->id;
222
223 my $ce = $self->{courseEnvironment};
224 my $root = $ce->{webworkURLs}->{root};
225 my $courseName = $ce->{courseName};
226
227 my $wwdb = $self->{wwdb};
228 my $user = $self->{r}->param("user");
229
230 my @links = ("Problem List" => "$root/$courseName/$setName");
231
232 my $prevProblem = $wwdb->getProblem($user, $setName, $problemNumber-1);
233 my $nextProblem = $wwdb->getProblem($user, $setName, $problemNumber+1);
234 unshift @links, "Previous Problem" => $prevProblem
235 ? "$root/$courseName/$setName/".$prevProblem->id
236 : "";
237 push @links, "Next Problem" => $nextProblem
238 ? "$root/$courseName/$setName/".$nextProblem->id
239 : "";
240
241 return $self->navMacro($args, @links);
242}
243
244sub title {
245 my $self = shift;
246 my $setName = $self->{set}->id;
247 my $problemNumber = $self->{problem}->id;
248
249 return "$setName : Problem $problemNumber";
250}
251
252sub body {
253 my $self = shift;
254
255 # unpack some useful variables
256 my $r = $self->{r};
257 my $wwdb = $self->{wwdb};
258 my $set = $self->{set};
259 my $problem = $self->{problem};
260 my $permissionLevel = $self->{permissionLevel};
261 my $submitAnswers = $self->{submitAnswers};
262 my $previewAnswers = $self->{previewAnswers};
263 my %will = %{ $self->{will} };
264 my $pg = $self->{pg};
265
266 ##### translation errors? #####
267
138 if ($pg->{flags}->{error_flag}) { 268 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}); 269 return translationError($pg->{errors}, $pg->{body_text});
143
144 return "";
145 } 270 }
146 271
147 ##### answer processing ##### 272 ##### answer processing #####
148 273
149 # if answers were submitted: 274 # if answers were submitted:
… …
156 my $answerString = encodeAnswers(%answersToStore, 281 my $answerString = encodeAnswers(%answersToStore,
157 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); 282 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
158 $problem->last_answer($answerString); 283 $problem->last_answer($answerString);
159 $wwdb->setProblem($problem); 284 $wwdb->setProblem($problem);
160 285
161 # store score in DB if it makes sense 286 # store state in DB if it makes sense
162 if ($will{recordAnswers}) { 287 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); 288 $problem->attempted(1);
167 $problem->status($pg->{state}->{recorded_score}); 289 $problem->status($pg->{state}->{recorded_score});
168 $problem->num_correct($pg->{state}->{num_of_correct_ans}); 290 $problem->num_correct($pg->{state}->{num_of_correct_ans});
169 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 291 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
170 #warn "Would have stored the following:\n",
171 # $problem->toString, "\n";
172 $wwdb->setProblem($problem); 292 $wwdb->setProblem($problem);
173 } else { 293 # write to the transaction log, just to make sure
174 print p("Your score was not recorded for some reason. ;)"); 294 writeLog($self->{courseEnvironment}, "transaction",
295 $problem->id."\t".
296 $problem->set_id."\t".
297 $problem->login_id."\t".
298 $problem->source_file."\t".
299 $problem->value."\t".
300 $problem->max_attempts."\t".
301 $problem->problem_seed."\t".
302 $problem->status."\t".
303 $problem->attempted."\t".
304 $problem->last_answer."\t".
305 $problem->num_correct."\t".
306 $problem->num_incorrect
307 );
175 } 308 }
176 } 309 }
177 310
178 ##### output ##### 311 ##### output #####
179 312
180 # attempt summary 313 # attempt summary
181 if ($submitAnswers or $will{showCorrectAnswers}) { 314 if ($submitAnswers or $will{showCorrectAnswers}) {
182 # print this if user submitted answers OR requested correct answers 315 # print this if user submitted answers OR requested correct answers
183 print attemptResults($pg, $submitAnswers, $will{showCorrectAnswers}, 316 print $self->attemptResults($pg, $submitAnswers, $will{showCorrectAnswers},
184 $pg->{flags}->{showPartialCorrectAnswers}); 317 $pg->{flags}->{showPartialCorrectAnswers});
318 } elsif ($previewAnswers) {
319 # print this if user previewed answers
320 print $self->attemptResults($pg, 1, 0, 0);
321 # don't show correctness
322 # don't show correct answers
185 } 323 }
186 324
187 # score summary 325 # score summary
188 my $attempts = $problem->num_correct + $problem->num_incorrect; 326 my $attempts = $problem->num_correct + $problem->num_incorrect;
189 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 327 my $attemptsNoun = $attempts != 1 ? "times" : "time";
… …
195 $attemptsLeftNoun = "attempts"; 333 $attemptsLeftNoun = "attempts";
196 } else { 334 } else {
197 $attemptsLeft = $problem->max_attempts - $attempts; 335 $attemptsLeft = $problem->max_attempts - $attempts;
198 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 336 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
199 } 337 }
338 my $setClosedMessage;
339 if (time < $set->open_date or time > $set->due_date) {
340 $setClosedMessage = "This problem set is closed.";
341 if ($permissionLevel > 0) {
342 $setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded.";
343 } else {
344 $setClosedMessage .= " Additional attempts will not be recorded.";
345 }
346 }
200 print p( 347 print CGI::p(
201 "You have attempted this problem $attempts $attemptsNoun.", br(), 348 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
202 $problem->attempted 349 $problem->attempted
203 ? "Your recorded score is $lastScore." . br() 350 ? "Your recorded score is $lastScore." . CGI::br()
204 : "", 351 : "",
205 "You have $attemptsLeft $attemptsLeftNoun remaining." 352 "You have $attemptsLeft $attemptsLeftNoun remaining.", CGI::br(),
353 $setClosedMessage,
206 ); 354 );
207 355
208 # BY THE WAY..........
209 # we have to figure out some way to tell the student if their NEW answer,
210 # 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
212 # cases where the answer is NOT being recorded, because of things decided
213 # in &canRecordAnswers...
214
215 print hr(); 356 print CGI::hr();
216 357
217 # main form 358 # main form
218 print 359 print
219 startform("POST", $r->uri), 360 CGI::startform("POST", $r->uri),
220 $self->hidden_authen_fields, 361 $self->hidden_authen_fields,
221 p(i($pg->{result}->{msg})), 362 CGI::p(CGI::i($pg->{result}->{msg})),
222 p($pg->{body_text}), 363 CGI::p($pg->{body_text}),
364 CGI::p(
223 p(submit(-name=>"submitAnswers", -label=>"Submit Answers")), 365 CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers"),
224 viewOptions($displayMode, \%must, \%can, \%will), 366 CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers"),
367 ),
368 $self->viewOptions(),
225 endform(), 369 CGI::endform();
226 hr(); 370
371 # feedback form
372 my $ce = $self->{courseEnvironment};
373 my $root = $ce->{webworkURLs}->{root};
374 my $courseName = $ce->{courseName};
375 my $feedbackURL = "$root/$courseName/feedback/";
376 print
377 CGI::startform("POST", $feedbackURL),
378 $self->hidden_authen_fields,
379 CGI::hidden("module", __PACKAGE__),
380 CGI::hidden("set", $set->id),
381 CGI::hidden("problem", $problem->id),
382 CGI::hidden("displayMode", $self->{displayMode}),
383 CGI::hidden("showOldAnswers", $will{showOldAnswers}),
384 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),
385 CGI::hidden("showHints", $will{showHints}),
386 CGI::hidden("showSolutions", $will{showSolutions}),
387 CGI::p({-align=>"right"},
388 CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback")
389 ),
390 CGI::endform();
391
392 # warning output
393 if ($pg->{warnings} ne "") {
394 print CGI::hr(), warningOutput($pg->{warnings});
395 }
227 396
228 # debugging stuff 397 # debugging stuff
229 print 398 #print
399 # CGI::hr(),
230 h2("debugging information"), 400 # CGI::h2("debugging information"),
231 h3("form fields"), 401 # CGI::h3("form fields"),
232 ref2string($formFields), 402 # ref2string($self->{formFields}),
233 h3("user object"), 403 # CGI::h3("user object"),
234 ref2string($user), 404 # ref2string($self->{user}),
235 h3("set object"), 405 # CGI::h3("set object"),
236 ref2string($set), 406 # ref2string($set),
237 h3("problem object"), 407 # CGI::h3("problem object"),
238 ref2string($problem), 408 # ref2string($problem),
239 h3("PG object"), 409 # CGI::h3("PG object"),
240 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 410 # ref2string($pg, {'WeBWorK::PG::Translator' => 1});
241 411
242 return ""; 412 return "";
243} 413}
244 414
245##### output utilities ##### 415##### output utilities #####
246 416
417# this is used by ProblemSet.pm too, so don't fuck it up
247sub translationError($$) { 418sub translationError($$) {
248 my ($error, $details) = @_; 419 my ($error, $details) = @_;
249 return 420 return
421 CGI::h2("Software Error"),
250 p(<<EOF), 422 CGI::p(<<EOF),
251WeBWorK has encountered a software error while attempting to process this problem. 423WeBWorK has encountered a software error while attempting to process this problem.
252It is likely that there is an error in the problem itself. 424It is likely that there is an error in the problem itself.
253If you are a student, contact your professor to have the error corrected. 425If 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. 426If you are a professor, please consut the error output below for more informaiton.
255EOF 427EOF
256 h3("Error messages"), blockquote(pre($error)), 428 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)),
257 h3("Error context"), blockquote(pre($details)); 429 CGI::h3("Error context"), CGI::blockquote(CGI::pre($details));
258} 430}
259 431
432# this is used by ProblemSet.pm too, so don't fuck it up
433sub warningOutput($) {
434 my $warnings = shift;
435
436 return
437 CGI::h2("Software Warnings"),
438 CGI::p(<<EOF),
439WeBWorK has encountered warnings while attempting to process this problem.
440It is likely that this indicates an error or ambiguity in the problem itself.
441If you are a student, contact your professor to have the problem corrected.
442If you are a professor, please consut the error output below for more informaiton.
443EOF
444 CGI::h3("Warning messages"),
445 CGI::blockquote(CGI::pre($warnings)),
446 ;
447}
448
260sub attemptResults($$$) { 449sub attemptResults($$$$$) {
450 my $self = shift;
261 my $pg = shift; 451 my $pg = shift;
262 my $showAttemptAnswers = shift; 452 my $showAttemptAnswers = shift;
263 my $showCorrectAnswers = shift; 453 my $showCorrectAnswers = shift;
264 my $showAttemptResults = $showAttemptAnswers && shift; 454 my $showAttemptResults = $showAttemptAnswers && shift;
265 my $problemResult = $pg->{result}; # the overall result of the problem 455 my $problemResult = $pg->{result}; # the overall result of the problem
266 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 456 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
267 457
268 my $header = th("answer"); 458 my $header = CGI::th("answer");
269 $header .= $showAttemptAnswers ? th("attempt") : ""; 459 $header .= $showAttemptAnswers ? CGI::th("attempt") : "";
460 $header .= $showAttemptAnswers ? CGI::th("preview") : "";
270 $header .= $showCorrectAnswers ? th("correct") : ""; 461 $header .= $showCorrectAnswers ? CGI::th("correct") : "";
271 $header .= $showAttemptResults ? th("result") : ""; 462 $header .= $showAttemptResults ? CGI::th("result") : "";
272 $header .= $showAttemptAnswers ? th("messages") : ""; 463 $header .= $showAttemptAnswers ? CGI::th("messages") : "";
273 my @tableRows = ( $header ); 464 my @tableRows = ( $header );
274 my $numCorrect; 465 my $numCorrect;
275 foreach my $name (@answerNames) { 466 foreach my $name (@answerNames) {
276 my $answerResult = $pg->{answers}->{$name}; 467 my $answerResult = $pg->{answers}->{$name};
277 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 468 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
469 my $preview = $self->previewAnswer($answerResult);
278 my $correctAnswer = $answerResult->{correct_ans}; 470 my $correctAnswer = $answerResult->{correct_ans};
279 my $answerScore = $answerResult->{score}; 471 my $answerScore = $answerResult->{score};
280 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; 472 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : "";
281 473
282 $numCorrect += $answerScore > 0; 474 $numCorrect += $answerScore > 0;
283 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 475 my $resultString = $answerScore ? "correct" : "incorrect";
284 476
477 # get rid of the goofy prefix on the answer names (supposedly, the format
478 # of the answer names is changeable. this only fixes
479 $name =~ s/^AnSwEr//;
480
285 my $row = td($name); 481 my $row = CGI::td($name);
286 $row .= $showAttemptAnswers ? td($studentAnswer) : ""; 482 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
483 $row .= $showAttemptAnswers ? CGI::td($preview) : "";
287 $row .= $showCorrectAnswers ? td($correctAnswer) : ""; 484 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
288 $row .= $showAttemptResults ? td($resultString) : ""; 485 $row .= $showAttemptResults ? CGI::td($resultString) : "";
289 $row .= $answerMessage ? td($answerMessage) : ""; 486 $row .= $answerMessage ? CGI::td($answerMessage) : "";
290 push @tableRows, $row; 487 push @tableRows, $row;
291 } 488 }
292 489
293 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions"; 490 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions";
294 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 491 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
295 #my $message = i($problemResult->{msg});
296 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of " 492 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of "
297 . scalar @answerNames . " correct, for a score of $scorePercent."; 493 . 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); 494 return CGI::table({-border=>1}, CGI::Tr(\@tableRows)) . CGI::p($summary);
300} 495}
301 496
302sub viewOptions($\%\%\%) { 497sub viewOptions($) {
303 my $displayMode = shift; 498 my $self = shift;
499 my $displayMode = $self->{displayMode};
304 my %must = %{ shift() }; 500 my %must = %{ $self->{must} };
305 my %can = %{ shift() }; 501 my %can = %{ $self->{can} };
306 my %will = %{ shift() }; 502 my %will = %{ $self->{will} };
307 503
308 my $optionLine; 504 my $optionLine;
309 $can{showOldAnswers} and $optionLine .= join "", 505 $can{showOldAnswers} and $optionLine .= join "",
310 "Show: &nbsp;", 506 "Show: &nbsp;",
311 checkbox( 507 CGI::checkbox(
312 -name => "showOldAnswers", 508 -name => "showOldAnswers",
313 -checked => $will{showOldAnswers}, 509 -checked => $will{showOldAnswers},
314 -label => "Saved answers", 510 -label => "Saved answers",
315 ), "&nbsp;&nbsp;"; 511 ), "&nbsp;&nbsp;";
316 $can{showCorrectAnswers} and $optionLine .= join "", 512 $can{showCorrectAnswers} and $optionLine .= join "",
317 checkbox( 513 CGI::checkbox(
318 -name => "showCorrectAnswers", 514 -name => "showCorrectAnswers",
319 -checked => $will{showCorrectAnswers}, 515 -checked => $will{showCorrectAnswers},
320 -label => "Correct answers", 516 -label => "Correct answers",
321 ), "&nbsp;&nbsp;"; 517 ), "&nbsp;&nbsp;";
322 $can{showHints} and $optionLine .= join "", 518 $can{showHints} and $optionLine .= join "",
323 checkbox( 519 CGI::checkbox(
324 -name => "showHints", 520 -name => "showHints",
325 -checked => $will{showHints}, 521 -checked => $will{showHints},
326 -label => "Hints", 522 -label => "Hints",
327 ), "&nbsp;&nbsp;"; 523 ), "&nbsp;&nbsp;";
328 $can{showSolutions} and $optionLine .= join "", 524 $can{showSolutions} and $optionLine .= join "",
329 checkbox( 525 CGI::checkbox(
330 -name => "showSolutions", 526 -name => "showSolutions",
331 -checked => $will{showSolutions}, 527 -checked => $will{showSolutions},
332 -label => "Solutions", 528 -label => "Solutions",
333 ), "&nbsp;&nbsp;"; 529 ), "&nbsp;&nbsp;";
334 $optionLine and $optionLine .= join "", br(); 530 $optionLine and $optionLine .= join "", CGI::br();
335 531
336 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, 532 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
337 "View equations as: &nbsp;", 533 "View equations as: &nbsp;",
338 radio_group( 534 CGI::radio_group(
339 -name => "displayMode", 535 -name => "displayMode",
340 -values => ['plainText', 'formattedText', 'images'], 536 -values => ['plainText', 'formattedText', 'images'],
341 -default => $displayMode, 537 -default => $displayMode,
342 -labels => { 538 -labels => {
343 plainText => "plain text", 539 plainText => "plain text",
344 formattedText => "formatted text", 540 formattedText => "formatted text",
345 images => "images", 541 images => "images",
346 } 542 }
347 ), br(), 543 ), CGI::br(),
348 $optionLine, 544 $optionLine,
349 submit(-name=>"redisplay", -label=>"Redisplay Problem"), 545 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
350 ); 546 );
547}
548
549sub previewAnswer($$) {
550 my ($self, $answerResult) = @_;
551 my $ce = $self->{courseEnvironment};
552 my $user = $self->{user};
553 my $set = $self->{set};
554 my $problem = $self->{problem};
555
556 # how are we going to name this?
557 my $targetPathCommon = "/png/"
558 . $user->id . "."
559 . $set->id . "."
560 . $problem->id . "."
561 . $answerResult->{ans_name} . ".png";
562
563 # figure out where to put things
564 my $wd = tempdir("webwork-dvipng-XXXXXXXX", DIR => $ce->{courseDirs}->{html_temp});
565 my $latex = $ce->{externalPrograms}->{latex};
566 my $dvipng = $ce->{externalPrograms}->{dvipng};
567 my $tex = $answerResult->{preview_latex_string};
568 my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
569 # should use surePathToTmpFile, but we have to
570 # isolate it from the problem enivronment first
571 my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
572
573 # call dvipng to generate a preview
574 dvipng($wd, $latex, $dvipng, $tex, $targetPath);
575 if (-e $targetPath) {
576 return "<img src=\"$targetURL\" alt=\"$tex\" />";
577 } else {
578 return "<b>[math2img failed]</b>";
579 }
351} 580}
352 581
353##### permission queries ##### 582##### permission queries #####
354 583
355# this stuff should be abstracted out into the permissions system 584# this stuff should be abstracted out into the permissions system
… …
372 601
373sub canRecordAnswers($$$$$) { 602sub canRecordAnswers($$$$$) {
374 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; 603 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
375 my $permHigh = $permissionLevel > 0; 604 my $permHigh = $permissionLevel > 0;
376 my $timeOK = time >= $openDate && time <= $dueDate; 605 my $timeOK = time >= $openDate && time <= $dueDate;
377 my $attemptsOK = $attempts <= $maxAttempts; 606 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
378 return $permHigh || ($timeOK && $attemptsOK); 607 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK);
608 return $recordAnswers;
379} 609}
380 610
381sub mustRecordAnswers($) { 611sub mustRecordAnswers($) {
382 my ($permissionLevel) = @_; 612 my ($permissionLevel) = @_;
383 return $permissionLevel == 0; 613 return $permissionLevel == 0;
Legend:
Removed from v.434  
changed lines
  Added in v.671
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9