[system] / branches / gage_dev / webwork2 / lib / WeBWorK / ContentGenerator / Problem.pm Repository:
ViewVC logotype

Diff of /branches/gage_dev/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm

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

Revision 434 Revision 634
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,
362 $self->viewOptions,
221 p(i($pg->{result}->{msg})), 363 CGI::p(CGI::i($pg->{result}->{msg})),
222 p($pg->{body_text}), 364 CGI::p($pg->{body_text}),
365 CGI::p(
223 p(submit(-name=>"submitAnswers", -label=>"Submit Answers")), 366 CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers"),
224 viewOptions($displayMode, \%must, \%can, \%will), 367 CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers"),
368 ),
225 endform(), 369 CGI::endform();
226 hr(); 370
371 # warning output
372 if ($pg->{warnings} ne "") {
373 print CGI::hr(), warningOutput($pg->{warnings});
374 }
227 375
228 # debugging stuff 376 # debugging stuff
229 print 377 #print
378 # CGI::hr(),
230 h2("debugging information"), 379 # CGI::h2("debugging information"),
231 h3("form fields"), 380 # CGI::h3("form fields"),
232 ref2string($formFields), 381 # ref2string($self->{formFields}),
233 h3("user object"), 382 # CGI::h3("user object"),
234 ref2string($user), 383 # ref2string($self->{user}),
235 h3("set object"), 384 # CGI::h3("set object"),
236 ref2string($set), 385 # ref2string($set),
237 h3("problem object"), 386 # CGI::h3("problem object"),
238 ref2string($problem), 387 # ref2string($problem),
239 h3("PG object"), 388 # CGI::h3("PG object"),
240 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 389 # ref2string($pg, {'WeBWorK::PG::Translator' => 1});
241 390
242 return ""; 391 return "";
243} 392}
244 393
245##### output utilities ##### 394##### output utilities #####
246 395
396# this is used by ProblemSet.pm too, so don't fuck it up
247sub translationError($$) { 397sub translationError($$) {
248 my ($error, $details) = @_; 398 my ($error, $details) = @_;
249 return 399 return
400 CGI::h2("Software Error"),
250 p(<<EOF), 401 CGI::p(<<EOF),
251WeBWorK has encountered a software error while attempting to process this problem. 402WeBWorK has encountered a software error while attempting to process this problem.
252It is likely that there is an error in the problem itself. 403It is likely that there is an error in the problem itself.
253If you are a student, contact your professor to have the error corrected. 404If 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. 405If you are a professor, please consut the error output below for more informaiton.
255EOF 406EOF
256 h3("Error messages"), blockquote(pre($error)), 407 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)),
257 h3("Error context"), blockquote(pre($details)); 408 CGI::h3("Error context"), CGI::blockquote(CGI::pre($details));
258} 409}
259 410
411# this is used by ProblemSet.pm too, so don't fuck it up
412sub warningOutput($) {
413 my $warnings = shift;
414
415 return
416 CGI::h2("Software Warnings"),
417 CGI::p(<<EOF),
418WeBWorK has encountered warnings while attempting to process this problem.
419It is likely that this indicates an error or ambiguity in the problem itself.
420If you are a student, contact your professor to have the problem corrected.
421If you are a professor, please consut the error output below for more informaiton.
422EOF
423 CGI::h3("Warning messages"),
424 CGI::blockquote(CGI::pre($warnings)),
425 ;
426}
427
260sub attemptResults($$$) { 428sub attemptResults($$$$$) {
429 my $self = shift;
261 my $pg = shift; 430 my $pg = shift;
262 my $showAttemptAnswers = shift; 431 my $showAttemptAnswers = shift;
263 my $showCorrectAnswers = shift; 432 my $showCorrectAnswers = shift;
264 my $showAttemptResults = $showAttemptAnswers && shift; 433 my $showAttemptResults = $showAttemptAnswers && shift;
265 my $problemResult = $pg->{result}; # the overall result of the problem 434 my $problemResult = $pg->{result}; # the overall result of the problem
266 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 435 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
267 436
268 my $header = th("answer"); 437 my $header = CGI::th("answer");
269 $header .= $showAttemptAnswers ? th("attempt") : ""; 438 $header .= $showAttemptAnswers ? CGI::th("attempt") : "";
439 $header .= $showAttemptAnswers ? CGI::th("preview") : "";
270 $header .= $showCorrectAnswers ? th("correct") : ""; 440 $header .= $showCorrectAnswers ? CGI::th("correct") : "";
271 $header .= $showAttemptResults ? th("result") : ""; 441 $header .= $showAttemptResults ? CGI::th("result") : "";
272 $header .= $showAttemptAnswers ? th("messages") : ""; 442 $header .= $showAttemptAnswers ? CGI::th("messages") : "";
273 my @tableRows = ( $header ); 443 my @tableRows = ( $header );
274 my $numCorrect; 444 my $numCorrect;
275 foreach my $name (@answerNames) { 445 foreach my $name (@answerNames) {
276 my $answerResult = $pg->{answers}->{$name}; 446 my $answerResult = $pg->{answers}->{$name};
277 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 447 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
448 my $preview = $self->previewAnswer($answerResult);
278 my $correctAnswer = $answerResult->{correct_ans}; 449 my $correctAnswer = $answerResult->{correct_ans};
279 my $answerScore = $answerResult->{score}; 450 my $answerScore = $answerResult->{score};
280 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; 451 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : "";
281 452
282 $numCorrect += $answerScore > 0; 453 $numCorrect += $answerScore > 0;
283 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 454 my $resultString = $answerScore ? "correct" : "incorrect";
284 455
456 # get rid of the goofy prefix on the answer names (supposedly, the format
457 # of the answer names is changeable. this only fixes
458 $name =~ s/^AnSwEr//;
459
285 my $row = td($name); 460 my $row = CGI::td($name);
286 $row .= $showAttemptAnswers ? td($studentAnswer) : ""; 461 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
462 $row .= $showAttemptAnswers ? CGI::td($preview) : "";
287 $row .= $showCorrectAnswers ? td($correctAnswer) : ""; 463 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
288 $row .= $showAttemptResults ? td($resultString) : ""; 464 $row .= $showAttemptResults ? CGI::td($resultString) : "";
289 $row .= $answerMessage ? td($answerMessage) : ""; 465 $row .= $answerMessage ? CGI::td($answerMessage) : "";
290 push @tableRows, $row; 466 push @tableRows, $row;
291 } 467 }
292 468
293 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions"; 469 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions";
294 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 470 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
295 #my $message = i($problemResult->{msg});
296 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of " 471 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of "
297 . scalar @answerNames . " correct, for a score of $scorePercent."; 472 . 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); 473 return CGI::table({-border=>1}, CGI::Tr(\@tableRows)) . CGI::p($summary);
300} 474}
301 475
302sub viewOptions($\%\%\%) { 476sub viewOptions($) {
303 my $displayMode = shift; 477 my $self = shift;
478 my $displayMode = $self->{displayMode};
304 my %must = %{ shift() }; 479 my %must = %{ $self->{must} };
305 my %can = %{ shift() }; 480 my %can = %{ $self->{can} };
306 my %will = %{ shift() }; 481 my %will = %{ $self->{will} };
307 482
308 my $optionLine; 483 my $optionLine;
309 $can{showOldAnswers} and $optionLine .= join "", 484 $can{showOldAnswers} and $optionLine .= join "",
310 "Show: &nbsp;", 485 "Show: &nbsp;",
311 checkbox( 486 CGI::checkbox(
312 -name => "showOldAnswers", 487 -name => "showOldAnswers",
313 -checked => $will{showOldAnswers}, 488 -checked => $will{showOldAnswers},
314 -label => "Saved answers", 489 -label => "Saved answers",
315 ), "&nbsp;&nbsp;"; 490 ), "&nbsp;&nbsp;";
316 $can{showCorrectAnswers} and $optionLine .= join "", 491 $can{showCorrectAnswers} and $optionLine .= join "",
317 checkbox( 492 CGI::checkbox(
318 -name => "showCorrectAnswers", 493 -name => "showCorrectAnswers",
319 -checked => $will{showCorrectAnswers}, 494 -checked => $will{showCorrectAnswers},
320 -label => "Correct answers", 495 -label => "Correct answers",
321 ), "&nbsp;&nbsp;"; 496 ), "&nbsp;&nbsp;";
322 $can{showHints} and $optionLine .= join "", 497 $can{showHints} and $optionLine .= join "",
323 checkbox( 498 CGI::checkbox(
324 -name => "showHints", 499 -name => "showHints",
325 -checked => $will{showHints}, 500 -checked => $will{showHints},
326 -label => "Hints", 501 -label => "Hints",
327 ), "&nbsp;&nbsp;"; 502 ), "&nbsp;&nbsp;";
328 $can{showSolutions} and $optionLine .= join "", 503 $can{showSolutions} and $optionLine .= join "",
329 checkbox( 504 CGI::checkbox(
330 -name => "showSolutions", 505 -name => "showSolutions",
331 -checked => $will{showSolutions}, 506 -checked => $will{showSolutions},
332 -label => "Solutions", 507 -label => "Solutions",
333 ), "&nbsp;&nbsp;"; 508 ), "&nbsp;&nbsp;";
334 $optionLine and $optionLine .= join "", br(); 509 $optionLine and $optionLine .= join "", CGI::br();
335 510
336 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, 511 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
337 "View equations as: &nbsp;", 512 "View equations as: &nbsp;",
338 radio_group( 513 CGI::radio_group(
339 -name => "displayMode", 514 -name => "displayMode",
340 -values => ['plainText', 'formattedText', 'images'], 515 -values => ['plainText', 'formattedText', 'images'],
341 -default => $displayMode, 516 -default => $displayMode,
342 -labels => { 517 -labels => {
343 plainText => "plain text", 518 plainText => "plain text",
344 formattedText => "formatted text", 519 formattedText => "formatted text",
345 images => "images", 520 images => "images",
346 } 521 }
347 ), br(), 522 ), CGI::br(),
348 $optionLine, 523 $optionLine,
349 submit(-name=>"redisplay", -label=>"Redisplay Problem"), 524 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
350 ); 525 );
526}
527
528sub previewAnswer($$) {
529 my ($self, $answerResult) = @_;
530 my $ce = $self->{courseEnvironment};
531 my $user = $self->{user};
532 my $set = $self->{set};
533 my $problem = $self->{problem};
534
535 # how are we going to name this?
536 my $targetPathCommon = "/png/"
537 . $user->id . "."
538 . $set->id . "."
539 . $problem->id . "."
540 . $answerResult->{ans_name} . ".png";
541
542 # figure out where to put things
543 my $wd = tempdir("webwork-dvipng-XXXXXXXX", DIR => $ce->{courseDirs}->{html_temp});
544 my $latex = $ce->{externalPrograms}->{latex};
545 my $dvipng = $ce->{externalPrograms}->{dvipng};
546 my $tex = $answerResult->{preview_latex_string};
547 my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
548 # should use surePathToTmpFile, but we have to
549 # isolate it from the problem enivronment first
550 my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
551
552 # call dvipng to generate a preview
553 dvipng($wd, $latex, $dvipng, $tex, $targetPath);
554 if (-e $targetPath) {
555 return "<img src=\"$targetURL\" alt=\"$tex\" />";
556 } else {
557 return "<b>[math2img failed]</b>";
558 }
351} 559}
352 560
353##### permission queries ##### 561##### permission queries #####
354 562
355# this stuff should be abstracted out into the permissions system 563# this stuff should be abstracted out into the permissions system
… …
372 580
373sub canRecordAnswers($$$$$) { 581sub canRecordAnswers($$$$$) {
374 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; 582 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
375 my $permHigh = $permissionLevel > 0; 583 my $permHigh = $permissionLevel > 0;
376 my $timeOK = time >= $openDate && time <= $dueDate; 584 my $timeOK = time >= $openDate && time <= $dueDate;
377 my $attemptsOK = $attempts <= $maxAttempts; 585 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
378 return $permHigh || ($timeOK && $attemptsOK); 586 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK);
587 return $recordAnswers;
379} 588}
380 589
381sub mustRecordAnswers($) { 590sub mustRecordAnswers($) {
382 my ($permissionLevel) = @_; 591 my ($permissionLevel) = @_;
383 return $permissionLevel == 0; 592 return $permissionLevel == 0;
Legend:
Removed from v.434  
changed lines
  Added in v.634
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9