| … | |
… | |
| 40 | # |
40 | # |
| 41 | ############################################################ |
41 | ############################################################ |
| 42 | |
42 | |
| 43 | sub pre_header_initialize { |
43 | sub pre_header_initialize { |
| 44 | my ($self, $setName, $problemNumber) = @_; |
44 | my ($self, $setName, $problemNumber) = @_; |
| 45 | my $courseEnv = $self->{courseEnvironment}; |
45 | my $courseEnv = $self->{ce}; |
| 46 | my $r = $self->{r}; |
46 | my $r = $self->{r}; |
| 47 | my $userName = $r->param('user'); |
47 | my $userName = $r->param('user'); |
| 48 | my $effectiveUserName = $r->param('effectiveUser'); |
48 | my $effectiveUserName = $r->param('effectiveUser'); |
| 49 | |
49 | |
| 50 | ##### database setup ##### |
50 | ##### database setup ##### |
| … | |
… | |
| 100 | my %want = ( |
100 | my %want = ( |
| 101 | showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, |
101 | showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, |
| 102 | showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, |
102 | showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, |
| 103 | showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, |
103 | showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, |
| 104 | showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, |
104 | showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, |
| 105 | #recordAnswers => $r->param("recordAnswers") || 1, |
|
|
| 106 | recordAnswers => $submitAnswers, |
105 | recordAnswers => $submitAnswers, |
|
|
106 | checkAnswers => $checkAnswers, |
| 107 | ); |
107 | ); |
| 108 | |
108 | |
| 109 | # are certain options enforced? |
109 | # are certain options enforced? |
| 110 | my %must = ( |
110 | my %must = ( |
| 111 | showOldAnswers => 0, |
111 | showOldAnswers => 0, |
| 112 | showCorrectAnswers => 0, |
112 | showCorrectAnswers => 0, |
| 113 | showHints => 0, |
113 | showHints => 0, |
| 114 | showSolutions => 0, |
114 | showSolutions => 0, |
| 115 | recordAnswers => mustRecordAnswers($permissionLevel), |
115 | recordAnswers => mustRecordAnswers($permissionLevel), |
|
|
116 | checkAnswers => 0, |
| 116 | ); |
117 | ); |
| 117 | |
118 | |
| 118 | # does the user have permission to use certain options? |
119 | # does the user have permission to use certain options? |
| 119 | my %can = ( |
120 | my %can = ( |
| 120 | showOldAnswers => 1, |
121 | showOldAnswers => 1, |
| 121 | showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date), |
122 | showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date), |
| 122 | showHints => 1, |
123 | showHints => 1, |
| 123 | showSolutions => canShowSolutions($permissionLevel, $set->answer_date), |
124 | showSolutions => canShowSolutions($permissionLevel, $set->answer_date), |
| 124 | recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, |
125 | recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, |
| 125 | $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), |
126 | $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), |
| 126 | # num_correct+num_incorrect+1 -- as this happens before updating $problem |
127 | # attempts=num_correct+num_incorrect+1, as this happens before updating $problem |
|
|
128 | checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date), |
| 127 | ); |
129 | ); |
| 128 | |
130 | |
| 129 | # final values for options |
131 | # final values for options |
| 130 | my %will; |
132 | my %will; |
| 131 | foreach (keys %must) { |
133 | foreach (keys %must) { |
| … | |
… | |
| 196 | my $self = shift; |
198 | my $self = shift; |
| 197 | my $args = $_[-1]; |
199 | my $args = $_[-1]; |
| 198 | my $setName = $self->{set}->id; |
200 | my $setName = $self->{set}->id; |
| 199 | my $problemNumber = $self->{problem}->id; |
201 | my $problemNumber = $self->{problem}->id; |
| 200 | |
202 | |
| 201 | my $ce = $self->{courseEnvironment}; |
203 | my $ce = $self->{ce}; |
| 202 | my $root = $ce->{webworkURLs}->{root}; |
204 | my $root = $ce->{webworkURLs}->{root}; |
| 203 | my $courseName = $ce->{courseName}; |
205 | my $courseName = $ce->{courseName}; |
| 204 | return $self->pathMacro($args, |
206 | return $self->pathMacro($args, |
| 205 | "Home" => "$root", |
207 | "Home" => "$root", |
| 206 | $courseName => "$root/$courseName", |
208 | $courseName => "$root/$courseName", |
| … | |
… | |
| 212 | sub siblings { |
214 | sub siblings { |
| 213 | my $self = shift; |
215 | my $self = shift; |
| 214 | my $setName = $self->{set}->id; |
216 | my $setName = $self->{set}->id; |
| 215 | my $problemNumber = $self->{problem}->id; |
217 | my $problemNumber = $self->{problem}->id; |
| 216 | |
218 | |
| 217 | my $ce = $self->{courseEnvironment}; |
219 | my $ce = $self->{ce}; |
| 218 | my $root = $ce->{webworkURLs}->{root}; |
220 | my $root = $ce->{webworkURLs}->{root}; |
| 219 | my $courseName = $ce->{courseName}; |
221 | my $courseName = $ce->{courseName}; |
| 220 | |
222 | |
| 221 | print CGI::strong("Problems"), CGI::br(); |
223 | print CGI::strong("Problems"), CGI::br(); |
| 222 | |
224 | |
| … | |
… | |
| 236 | my $self = shift; |
238 | my $self = shift; |
| 237 | my $args = $_[-1]; |
239 | my $args = $_[-1]; |
| 238 | my $setName = $self->{set}->id; |
240 | my $setName = $self->{set}->id; |
| 239 | my $problemNumber = $self->{problem}->id; |
241 | my $problemNumber = $self->{problem}->id; |
| 240 | |
242 | |
| 241 | my $ce = $self->{courseEnvironment}; |
243 | my $ce = $self->{ce}; |
| 242 | my $root = $ce->{webworkURLs}->{root}; |
244 | my $root = $ce->{webworkURLs}->{root}; |
| 243 | my $courseName = $ce->{courseName}; |
245 | my $courseName = $ce->{courseName}; |
| 244 | |
246 | |
| 245 | my $wwdb = $self->{wwdb}; |
247 | my $wwdb = $self->{wwdb}; |
| 246 | my $effectiveUser = $self->{r}->param("effectiveUser"); |
248 | my $effectiveUser = $self->{r}->param("effectiveUser"); |
| 247 | my $tail = "&displayMode=".$self->{displayMode}; |
249 | my $tail = "&displayMode=".$self->{displayMode}; |
| 248 | |
250 | |
| 249 | my @links = ("Problem List" => "$root/$courseName/$setName"); |
251 | my @links = ("Problem List" , "$root/$courseName/$setName", "navProbList"); |
| 250 | |
252 | |
| 251 | my $prevProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber-1); |
253 | my $prevProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber-1); |
| 252 | my $nextProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber+1); |
254 | my $nextProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber+1); |
| 253 | unshift @links, "Previous Problem" => $prevProblem |
255 | unshift @links, "Previous Problem" , ($prevProblem |
| 254 | ? "$root/$courseName/$setName/".$prevProblem->id |
256 | ? "$root/$courseName/$setName/".$prevProblem->id |
| 255 | : ""; |
257 | : "") , "navPrev"; |
| 256 | push @links, "Next Problem" => $nextProblem |
258 | push @links, "Next Problem" , ($nextProblem |
| 257 | ? "$root/$courseName/$setName/".$nextProblem->id |
259 | ? "$root/$courseName/$setName/".$nextProblem->id |
| 258 | : ""; |
260 | : "") , "navNext"; |
| 259 | |
261 | |
| 260 | return $self->navMacro($args, $tail, @links); |
262 | return $self->navMacro($args, $tail, @links); |
| 261 | } |
263 | } |
| 262 | |
264 | |
| 263 | sub title { |
265 | sub title { |
| … | |
… | |
| 269 | } |
271 | } |
| 270 | |
272 | |
| 271 | sub body { |
273 | sub body { |
| 272 | my $self = shift; |
274 | my $self = shift; |
| 273 | |
275 | |
| 274 | unless ($self->{isOpen}) { |
|
|
| 275 | return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open.")); |
276 | return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open.")) |
| 276 | } |
277 | unless $self->{isOpen}; |
| 277 | |
278 | |
| 278 | # unpack some useful variables |
279 | # unpack some useful variables |
| 279 | my $r = $self->{r}; |
280 | my $r = $self->{r}; |
| 280 | my $wwdb = $self->{wwdb}; |
281 | my $wwdb = $self->{wwdb}; |
| 281 | my $set = $self->{set}; |
282 | my $set = $self->{set}; |
| … | |
… | |
| 316 | $problem->status($pg->{state}->{recorded_score}); |
317 | $problem->status($pg->{state}->{recorded_score}); |
| 317 | $problem->num_correct($pg->{state}->{num_of_correct_ans}); |
318 | $problem->num_correct($pg->{state}->{num_of_correct_ans}); |
| 318 | $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); |
319 | $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); |
| 319 | $wwdb->setProblem($problem); |
320 | $wwdb->setProblem($problem); |
| 320 | # write to the transaction log, just to make sure |
321 | # write to the transaction log, just to make sure |
| 321 | writeLog($self->{courseEnvironment}, "transaction", |
322 | writeLog($self->{ce}, "transaction", |
| 322 | $problem->id."\t". |
323 | $problem->id."\t". |
| 323 | $problem->set_id."\t". |
324 | $problem->set_id."\t". |
| 324 | $problem->login_id."\t". |
325 | $problem->login_id."\t". |
| 325 | $problem->source_file."\t". |
326 | $problem->source_file."\t". |
| 326 | $problem->value."\t". |
327 | $problem->value."\t". |
| … | |
… | |
| 332 | $problem->num_correct."\t". |
333 | $problem->num_correct."\t". |
| 333 | $problem->num_incorrect |
334 | $problem->num_incorrect |
| 334 | ); |
335 | ); |
| 335 | } |
336 | } |
| 336 | } |
337 | } |
|
|
338 | # logging student answers |
|
|
339 | my $pastAnswerLog = undef; |
|
|
340 | if (defined( $self->{ce}->{webworkFiles}->{logs}->{'pastAnswerList'} )) { |
|
|
341 | |
|
|
342 | $pastAnswerLog = $self->{ce}->{webworkFiles}->{logs}->{'pastAnswerList'}; |
|
|
343 | |
|
|
344 | if ($submitAnswers and defined($pastAnswerLog) ) { |
|
|
345 | my $answerString = ""; |
|
|
346 | my %answerHash = %{ $pg->{answers} }; |
|
|
347 | $answerString = $answerString . $answerHash{$_}->{original_student_ans}."\t" |
|
|
348 | foreach (sort keys %answerHash); |
|
|
349 | writeLog($self->{ce}, "pastAnswerList", |
|
|
350 | '|'.$problem->login_id. |
|
|
351 | '|'.$problem->set_id. |
|
|
352 | '|'.$problem->id.'|'."\t". |
|
|
353 | time()."\t". |
|
|
354 | $answerString, |
|
|
355 | |
|
|
356 | ); |
|
|
357 | |
|
|
358 | } |
|
|
359 | |
|
|
360 | } |
|
|
361 | # end logging student answers |
| 337 | |
362 | |
| 338 | ##### output ##### |
363 | ##### output ##### |
| 339 | |
364 | print CGI::start_div({class=>"problemHeader"}); |
| 340 | # attempt summary |
365 | # attempt summary |
| 341 | if ($submitAnswers or $will{showCorrectAnswers}) { |
366 | if ($submitAnswers or $will{showCorrectAnswers}) { |
| 342 | # print this if user submitted answers OR requested correct answers |
367 | # print this if user submitted answers OR requested correct answers |
| 343 | print $self->attemptResults($pg, $submitAnswers, |
368 | print $self->attemptResults($pg, $submitAnswers, |
| 344 | $will{showCorrectAnswers}, |
369 | $will{showCorrectAnswers}, |
| 345 | $pg->{flags}->{showPartialCorrectAnswers}, 0); |
370 | $pg->{flags}->{showPartialCorrectAnswers}, 1, 0); |
| 346 | } elsif ($checkAnswers) { |
371 | } elsif ($checkAnswers) { |
| 347 | # print this if user previewed answers |
372 | # print this if user previewed answers |
| 348 | print $self->attemptResults($pg, 1, 0, 1, 0); |
373 | print $self->attemptResults($pg, 1, 0, 1, 1, 0); |
| 349 | # show attempt answers |
374 | # show attempt answers |
| 350 | # don't show correct answers |
375 | # don't show correct answers |
| 351 | # show attempt results (correctness) |
376 | # show attempt results (correctness) |
| 352 | # don't show attempt previews |
377 | # don't show attempt previews |
| 353 | } elsif ($previewAnswers) { |
378 | } elsif ($previewAnswers) { |
| 354 | # print this if user previewed answers |
379 | # print this if user previewed answers |
| 355 | print $self->attemptResults($pg, 1, 0, 0, 1); |
380 | print $self->attemptResults($pg, 1, 0, 0, 0, 1); |
| 356 | # show attempt answers |
381 | # show attempt answers |
| 357 | # don't show correct answers |
382 | # don't show correct answers |
| 358 | # don't show attempt results (correctness) |
383 | # don't show attempt results (correctness) |
| 359 | # show attempt previews |
384 | # show attempt previews |
| 360 | } |
385 | } |
| 361 | |
386 | |
|
|
387 | print CGI::end_div(); |
|
|
388 | |
|
|
389 | print CGI::start_div({class=>"problem"}); |
|
|
390 | #print CGI::hr(); |
|
|
391 | # main form |
|
|
392 | print |
|
|
393 | CGI::startform("POST", $r->uri), |
|
|
394 | $self->hidden_authen_fields, |
|
|
395 | CGI::p($pg->{body_text}), |
|
|
396 | CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})), |
|
|
397 | CGI::p( |
|
|
398 | ($can{recordAnswers} |
|
|
399 | ? CGI::submit(-name=>"submitAnswers", |
|
|
400 | -label=>"Submit Answers") |
|
|
401 | : ""), |
|
|
402 | ($can{checkAnswers} |
|
|
403 | ? CGI::submit(-name=>"checkAnswers", |
|
|
404 | -label=>"Check Answers") |
|
|
405 | : ""), |
|
|
406 | CGI::submit(-name=>"previewAnswers", |
|
|
407 | -label=>"Preview Answers"), |
|
|
408 | ); |
|
|
409 | print CGI::end_div(); |
|
|
410 | |
|
|
411 | print CGI::start_div({class=>"scoreSummary"}); |
| 362 | # score summary |
412 | # score summary |
| 363 | my $attempts = $problem->num_correct + $problem->num_incorrect; |
413 | my $attempts = $problem->num_correct + $problem->num_incorrect; |
| 364 | my $attemptsNoun = $attempts != 1 ? "times" : "time"; |
414 | my $attemptsNoun = $attempts != 1 ? "times" : "time"; |
| 365 | my $lastScore = int ($problem->status * 100) . "%"; |
415 | my $lastScore = int ($problem->status * 100) . "%"; |
| 366 | my ($attemptsLeft, $attemptsLeftNoun); |
416 | my ($attemptsLeft, $attemptsLeftNoun); |
| … | |
… | |
| 370 | $attemptsLeftNoun = "attempts"; |
420 | $attemptsLeftNoun = "attempts"; |
| 371 | } else { |
421 | } else { |
| 372 | $attemptsLeft = $problem->max_attempts - $attempts; |
422 | $attemptsLeft = $problem->max_attempts - $attempts; |
| 373 | $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; |
423 | $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; |
| 374 | } |
424 | } |
|
|
425 | |
|
|
426 | my $setClosed = 0; |
| 375 | my $setClosedMessage; |
427 | my $setClosedMessage; |
| 376 | if (time < $set->open_date or time > $set->due_date) { |
428 | if (time < $set->open_date or time > $set->due_date) { |
|
|
429 | $setClosed = 1; |
| 377 | $setClosedMessage = "This problem set is closed."; |
430 | $setClosedMessage = "This problem set is closed."; |
| 378 | if ($permissionLevel > 0) { |
431 | if ($permissionLevel > 0) { |
| 379 | $setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded."; |
432 | $setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded."; |
| 380 | } else { |
433 | } else { |
| 381 | $setClosedMessage .= " Additional attempts will not be recorded."; |
434 | $setClosedMessage .= " Additional attempts will not be recorded."; |
| … | |
… | |
| 384 | print CGI::p( |
437 | print CGI::p( |
| 385 | "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), |
438 | "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), |
| 386 | $problem->attempted |
439 | $problem->attempted |
| 387 | ? "Your recorded score is $lastScore." . CGI::br() |
440 | ? "Your recorded score is $lastScore." . CGI::br() |
| 388 | : "", |
441 | : "", |
| 389 | "You have $attemptsLeft $attemptsLeftNoun remaining.", CGI::br(), |
442 | $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." |
| 390 | $setClosedMessage, |
|
|
| 391 | ); |
443 | ); |
| 392 | |
|
|
| 393 | print CGI::hr(); |
444 | print CGI::end_div(); |
| 394 | |
445 | print CGI::hr(), CGI::start_div({class=>"viewOptions"}); |
| 395 | # main form |
|
|
| 396 | print |
446 | print |
| 397 | CGI::startform("POST", $r->uri), |
|
|
| 398 | $self->hidden_authen_fields, |
|
|
| 399 | CGI::p(CGI::i($pg->{result}->{msg})), |
|
|
| 400 | CGI::p($pg->{body_text}), |
|
|
| 401 | CGI::p( |
|
|
| 402 | ($can{recordAnswers} |
|
|
| 403 | ? CGI::submit(-name=>"submitAnswers", |
|
|
| 404 | -label=>"Submit Answers") |
|
|
| 405 | : ""), |
|
|
| 406 | ($can{recordAnswers} |
|
|
| 407 | ? CGI::submit(-name=>"checkAnswers", |
|
|
| 408 | -label=>"Check Answers") |
|
|
| 409 | : ""), |
|
|
| 410 | CGI::submit(-name=>"previewAnswers", |
|
|
| 411 | -label=>"Preview Answers"), |
|
|
| 412 | ), |
|
|
| 413 | $self->viewOptions(), |
447 | $self->viewOptions(),CGI::end_div(), |
| 414 | CGI::endform(); |
448 | CGI::endform(); |
| 415 | |
449 | |
|
|
450 | print CGI::start_div({class=>"problemFooter"}); |
| 416 | # feedback form |
451 | # feedback form |
| 417 | my $ce = $self->{courseEnvironment}; |
452 | my $ce = $self->{ce}; |
| 418 | my $root = $ce->{webworkURLs}->{root}; |
453 | my $root = $ce->{webworkURLs}->{root}; |
| 419 | my $courseName = $ce->{courseName}; |
454 | my $courseName = $ce->{courseName}; |
| 420 | my $feedbackURL = "$root/$courseName/feedback/"; |
455 | my $feedbackURL = "$root/$courseName/feedback/"; |
|
|
456 | |
|
|
457 | # arguments for answer inspection button |
|
|
458 | my $prof_url = $ce->{webworkURLs}->{oldProf}; |
|
|
459 | my $cgi_url = $prof_url; |
|
|
460 | $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl |
|
|
461 | my $authen_args = $self->url_authen_args(); |
|
|
462 | my $showPastAnswersURL = "$cgi_url/showPastAnswers.pl"; |
|
|
463 | |
|
|
464 | #print feedback form |
| 421 | print |
465 | print |
| 422 | CGI::startform("POST", $feedbackURL), |
466 | CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", |
| 423 | $self->hidden_authen_fields, |
467 | $self->hidden_authen_fields,"\n", |
| 424 | CGI::hidden("module", __PACKAGE__), |
468 | CGI::hidden("module", __PACKAGE__),"\n", |
| 425 | CGI::hidden("set", $set->id), |
469 | CGI::hidden("set", $set->id),"\n", |
| 426 | CGI::hidden("problem", $problem->id), |
470 | CGI::hidden("problem", $problem->id),"\n", |
| 427 | CGI::hidden("displayMode", $self->{displayMode}), |
471 | CGI::hidden("displayMode", $self->{displayMode}),"\n", |
| 428 | CGI::hidden("showOldAnswers", $will{showOldAnswers}), |
472 | CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", |
| 429 | CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}), |
473 | CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", |
| 430 | CGI::hidden("showHints", $will{showHints}), |
474 | CGI::hidden("showHints", $will{showHints}),"\n", |
| 431 | CGI::hidden("showSolutions", $will{showSolutions}), |
475 | CGI::hidden("showSolutions", $will{showSolutions}),"\n", |
| 432 | CGI::p({-align=>"right"}, |
476 | CGI::p({-align=>"right"}, |
| 433 | CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback") |
477 | CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback") |
| 434 | ), |
478 | ), |
|
|
479 | CGI::endform(),"\n"; |
|
|
480 | # print answer inspection button |
|
|
481 | if ($self->{permissionLevel} >0) { |
|
|
482 | |
|
|
483 | |
|
|
484 | print "\n", |
|
|
485 | CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", |
|
|
486 | $self->hidden_authen_fields,"\n", |
|
|
487 | CGI::hidden(-name => 'course', -value=>$courseName), "\n", |
|
|
488 | CGI::hidden(-name => 'probNum', -value=>$problem->id), "\n", |
|
|
489 | CGI::hidden(-name => 'setNum', -value=>$problem->set_id), "\n", |
|
|
490 | CGI::hidden(-name => 'User', -value=>$problem->login_id), "\n", |
|
|
491 | CGI::submit(-name => 'action', -value=>'Show Past Answers'), "\n", |
| 435 | CGI::endform(); |
492 | CGI::endform(); |
| 436 | |
493 | |
|
|
494 | |
|
|
495 | |
|
|
496 | } |
|
|
497 | print CGI::end_div(); |
|
|
498 | # end answer inspection button |
| 437 | # warning output |
499 | # warning output |
| 438 | if ($pg->{warnings} ne "") { |
500 | if ($pg->{warnings} ne "") { |
| 439 | print CGI::hr(), $self->warningOutput($pg->{warnings}); |
501 | print CGI::hr(), $self->warningOutput($pg->{warnings}); |
| 440 | } |
502 | } |
| 441 | |
503 | |
| 442 | # debugging stuff |
504 | # debugging stuff |
| 443 | if (1) { |
505 | if (0) { |
| 444 | print |
506 | print |
| 445 | CGI::hr(), |
507 | CGI::hr(), |
| 446 | CGI::h2("debugging information"), |
508 | CGI::h2("debugging information"), |
| 447 | CGI::h3("form fields"), |
509 | CGI::h3("form fields"), |
| 448 | ref2string($self->{formFields}), |
510 | ref2string($self->{formFields}), |
| … | |
… | |
| 459 | return ""; |
521 | return ""; |
| 460 | } |
522 | } |
| 461 | |
523 | |
| 462 | ##### output utilities ##### |
524 | ##### output utilities ##### |
| 463 | |
525 | |
| 464 | sub attemptResults($$$$$) { |
526 | sub attemptResults($$$$$$) { |
| 465 | my $self = shift; |
527 | my $self = shift; |
| 466 | my $pg = shift; |
528 | my $pg = shift; |
| 467 | my $showAttemptAnswers = shift; |
529 | my $showAttemptAnswers = shift; |
| 468 | my $showCorrectAnswers = shift; |
530 | my $showCorrectAnswers = shift; |
| 469 | my $showAttemptResults = $showAttemptAnswers && shift; |
531 | my $showAttemptResults = $showAttemptAnswers && shift; |
|
|
532 | my $showSummary = shift; |
| 470 | my $showAttemptPreview = shift || 0; |
533 | my $showAttemptPreview = shift || 0; |
| 471 | my $problemResult = $pg->{result}; # the overall result of the problem |
534 | my $problemResult = $pg->{result}; # the overall result of the problem |
| 472 | my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; |
535 | my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; |
| 473 | |
536 | |
| 474 | my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; |
537 | my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; |
| 475 | |
538 | |
| 476 | my $header = CGI::th("part"); |
539 | my $header = CGI::th("Part"); |
| 477 | $header .= $showAttemptAnswers ? CGI::th("entered") : ""; |
540 | $header .= $showAttemptAnswers ? CGI::th("Entered") : ""; |
| 478 | $header .= $showAttemptPreview ? CGI::th("preview") : ""; |
541 | $header .= $showAttemptPreview ? CGI::th("Answer Preview") : ""; |
| 479 | $header .= $showCorrectAnswers ? CGI::th("correct") : ""; |
542 | $header .= $showCorrectAnswers ? CGI::th("Correct") : ""; |
| 480 | $header .= $showAttemptResults ? CGI::th("result") : ""; |
543 | $header .= $showAttemptResults ? CGI::th("Result") : ""; |
| 481 | $header .= $showMessages ? CGI::th("messages") : ""; |
544 | $header .= $showMessages ? CGI::th("messages") : ""; |
| 482 | my @tableRows = ( $header ); |
545 | my @tableRows = ( $header ); |
| 483 | my $numCorrect; |
546 | my $numCorrect; |
| 484 | foreach my $name (@answerNames) { |
547 | foreach my $name (@answerNames) { |
| 485 | my $answerResult = $pg->{answers}->{$name}; |
548 | my $answerResult = $pg->{answers}->{$name}; |
| … | |
… | |
| 505 | $row .= $showAttemptResults ? CGI::td($resultString) : ""; |
568 | $row .= $showAttemptResults ? CGI::td($resultString) : ""; |
| 506 | $row .= $answerMessage ? CGI::td($answerMessage) : ""; |
569 | $row .= $answerMessage ? CGI::td($answerMessage) : ""; |
| 507 | push @tableRows, $row; |
570 | push @tableRows, $row; |
| 508 | } |
571 | } |
| 509 | |
572 | |
| 510 | my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions"; |
573 | my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; |
| 511 | my $scorePercent = int ($problemResult->{score} * 100) . "\%"; |
574 | my $scorePercent = int ($problemResult->{score} * 100) . "\%"; |
| 512 | my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of " |
575 | my $summary = "On this attempt, you answered $numCorrect out of " |
| 513 | . scalar @answerNames . " correct, for a score of $scorePercent."; |
576 | . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; |
| 514 | return CGI::table({-border=>1}, CGI::Tr(\@tableRows)) . CGI::p($summary); |
577 | return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . ($showSummary ? CGI::p($summary) : ""); |
| 515 | } |
578 | } |
| 516 | |
579 | |
| 517 | sub viewOptions($) { |
580 | sub viewOptions($) { |
| 518 | my $self = shift; |
581 | my $self = shift; |
| 519 | my $displayMode = $self->{displayMode}; |
582 | my $displayMode = $self->{displayMode}; |
| … | |
… | |
| 566 | ); |
629 | ); |
| 567 | } |
630 | } |
| 568 | |
631 | |
| 569 | sub previewAnswer($$) { |
632 | sub previewAnswer($$) { |
| 570 | my ($self, $answerResult) = @_; |
633 | my ($self, $answerResult) = @_; |
| 571 | my $ce = $self->{courseEnvironment}; |
634 | my $ce = $self->{ce}; |
| 572 | my $effectiveUser = $self->{effectiveUser}; |
635 | my $effectiveUser = $self->{effectiveUser}; |
| 573 | my $set = $self->{set}; |
636 | my $set = $self->{set}; |
| 574 | my $problem = $self->{problem}; |
637 | my $problem = $self->{problem}; |
| 575 | my $displayMode = $self->{displayMode}; |
638 | my $displayMode = $self->{displayMode}; |
| 576 | |
639 | |
| … | |
… | |
| 613 | # should use surePathToTmpFile, but we have to |
676 | # should use surePathToTmpFile, but we have to |
| 614 | # isolate it from the problem enivronment first |
677 | # isolate it from the problem enivronment first |
| 615 | my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon; |
678 | my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon; |
| 616 | |
679 | |
| 617 | # call dvipng to generate a preview |
680 | # call dvipng to generate a preview |
|
|
681 | warn $tex; |
| 618 | dvipng($wd, $latex, $dvipng, $tex, $targetPath); |
682 | dvipng($wd, $latex, $dvipng, $tex, $targetPath); |
| 619 | if (-e $targetPath) { |
683 | if (-e $targetPath) { |
| 620 | return "<img src=\"$targetURL\" alt=\"$tex\" />"; |
684 | return "<img src=\"$targetURL\" alt=\"$tex\" />"; |
| 621 | } else { |
685 | } else { |
| 622 | return "<b>[math2img failed]</b>"; |
686 | return "<b>[math2img failed]</b>"; |
| 623 | } |
687 | } |
| 624 | } |
688 | } |
| 625 | } |
689 | } |
|
|
690 | ##### logging subroutine #### |
|
|
691 | |
|
|
692 | |
| 626 | |
693 | |
| 627 | ##### permission queries ##### |
694 | ##### permission queries ##### |
| 628 | |
695 | |
| 629 | # this stuff should be abstracted out into the permissions system |
696 | # this stuff should be abstracted out into the permissions system |
| 630 | # however, the permission system only knows about things in the |
697 | # however, the permission system only knows about things in the |
| … | |
… | |
| 651 | my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts; |
718 | my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts; |
| 652 | my $recordAnswers = $permHigh || ($timeOK && $attemptsOK); |
719 | my $recordAnswers = $permHigh || ($timeOK && $attemptsOK); |
| 653 | return $recordAnswers; |
720 | return $recordAnswers; |
| 654 | } |
721 | } |
| 655 | |
722 | |
|
|
723 | sub canCheckAnswers($$) { |
|
|
724 | my ($permissionLevel, $answerDate) = @_; |
|
|
725 | my $permHigh = $permissionLevel > 0; |
|
|
726 | my $timeOK = time >= $answerDate; |
|
|
727 | my $recordAnswers = $permHigh || $timeOK; |
|
|
728 | return $recordAnswers; |
|
|
729 | } |
|
|
730 | |
| 656 | sub mustRecordAnswers($) { |
731 | sub mustRecordAnswers($) { |
| 657 | my ($permissionLevel) = @_; |
732 | my ($permissionLevel) = @_; |
| 658 | return $permissionLevel == 0; |
733 | return $permissionLevel == 0; |
| 659 | } |
734 | } |
| 660 | |
735 | |