[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 476 Revision 755
1################################################################################ 1################################################################################
2# WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester 2# WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
3# $Id$ 3# $Id$
4################################################################################ 4################################################################################
5 5
6package WeBWorK::ContentGenerator::Problem; 6package WeBWorK::ContentGenerator::Problem;
7 7
… …
13 13
14use strict; 14use strict;
15use warnings; 15use warnings;
16use base qw(WeBWorK::ContentGenerator); 16use base qw(WeBWorK::ContentGenerator);
17use CGI qw(); 17use CGI qw();
18use File::Temp qw(tempdir);
18use WeBWorK::Form; 19use WeBWorK::Form;
19use WeBWorK::PG; 20use WeBWorK::PG;
21use WeBWorK::PG::IO;
20use WeBWorK::Utils qw(ref2string encodeAnswers decodeAnswers); 22use WeBWorK::Utils qw(writeLog encodeAnswers decodeAnswers ref2string);
21
22# TODO:
23# 7. make warnings work
24 23
25############################################################ 24############################################################
26# 25#
27# user 26# user
27# effectiveUser
28# key 28# key
29# 29#
30# displayMode 30# displayMode
31# showOldAnswers 31# showOldAnswers
32# showCorrectAnswers 32# showCorrectAnswers
… …
43sub pre_header_initialize { 43sub pre_header_initialize {
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 $cldb = 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 = $cldb->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);
60 my $psvn = $wwdb->getPSVN($effectiveUserName, $setName);
62 my $permissionLevel = $authdb->getPermissions($userName); 61 my $permissionLevel = $authdb->getPermissions($userName);
63 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
64 ##### form processing ##### 74 ##### form processing #####
65 75
66 # 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)
67 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 77 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
68 my $redisplay = $r->param("redisplay"); 78 my $redisplay = $r->param("redisplay");
69 my $submitAnswers = $r->param("submitAnswers"); 79 my $submitAnswers = $r->param("submitAnswers");
80 my $checkAnswers = $r->param("checkAnswers");
81 my $previewAnswers = $r->param("previewAnswers");
70 82
71 # coerce form fields into CGI::Vars format 83 # coerce form fields into CGI::Vars format
72 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 84 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
73 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
74 ##### permissions ##### 93 ##### permissions #####
94
95 # are we allowed to view this problem?
96 $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0;
97 return unless $self->{isOpen};
75 98
76 # what does the user want to do? 99 # what does the user want to do?
77 my %want = ( 100 my %want = (
78 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, 101 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
79 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, 102 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
80 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, 103 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
81 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, 104 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
82 recordAnswers => $r->param("recordAnswers") || 1, 105 recordAnswers => $submitAnswers,
106 checkAnswers => $checkAnswers,
83 ); 107 );
84 108
85 # are certain options enforced? 109 # are certain options enforced?
86 my %must = ( 110 my %must = (
87 showOldAnswers => 0, 111 showOldAnswers => 0,
88 showCorrectAnswers => 0, 112 showCorrectAnswers => 0,
89 showHints => 0, 113 showHints => 0,
90 showSolutions => 0, 114 showSolutions => 0,
91 recordAnswers => mustRecordAnswers($permissionLevel), 115 recordAnswers => mustRecordAnswers($permissionLevel),
116 checkAnswers => 0,
92 ); 117 );
93 118
94 # does the user have permission to use certain options? 119 # does the user have permission to use certain options?
95 my %can = ( 120 my %can = (
96 showOldAnswers => 1, 121 showOldAnswers => 1,
97 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date), 122 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),
98 showHints => 1, 123 showHints => 1,
99 showSolutions => 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
100 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, 126 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
101 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), 127 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
102 # num_correct+num_incorrect+1 -- as this happens before updating $problem 128 checkAnswers => canCheckAnswers($permissionLevel, $set->open_date,
129 $set->due_date, $set->answer_date, $problem->max_attempts,
130 $problem->num_correct + $problem->num_incorrect + 1),
103 ); 131 );
104 132
105 # final values for options 133 # final values for options
106 my %will; 134 my %will;
107 foreach(keys %must) { 135 foreach (keys %must) {
108 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 136 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
109 } 137 }
110 138
111 ##### sticky answers ##### 139 ##### sticky answers #####
112 140
… …
118 146
119 ##### translation ##### 147 ##### translation #####
120 148
121 my $pg = WeBWorK::PG->new( 149 my $pg = WeBWorK::PG->new(
122 $courseEnv, 150 $courseEnv,
123 $r->param('user'), 151 $effectiveUser,
124 $r->param('key'), 152 $r->param('key'),
125 $setName, 153 $set,
126 $problemNumber, 154 $problem,
155 $psvn,
156 $formFields,
127 { # translation options 157 { # translation options
128 displayMode => $displayMode, 158 displayMode => $displayMode,
129 showHints => $will{showHints}, 159 showHints => $will{showHints},
130 showSolutions => $will{showSolutions}, 160 showSolutions => $will{showSolutions},
131 refreshMath2img => $will{showHints} || $will{showSolutions}, 161 refreshMath2img => $will{showHints} || $will{showSolutions},
132 # try leaving processAnswers on all the time? 162 processAnswers => 1,
133 processAnswers => 1, #$submitAnswers ? 1 : 0,
134 }, 163 },
135 $formFields
136 ); 164 );
137 165
166 ##### fix hint/solution options #####
167
168 $can{showHints} &&= $pg->{flags}->{hintExists};
169 $can{showSolutions} &&= $pg->{flags}->{solutionExists};
170
138 ##### store fields ##### 171 ##### store fields #####
139
140 $self->{cldb} = $cldb;
141 $self->{wwdb} = $wwdb;
142 $self->{authdb} = $authdb;
143
144 $self->{user} = $user;
145 $self->{set} = $set;
146 $self->{problem} = $problem;
147 $self->{permissionLevel} = $permissionLevel;
148
149 $self->{displayMode} = $displayMode;
150 $self->{redisplay} = $redisplay;
151 $self->{submitAnswers} = $submitAnswers;
152 $self->{formFields} = $formFields;
153 172
154 $self->{want} = \%want; 173 $self->{want} = \%want;
155 $self->{must} = \%must; 174 $self->{must} = \%must;
156 $self->{can} = \%can; 175 $self->{can} = \%can;
157 $self->{will} = \%will; 176 $self->{will} = \%will;
158 177
159 $self->{pg} = $pg; 178 $self->{pg} = $pg;
160} 179}
161 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
162#sub header { 193sub head {
163# # *** we need to print $pg->{header_text} here! 194 my $self = shift;
164#} 195 return "" unless $self->{isOpen};
196 return $self->{pg}->{head_text} if $self->{pg}->{head_text};
197}
165 198
166sub path { 199sub path {
167 my $self = shift; 200 my $self = shift;
168 my $args = $_[-1]; 201 my $args = $_[-1];
169 my $setName = $self->{set}->id; 202 my $setName = $self->{set}->id;
… …
173 my $root = $ce->{webworkURLs}->{root}; 206 my $root = $ce->{webworkURLs}->{root};
174 my $courseName = $ce->{courseName}; 207 my $courseName = $ce->{courseName};
175 return $self->pathMacro($args, 208 return $self->pathMacro($args,
176 "Home" => "$root", 209 "Home" => "$root",
177 $courseName => "$root/$courseName", 210 $courseName => "$root/$courseName",
178 $setName => "$root/$courseName/set$setName", 211 $setName => "$root/$courseName/$setName",
179 "Problem $problemNumber" => "", 212 "Problem $problemNumber" => "",
180 ); 213 );
181} 214}
182 215
183sub siblings { 216sub siblings {
… …
187 220
188 my $ce = $self->{courseEnvironment}; 221 my $ce = $self->{courseEnvironment};
189 my $root = $ce->{webworkURLs}->{root}; 222 my $root = $ce->{webworkURLs}->{root};
190 my $courseName = $ce->{courseName}; 223 my $courseName = $ce->{courseName};
191 224
225 print CGI::strong("Problems"), CGI::br();
226
192 my $wwdb = $self->{wwdb}; 227 my $wwdb = $self->{wwdb};
193 my $user = $self->{r}->param("user"); 228 my $effectiveUser = $self->{r}->param("effectiveUser");
194 my @problems; 229 my @problems;
195 push @problems, $wwdb->getProblem($user, $setName, $_) 230 push @problems, $wwdb->getProblem($effectiveUser, $setName, $_)
196 foreach ($wwdb->getProblems($user, $setName)); 231 foreach ($wwdb->getProblems($effectiveUser, $setName));
197 foreach my $problem (sort { $a->id <=> $b->id } @problems) { 232 foreach my $problem (sort { $a->id <=> $b->id } @problems) {
198 print CGI::a({-href=>"$root/$courseName/$setName/".$problem->id."/?" 233 print CGI::a({-href=>"$root/$courseName/$setName/".$problem->id."/?"
199 . $self->url_authen_args}, "Problem ".$problem->id), CGI::br(); 234 . $self->url_authen_args . "&displayMode=" . $self->{displayMode}},
235 "Problem ".$problem->id), CGI::br();
200 } 236 }
201} 237}
202 238
203sub nav { 239sub nav {
204 my $self = shift; 240 my $self = shift;
… …
208 244
209 my $ce = $self->{courseEnvironment}; 245 my $ce = $self->{courseEnvironment};
210 my $root = $ce->{webworkURLs}->{root}; 246 my $root = $ce->{webworkURLs}->{root};
211 my $courseName = $ce->{courseName}; 247 my $courseName = $ce->{courseName};
212 248
213 my $wwdb = $self->{wwdb}; 249 my $wwdb = $self->{wwdb};
214 my $user = $self->{r}->param("user"); 250 my $effectiveUser = $self->{r}->param("effectiveUser");
251 my $tail = "&displayMode=".$self->{displayMode};
215 252
216 my @links = ("Problem List" => "$root/$courseName/set$setName"); 253 my @links = ("Problem List" , "$root/$courseName/$setName", "ProbList");
217 254
218 my $prevProblem = $wwdb->getProblem($user, $setName, $problemNumber-1); 255 my $prevProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber-1);
219 my $nextProblem = $wwdb->getProblem($user, $setName, $problemNumber+1); 256 my $nextProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber+1);
220 unshift @links, "Previous Problem" => "$root/$courseName/set$setName/prob".$prevProblem->id 257 unshift @links, "Previous Problem" , ($prevProblem
221 if $prevProblem; 258 ? "$root/$courseName/$setName/".$prevProblem->id
222 push @links, "Next Problem" => "$root/$courseName/set$setName/prob".$nextProblem->id 259 : "") , "Prev";
223 if $nextProblem; 260 push @links, "Next Problem" , ($nextProblem
261 ? "$root/$courseName/$setName/".$nextProblem->id
262 : "") , "Next";
224 263
225 return $self->navMacro($args, @links); 264 return $self->navMacro($args, $tail, @links);
226} 265}
227 266
228sub title { 267sub title {
229 my $self = shift; 268 my $self = shift;
230 my $setName = $self->{set}->id; 269 my $setName = $self->{set}->id;
… …
234} 273}
235 274
236sub body { 275sub body {
237 my $self = shift; 276 my $self = shift;
238 277
239 #$self->prepare(@_); 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};
240 280
241 # unpack some useful variables 281 # unpack some useful variables
242 my $r = $self->{r}; 282 my $r = $self->{r};
243 my $wwdb = $self->{wwdb}; 283 my $wwdb = $self->{wwdb};
244 my $set = $self->{set}; 284 my $set = $self->{set};
245 my $problem = $self->{problem}; 285 my $problem = $self->{problem};
246 my $permissionLevel = $self->{permissionLevel}; 286 my $permissionLevel = $self->{permissionLevel};
247 my $submitAnswers = $self->{submitAnswers}; 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} };
248 my %will = %{ $self->{will} }; 293 my %will = %{ $self->{will} };
249 my $pg = $self->{pg}; 294 my $pg = $self->{pg};
250 295
251 ##### translation errors? ##### 296 ##### translation errors? #####
252 297
253 if ($pg->{flags}->{error_flag}) { 298 if ($pg->{flags}->{error_flag}) {
254 print translationError($pg->{errors}, $pg->{body_text}); 299 return $self->errorOutput($pg->{errors}, $pg->{body_text});
255 return "";
256 } 300 }
257 301
258 ##### answer processing ##### 302 ##### answer processing #####
259 303
260 # if answers were submitted: 304 # if answers were submitted:
… …
274 $problem->attempted(1); 318 $problem->attempted(1);
275 $problem->status($pg->{state}->{recorded_score}); 319 $problem->status($pg->{state}->{recorded_score});
276 $problem->num_correct($pg->{state}->{num_of_correct_ans}); 320 $problem->num_correct($pg->{state}->{num_of_correct_ans});
277 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 321 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
278 $wwdb->setProblem($problem); 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 );
279 } 338 }
280 } 339 }
281 340
282 ##### output ##### 341 ##### output #####
283 342 print CGI::start_div({class=>"problemHeader"});
284 # attempt summary 343 # attempt summary
285 if ($submitAnswers or $will{showCorrectAnswers}) { 344 if ($submitAnswers or $will{showCorrectAnswers}) {
286 # print this if user submitted answers OR requested correct answers 345 # print this if user submitted answers OR requested correct answers
287 print attemptResults($pg, $submitAnswers, $will{showCorrectAnswers}, 346 print $self->attemptResults($pg, $submitAnswers,
347 $will{showCorrectAnswers},
288 $pg->{flags}->{showPartialCorrectAnswers}); 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
289 } 363 }
290 364
365 print CGI::end_div();
366
367 print CGI::start_div({class=>"problem"});
368 #print CGI::hr();
369 # main form
370 print
371 CGI::startform("POST", $r->uri),
372 $self->hidden_authen_fields,
373 CGI::p($pg->{body_text}),
374 CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})),
375 CGI::p(
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 );
291 # score summary 387 # score summary
292 my $attempts = $problem->num_correct + $problem->num_incorrect; 388 my $attempts = $problem->num_correct + $problem->num_incorrect;
293 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 389 my $attemptsNoun = $attempts != 1 ? "times" : "time";
294 my $lastScore = int ($problem->status * 100) . "%"; 390 my $lastScore = int ($problem->status * 100) . "%";
295 my ($attemptsLeft, $attemptsLeftNoun); 391 my ($attemptsLeft, $attemptsLeftNoun);
… …
299 $attemptsLeftNoun = "attempts"; 395 $attemptsLeftNoun = "attempts";
300 } else { 396 } else {
301 $attemptsLeft = $problem->max_attempts - $attempts; 397 $attemptsLeft = $problem->max_attempts - $attempts;
302 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 398 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
303 } 399 }
400
401 my $setClosed = 0;
304 my $setClosedMessage; 402 my $setClosedMessage;
305 if (time < $set->open_date or time > $set->due_date) { 403 if (time < $set->open_date or time > $set->due_date) {
404 $setClosed = 1;
306 $setClosedMessage = "This problem set is closed."; 405 $setClosedMessage = "This problem set is closed.";
307 if ($permissionLevel > 0) { 406 if ($permissionLevel > 0) {
308 $setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded."; 407 $setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded.";
309 } else { 408 } else {
310 $setClosedMessage .= " Additional attempts will not be recorded."; 409 $setClosedMessage .= " Additional attempts will not be recorded.";
… …
313 print CGI::p( 412 print CGI::p(
314 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), 413 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
315 $problem->attempted 414 $problem->attempted
316 ? "Your recorded score is $lastScore." . CGI::br() 415 ? "Your recorded score is $lastScore." . CGI::br()
317 : "", 416 : "",
318 "You have $attemptsLeft $attemptsLeftNoun remaining.", CGI::br(), 417 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
319 $setClosedMessage,
320 ); 418 );
321 419
322 # BY THE WAY.......... 420
323 # we have to figure out some way to tell the student if their NEW answer,
324 # on THIS attempt, has been recorded. however, this is decided in part by
325 # the grader, so is there any way for us to know? we can rule out several
326 # cases where the answer is NOT being recorded, because of things decided
327 # in &canRecordAnswers...
328
329 print CGI::hr();
330
331 # main form
332 print 421 print
422 $self->viewOptions(),
423 CGI::endform();
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
333 CGI::startform("POST", $r->uri), 432 CGI::startform("POST", $feedbackURL),
334 $self->hidden_authen_fields, 433 $self->hidden_authen_fields,
335 CGI::p(CGI::i($pg->{result}->{msg})), 434 CGI::hidden("module", __PACKAGE__),
336 CGI::p($pg->{body_text}), 435 CGI::hidden("set", $set->id),
337 CGI::p(CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers")), 436 CGI::hidden("problem", $problem->id),
338 $self->viewOptions, 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 ),
339 CGI::endform(); 445 CGI::endform();
340 446
447 # warning output
448 if ($pg->{warnings} ne "") {
449 print CGI::hr(), $self->warningOutput($pg->{warnings});
450 }
451
341 # debugging stuff 452 # debugging stuff
453 if (0) {
342 #print 454 print
343 # hr(), 455 CGI::hr(),
344 # h2("debugging information"), 456 CGI::h2("debugging information"),
345 # h3("form fields"), 457 CGI::h3("form fields"),
346 # ref2string($formFields), 458 ref2string($self->{formFields}),
347 # h3("user object"), 459 CGI::h3("user object"),
348 # ref2string($user), 460 ref2string($self->{user}),
349 # h3("set object"), 461 CGI::h3("set object"),
350 # ref2string($set), 462 ref2string($set),
351 # h3("problem object"), 463 CGI::h3("problem object"),
352 # ref2string($problem), 464 ref2string($problem),
353 # h3("PG object"), 465 CGI::h3("PG object"),
354 # ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 466 ref2string($pg, {'WeBWorK::PG::Translator' => 1});
467 }
355 468
356 return ""; 469 return "";
357} 470}
358 471
359##### output utilities ##### 472##### output utilities #####
360 473
361sub translationError($$) {
362 my ($error, $details) = @_;
363 return
364 CGI::h2("Software Error"),
365 CGI::p(<<EOF),
366WeBWorK has encountered a software error while attempting to process this problem.
367It is likely that there is an error in the problem itself.
368If you are a student, contact your professor to have the error corrected.
369If you are a professor, please consut the error output below for more informaiton.
370EOF
371 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)),
372 CGI::h3("Error context"), CGI::blockquote(CGI::pre($details));
373}
374
375sub attemptResults($$$) { 474sub attemptResults($$$$$$) {
475 my $self = shift;
376 my $pg = shift; 476 my $pg = shift;
377 my $showAttemptAnswers = shift; 477 my $showAttemptAnswers = shift;
378 my $showCorrectAnswers = shift; 478 my $showCorrectAnswers = shift;
379 my $showAttemptResults = $showAttemptAnswers && shift; 479 my $showAttemptResults = $showAttemptAnswers && shift;
480 my $showSummary = shift;
481 my $showAttemptPreview = shift || 0;
380 my $problemResult = $pg->{result}; # the overall result of the problem 482 my $problemResult = $pg->{result}; # the overall result of the problem
381 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 483 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
382 484
485 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
486
383 my $header = CGI::th("answer"); 487 my $header = CGI::th("Part");
384 $header .= $showAttemptAnswers ? CGI::th("attempt") : ""; 488 $header .= $showAttemptAnswers ? CGI::th("Entered") : "";
489 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : "";
385 $header .= $showCorrectAnswers ? CGI::th("correct") : ""; 490 $header .= $showCorrectAnswers ? CGI::th("Correct") : "";
386 $header .= $showAttemptResults ? CGI::th("result") : ""; 491 $header .= $showAttemptResults ? CGI::th("Result") : "";
387 $header .= $showAttemptAnswers ? CGI::th("messages") : ""; 492 $header .= $showMessages ? CGI::th("messages") : "";
388 my @tableRows = ( $header ); 493 my @tableRows = ( $header );
389 my $numCorrect; 494 my $numCorrect;
390 foreach my $name (@answerNames) { 495 foreach my $name (@answerNames) {
391 my $answerResult = $pg->{answers}->{$name}; 496 my $answerResult = $pg->{answers}->{$name};
392 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 : "");
393 my $correctAnswer = $answerResult->{correct_ans}; 501 my $correctAnswer = $answerResult->{correct_ans};
394 my $answerScore = $answerResult->{score}; 502 my $answerScore = $answerResult->{score};
395 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; 503 my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
396 504
397 $numCorrect += $answerScore > 0; 505 $numCorrect += $answerScore > 0;
398 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 506 my $resultString = $answerScore ? "correct" : "incorrect";
507
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//;
399 511
400 my $row = CGI::td($name); 512 my $row = CGI::td($name);
401 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : ""; 513 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
514 $row .= $showAttemptPreview ? CGI::td($preview) : "";
402 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : ""; 515 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
403 $row .= $showAttemptResults ? CGI::td($resultString) : ""; 516 $row .= $showAttemptResults ? CGI::td($resultString) : "";
404 $row .= $answerMessage ? CGI::td($answerMessage) : ""; 517 $row .= $answerMessage ? CGI::td($answerMessage) : "";
405 push @tableRows, $row; 518 push @tableRows, $row;
406 } 519 }
407 520
408 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions"; 521 my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
409 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 522 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
410 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of " 523 my $summary = "On this attempt, you answered $numCorrect out of "
411 . scalar @answerNames . " correct, for a score of $scorePercent."; 524 . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
412 return CGI::table({-border=>1}, CGI::Tr(\@tableRows)) . CGI::p($summary); 525 return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . ($showSummary ? CGI::p($summary) : "");
413} 526}
414 527
415sub viewOptions($) { 528sub viewOptions($) {
416 my $self = shift; 529 my $self = shift;
417 my $displayMode = $self->{displayMode}; 530 my $displayMode = $self->{displayMode};
… …
462 $optionLine, 575 $optionLine,
463 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"), 576 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
464 ); 577 );
465} 578}
466 579
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
467##### permission queries ##### 639##### permission queries #####
468 640
469# this stuff should be abstracted out into the permissions system 641# this stuff should be abstracted out into the permissions system
470# however, the permission system only knows about things in the 642# however, the permission system only knows about things in the
471# course environment and the username. hmmm... 643# course environment and the username. hmmm...
… …
486 658
487sub canRecordAnswers($$$$$) { 659sub canRecordAnswers($$$$$) {
488 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; 660 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
489 my $permHigh = $permissionLevel > 0; 661 my $permHigh = $permissionLevel > 0;
490 my $timeOK = time >= $openDate && time <= $dueDate; 662 my $timeOK = time >= $openDate && time <= $dueDate;
491 my $attemptsOK = $attempts <= $maxAttempts; 663 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
492 return $permHigh || ($timeOK && $attemptsOK); 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);
493} 671}
494 672
495sub mustRecordAnswers($) { 673sub mustRecordAnswers($) {
496 my ($permissionLevel) = @_; 674 my ($permissionLevel) = @_;
497 return $permissionLevel == 0; 675 return $permissionLevel == 0;
Legend:
Removed from v.476  
changed lines
  Added in v.755
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9