[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 431 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# 3. Latex2HTML massaging code
37# :) store submitted answers hash in database for sticky answers
38# :) 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) = @_; 43 my ($self, $setName, $problemNumber) = @_;
45 my $courseEnv = $self->{courseEnvironment}; 44 my $courseEnv = $self->{courseEnvironment};
46 my $r = $self->{r}; 45 my $r = $self->{r};
47 my $userName = $r->param('user'); 46 my $userName = $r->param('user');
48 47
49 # fix format of setName and problem
50 $setName =~ s/^set//;
51 $problemNumber =~ s/^prob//;
52
53 ##### database setup ##### 48 ##### database setup #####
54 # this should probably go in initialize() or whatever it's called
55 49
56 my $classlist = WeBWorK::DB::Classlist->new($courseEnv); 50 my $cldb = WeBWorK::DB::Classlist->new($courseEnv);
57 my $wwdb = WeBWorK::DB::WW->new($courseEnv); 51 my $wwdb = WeBWorK::DB::WW->new($courseEnv);
58 my $authdb = WeBWorK::DB::Auth->new($courseEnv); 52 my $authdb = WeBWorK::DB::Auth->new($courseEnv);
59 53
60 my $user = $classlist->getUser($userName); 54 my $user = $cldb->getUser($userName);
61 my $set = $wwdb->getSet($userName, $setName); 55 my $set = $wwdb->getSet($userName, $setName);
62 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 56 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
57 my $psvn = $wwdb->getPSVN($userName, $setName);
63 my $permissionLevel = $authdb->getPermissions($userName); 58 my $permissionLevel = $authdb->getPermissions($userName);
64 59
65 ##### form processing ##### 60 ##### form processing #####
66 61
67 # 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)
68 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 63 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
69 my $redisplay = $r->param("redisplay"); 64 my $redisplay = $r->param("redisplay");
70 my $submitAnswers = $r->param("submitAnswers"); 65 my $submitAnswers = $r->param("submitAnswers");
66 my $previewAnswers = $r->param("previewAnswers");
71 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?
72 my %want = ( 74 my %want = (
73 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, 75 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
74 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, 76 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
75 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, 77 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
76 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, 78 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
77 recordAnswers => $r->param("recordAnswers") || 1, 79 recordAnswers => $r->param("recordAnswers") || 1,
78 ); 80 );
79
80 # coerce form fields into CGI::Vars format
81 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
82
83 ##### permissions #####
84 81
85 # are certain options enforced? 82 # are certain options enforced?
86 my %must = ( 83 my %must = (
87 showOldAnswers => 0, 84 showOldAnswers => 0,
88 showCorrectAnswers => 0, 85 showCorrectAnswers => 0,
… …
102 # num_correct+num_incorrect+1 -- as this happens before updating $problem 99 # num_correct+num_incorrect+1 -- as this happens before updating $problem
103 ); 100 );
104 101
105 # final values for options 102 # final values for options
106 my %will; 103 my %will;
107 foreach(keys %must) { 104 foreach (keys %must) {
108 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 105 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
106 #warn "$_: can? $can{$_} want? $want{$_} must? $must{$_} will? $will{$_}\n";
109 } 107 }
110 108
111 ##### sticky answers ##### 109 ##### sticky answers #####
112 110
113 if (not $submitAnswers and $will{showOldAnswers}) { 111 if (not $submitAnswers and $will{showOldAnswers}) {
… …
118 116
119 ##### translation ##### 117 ##### translation #####
120 118
121 my $pg = WeBWorK::PG->new( 119 my $pg = WeBWorK::PG->new(
122 $courseEnv, 120 $courseEnv,
123 $r->param('user'), 121 $user,
124 $r->param('key'), 122 $r->param('key'),
125 $setName, 123 $set,
126 $problemNumber, 124 $problem,
125 $psvn,
126 $formFields,
127 { # translation options 127 { # translation options
128 displayMode => $displayMode, 128 displayMode => $displayMode,
129 showHints => $will{showHints}, 129 showHints => $will{showHints},
130 showSolutions => $will{showSolutions}, 130 showSolutions => $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
147 # massage LaTeX2HTML [TODO #3]
148 271
149 ##### answer processing ##### 272 ##### answer processing #####
150 273
151 # if answers were submitted: 274 # if answers were submitted:
152 if ($submitAnswers) { 275 if ($submitAnswers) {
… …
158 my $answerString = encodeAnswers(%answersToStore, 281 my $answerString = encodeAnswers(%answersToStore,
159 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); 282 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
160 $problem->last_answer($answerString); 283 $problem->last_answer($answerString);
161 $wwdb->setProblem($problem); 284 $wwdb->setProblem($problem);
162 285
163 # store score in DB if it makes sense 286 # store state in DB if it makes sense
164 if ($will{recordAnswers}) { 287 if ($will{recordAnswers}) {
165 # the grader makes a lot of decisions for us...
166 # all we have to do is update information from
167 # the 'state' hash in the $pg hash.
168 $problem->attempted(1); 288 $problem->attempted(1);
169 $problem->status($pg->{state}->{recorded_score}); 289 $problem->status($pg->{state}->{recorded_score});
170 $problem->num_correct($pg->{state}->{num_of_correct_ans}); 290 $problem->num_correct($pg->{state}->{num_of_correct_ans});
171 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 291 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
172 #warn "Would have stored the following:\n",
173 # $problem->toString, "\n";
174 $wwdb->setProblem($problem); 292 $wwdb->setProblem($problem);
175 } else { 293 # write to the transaction log, just to make sure
176 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 );
177 } 308 }
178 } 309 }
179 310
180 ##### output ##### 311 ##### output #####
181 312
182 # attempt summary 313 # attempt summary
183 if ($submitAnswers or $will{showCorrectAnswers}) { 314 if ($submitAnswers or $will{showCorrectAnswers}) {
184 # print this if user submitted answers OR requested correct answers 315 # print this if user submitted answers OR requested correct answers
185 print attemptResults($pg, $submitAnswers, $will{showCorrectAnswers}, 316 print $self->attemptResults($pg, $submitAnswers, $will{showCorrectAnswers},
186 $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
187 } 323 }
188 324
189 # score summary 325 # score summary
190 my $attempts = $problem->num_correct + $problem->num_incorrect; 326 my $attempts = $problem->num_correct + $problem->num_incorrect;
191 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 327 my $attemptsNoun = $attempts != 1 ? "times" : "time";
… …
197 $attemptsLeftNoun = "attempts"; 333 $attemptsLeftNoun = "attempts";
198 } else { 334 } else {
199 $attemptsLeft = $problem->max_attempts - $attempts; 335 $attemptsLeft = $problem->max_attempts - $attempts;
200 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 336 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
201 } 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 }
202 print p( 347 print CGI::p(
203 "You have attempted this problem $attempts $attemptsNoun.", br(), 348 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
204 $problem->attempted 349 $problem->attempted
205 ? "Your recorded score is $lastScore." . br() 350 ? "Your recorded score is $lastScore." . CGI::br()
206 : "", 351 : "",
207 "You have $attemptsLeft $attemptsLeftNoun remaining." 352 "You have $attemptsLeft $attemptsLeftNoun remaining.", CGI::br(),
353 $setClosedMessage,
208 ); 354 );
209 355
210 # BY THE WAY..........
211 # we have to figure out some way to tell the student if their NEW answer,
212 # on THIS attempt, has been recorded. however, this is decided in part by
213 # the grader, so is there any way for us to know? we can rule out several
214 # cases where the answer is NOT being recorded, because of things decided
215 # in &canRecordAnswers...
216
217 print hr(); 356 print CGI::hr();
218 357
219 # main form 358 # main form
220 print 359 print
221 startform("POST", $r->uri), 360 CGI::startform("POST", $r->uri),
222 $self->hidden_authen_fields, 361 $self->hidden_authen_fields,
362 $self->viewOptions,
223 p(i($pg->{result}->{msg})), 363 CGI::p(CGI::i($pg->{result}->{msg})),
224 p($pg->{body_text}), 364 CGI::p($pg->{body_text}),
365 CGI::p(
225 p(submit(-name=>"submitAnswers", -label=>"Submit Answers")), 366 CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers"),
226 viewOptions($displayMode, \%must, \%can, \%will), 367 CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers"),
368 ),
227 endform(), 369 CGI::endform();
228 hr(); 370
371 # warning output
372 if ($pg->{warnings} ne "") {
373 print CGI::hr(), warningOutput($pg->{warnings});
374 }
229 375
230 # debugging stuff 376 # debugging stuff
231 print 377 #print
378 # CGI::hr(),
232 h2("debugging information"), 379 # CGI::h2("debugging information"),
233 h3("form fields"), 380 # CGI::h3("form fields"),
234 ref2string($formFields), 381 # ref2string($self->{formFields}),
235 h3("user object"), 382 # CGI::h3("user object"),
236 ref2string($user), 383 # ref2string($self->{user}),
237 h3("set object"), 384 # CGI::h3("set object"),
238 ref2string($set), 385 # ref2string($set),
239 h3("problem object"), 386 # CGI::h3("problem object"),
240 ref2string($problem), 387 # ref2string($problem),
241 h3("PG object"), 388 # CGI::h3("PG object"),
242 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 389 # ref2string($pg, {'WeBWorK::PG::Translator' => 1});
243 390
244 return ""; 391 return "";
245} 392}
246 393
247##### output utilities ##### 394##### output utilities #####
248 395
396# this is used by ProblemSet.pm too, so don't fuck it up
249sub translationError($$) { 397sub translationError($$) {
250 my ($error, $details) = @_; 398 my ($error, $details) = @_;
251 return 399 return
400 CGI::h2("Software Error"),
252 p(<<EOF), 401 CGI::p(<<EOF),
253WeBWorK has encountered a software error while attempting to process this problem. 402WeBWorK has encountered a software error while attempting to process this problem.
254It is likely that there is an error in the problem itself. 403It is likely that there is an error in the problem itself.
255If 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.
256If 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.
257EOF 406EOF
258 h3("Error messages"), blockquote(pre($error)), 407 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)),
259 h3("Error context"), blockquote(pre($details)); 408 CGI::h3("Error context"), CGI::blockquote(CGI::pre($details));
260} 409}
261 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
262sub attemptResults($$$) { 428sub attemptResults($$$$$) {
429 my $self = shift;
263 my $pg = shift; 430 my $pg = shift;
264 my $showAttemptAnswers = shift; 431 my $showAttemptAnswers = shift;
265 my $showCorrectAnswers = shift; 432 my $showCorrectAnswers = shift;
266 my $showAttemptResults = $showAttemptAnswers && shift; 433 my $showAttemptResults = $showAttemptAnswers && shift;
267 my $problemResult = $pg->{result}; # the overall result of the problem 434 my $problemResult = $pg->{result}; # the overall result of the problem
268 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 435 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
269 436
270 my $header = th("answer"); 437 my $header = CGI::th("answer");
271 $header .= $showAttemptAnswers ? th("attempt") : ""; 438 $header .= $showAttemptAnswers ? CGI::th("attempt") : "";
439 $header .= $showAttemptAnswers ? CGI::th("preview") : "";
272 $header .= $showCorrectAnswers ? th("correct") : ""; 440 $header .= $showCorrectAnswers ? CGI::th("correct") : "";
273 $header .= $showAttemptResults ? th("result") : ""; 441 $header .= $showAttemptResults ? CGI::th("result") : "";
274 $header .= $showAttemptAnswers ? th("messages") : ""; 442 $header .= $showAttemptAnswers ? CGI::th("messages") : "";
275 my @tableRows = ( $header ); 443 my @tableRows = ( $header );
276 my $numCorrect; 444 my $numCorrect;
277 foreach my $name (@answerNames) { 445 foreach my $name (@answerNames) {
278 my $answerResult = $pg->{answers}->{$name}; 446 my $answerResult = $pg->{answers}->{$name};
279 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 447 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
448 my $preview = $self->previewAnswer($answerResult);
280 my $correctAnswer = $answerResult->{correct_ans}; 449 my $correctAnswer = $answerResult->{correct_ans};
281 my $answerScore = $answerResult->{score}; 450 my $answerScore = $answerResult->{score};
282 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; 451 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : "";
283 452
284 $numCorrect += $answerScore > 0; 453 $numCorrect += $answerScore > 0;
285 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 454 my $resultString = $answerScore ? "correct" : "incorrect";
286 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
287 my $row = td($name); 460 my $row = CGI::td($name);
288 $row .= $showAttemptAnswers ? td($studentAnswer) : ""; 461 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
462 $row .= $showAttemptAnswers ? CGI::td($preview) : "";
289 $row .= $showCorrectAnswers ? td($correctAnswer) : ""; 463 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
290 $row .= $showAttemptResults ? td($resultString) : ""; 464 $row .= $showAttemptResults ? CGI::td($resultString) : "";
291 $row .= $answerMessage ? td($answerMessage) : ""; 465 $row .= $answerMessage ? CGI::td($answerMessage) : "";
292 push @tableRows, $row; 466 push @tableRows, $row;
293 } 467 }
294 468
295 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions"; 469 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions";
296 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 470 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
297 #my $message = i($problemResult->{msg});
298 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of " 471 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of "
299 . scalar @answerNames . " correct, for a score of $scorePercent."; 472 . scalar @answerNames . " correct, for a score of $scorePercent.";
300 #return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary);
301 return table({-border=>1}, Tr(\@tableRows)) . p($summary); 473 return CGI::table({-border=>1}, CGI::Tr(\@tableRows)) . CGI::p($summary);
302} 474}
303 475
304sub viewOptions($\%\%\%) { 476sub viewOptions($) {
305 my $displayMode = shift; 477 my $self = shift;
478 my $displayMode = $self->{displayMode};
306 my %must = %{ shift() }; 479 my %must = %{ $self->{must} };
307 my %can = %{ shift() }; 480 my %can = %{ $self->{can} };
308 my %will = %{ shift() }; 481 my %will = %{ $self->{will} };
309 482
310 my $optionLine; 483 my $optionLine;
311 $can{showOldAnswers} and $optionLine .= join "", 484 $can{showOldAnswers} and $optionLine .= join "",
312 "Show: &nbsp;", 485 "Show: &nbsp;",
313 checkbox( 486 CGI::checkbox(
314 -name => "showOldAnswers", 487 -name => "showOldAnswers",
315 -checked => $will{showOldAnswers}, 488 -checked => $will{showOldAnswers},
316 -label => "Saved answers", 489 -label => "Saved answers",
317 ), "&nbsp;&nbsp;"; 490 ), "&nbsp;&nbsp;";
318 $can{showCorrectAnswers} and $optionLine .= join "", 491 $can{showCorrectAnswers} and $optionLine .= join "",
319 checkbox( 492 CGI::checkbox(
320 -name => "showCorrectAnswers", 493 -name => "showCorrectAnswers",
321 -checked => $will{showCorrectAnswers}, 494 -checked => $will{showCorrectAnswers},
322 -label => "Correct answers", 495 -label => "Correct answers",
323 ), "&nbsp;&nbsp;"; 496 ), "&nbsp;&nbsp;";
324 $can{showHints} and $optionLine .= join "", 497 $can{showHints} and $optionLine .= join "",
325 checkbox( 498 CGI::checkbox(
326 -name => "showHints", 499 -name => "showHints",
327 -checked => $will{showHints}, 500 -checked => $will{showHints},
328 -label => "Hints", 501 -label => "Hints",
329 ), "&nbsp;&nbsp;"; 502 ), "&nbsp;&nbsp;";
330 $can{showSolutions} and $optionLine .= join "", 503 $can{showSolutions} and $optionLine .= join "",
331 checkbox( 504 CGI::checkbox(
332 -name => "showSolutions", 505 -name => "showSolutions",
333 -checked => $will{showSolutions}, 506 -checked => $will{showSolutions},
334 -label => "Solutions", 507 -label => "Solutions",
335 ), "&nbsp;&nbsp;"; 508 ), "&nbsp;&nbsp;";
336 $optionLine and $optionLine .= join "", br(); 509 $optionLine and $optionLine .= join "", CGI::br();
337 510
338 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, 511 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
339 "View equations as: &nbsp;", 512 "View equations as: &nbsp;",
340 radio_group( 513 CGI::radio_group(
341 -name => "displayMode", 514 -name => "displayMode",
342 -values => ['plainText', 'formattedText', 'images'], 515 -values => ['plainText', 'formattedText', 'images'],
343 -default => $displayMode, 516 -default => $displayMode,
344 -labels => { 517 -labels => {
345 plainText => "plain text", 518 plainText => "plain text",
346 formattedText => "formatted text", 519 formattedText => "formatted text",
347 images => "images", 520 images => "images",
348 } 521 }
349 ), br(), 522 ), CGI::br(),
350 $optionLine, 523 $optionLine,
351 submit(-name=>"redisplay", -label=>"Redisplay Problem"), 524 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
352 ); 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 }
353} 559}
354 560
355##### permission queries ##### 561##### permission queries #####
356 562
357# this stuff should be abstracted out into the permissions system 563# this stuff should be abstracted out into the permissions system
… …
374 580
375sub canRecordAnswers($$$$$) { 581sub canRecordAnswers($$$$$) {
376 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; 582 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
377 my $permHigh = $permissionLevel > 0; 583 my $permHigh = $permissionLevel > 0;
378 my $timeOK = time >= $openDate && time <= $dueDate; 584 my $timeOK = time >= $openDate && time <= $dueDate;
379 my $attemptsOK = $attempts <= $maxAttempts; 585 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
380 return $permHigh || ($timeOK && $attemptsOK); 586 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK);
587 return $recordAnswers;
381} 588}
382 589
383sub mustRecordAnswers($) { 590sub mustRecordAnswers($) {
384 my ($permissionLevel) = @_; 591 my ($permissionLevel) = @_;
385 return $permissionLevel == 0; 592 return $permissionLevel == 0;
Legend:
Removed from v.431  
changed lines
  Added in v.634
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9