Parent Directory
| 
Revision Log
Added ShowAnswers.pm module which reads the log file of the students answers Modifications to WeBWorK (dispatcher) and Problem (the Show Past Answer button had to be redirected) were also made. --Mike
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::ContentGenerator::Problem; 7 use base qw(WeBWorK::ContentGenerator); 8 9 =head1 NAME 10 11 WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. 12 13 =cut 14 my $timer0_ON=1; # times pg translation phase 15 use strict; 16 use warnings; 17 use CGI qw(); 18 use File::Path qw(rmtree); 19 use WeBWorK::Form; 20 use WeBWorK::PG; 21 use WeBWorK::PG::ImageGenerator; 22 use WeBWorK::PG::IO; 23 use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory); 24 use WeBWorK::DB::Utils qw(global2user user2global findDefaults); 25 use WeBWorK::Timing; 26 27 ############################################################ 28 # 29 # user 30 # effectiveUser 31 # key 32 # 33 # displayMode 34 # showOldAnswers 35 # showCorrectAnswers 36 # showHints 37 # showSolutions 38 # 39 # AnSwEr# - answer blanks in problem 40 # 41 # redisplay - name of the "Redisplay Problem" button 42 # submitAnswers - name of "Submit Answers" button 43 # checkAnswers - name of the "Check Answers" button 44 # previewAnswers - name of the "Preview Answers" button 45 # 46 ############################################################ 47 48 sub pre_header_initialize { 49 my ($self, $setName, $problemNumber) = @_; 50 my $r = $self->{r}; 51 my $courseEnv = $self->{ce}; 52 my $db = $self->{db}; 53 my $userName = $r->param('user'); 54 my $effectiveUserName = $r->param('effectiveUser'); 55 my $key = $r->param('key'); 56 my $user = $db->getUser($userName); 57 my $effectiveUser = $db->getUser($effectiveUserName); 58 my $permissionLevel = $db->getPermissionLevel($userName)->permission(); 59 60 # obtain the merged set for $effectiveUser 61 my $set = $db->getMergedSet($effectiveUserName, $setName); 62 63 # obtain the merged problem for $effectiveUser 64 my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); 65 66 my $editMode = $r->param("editMode"); 67 68 if ($permissionLevel > 0 and defined $editMode) { 69 # professors are allowed to fabricate sets and problems not 70 # assigned to them (or anyone). this allows them to use the 71 # editor to 72 73 # if that is not yet defined obtain the global set, convert 74 # it to a user set, and add fake user data 75 unless (defined $set) { 76 my $userSetClass = $db->{set_user}->{record}; 77 $set = global2user($userSetClass, 78 $db->getGlobalSet($setName)); 79 die "Set $setName does not exist" 80 unless defined $set; 81 $set->psvn(0); 82 } 83 84 # if that is not yet defined obtain the global problem, 85 # convert it to a user problem, and add fake user data 86 unless (defined $problem) { 87 my $userProblemClass = $db->{problem_user}->{record}; 88 $problem = global2user($userProblemClass, 89 $db->getGlobalProblem($setName,$problemNumber)); 90 die "Problem $problemNumber in set $setName does not exist" 91 unless defined $problem; 92 $problem->user_id($effectiveUserName); 93 $problem->problem_seed(0); 94 $problem->status(0); 95 $problem->attempted(0); 96 $problem->last_answer(""); 97 $problem->num_correct(0); 98 $problem->num_incorrect(0); 99 } 100 101 # now we're sure we have valid UserSet and UserProblem objects 102 # yay! 103 104 # now deal with possible editor overrides: 105 106 # if the caller is asking to override the source file, and 107 # editMode calls for a temporary file, do so 108 my $sourceFilePath = $r->param("sourceFilePath"); 109 if (defined $sourceFilePath and $editMode eq "temporaryFile") { 110 $problem->source_file($sourceFilePath); 111 } 112 113 # if the caller is asking to override the problem seed, do so 114 my $problemSeed = $r->param("problemSeed"); 115 if (defined $problemSeed) { 116 $problem->problem_seed($problemSeed); 117 } 118 } else { 119 # students can't view problems not assigned to them 120 die "Set $setName is not assigned to $effectiveUserName" 121 unless defined $set; 122 die "Problem $problemNumber in set $setName is not assigned to $effectiveUserName" 123 unless defined $problem; 124 } 125 126 $self->{userName} = $userName; 127 $self->{effectiveUserName} = $effectiveUserName; 128 $self->{user} = $user; 129 $self->{effectiveUser} = $effectiveUser; 130 $self->{permissionLevel} = $permissionLevel; 131 $self->{set} = $set; 132 $self->{problem} = $problem; 133 $self->{editMode} = $editMode; 134 135 ##### form processing ##### 136 137 # set options from form fields (see comment at top of file for names) 138 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 139 my $redisplay = $r->param("redisplay"); 140 my $submitAnswers = $r->param("submitAnswers"); 141 my $checkAnswers = $r->param("checkAnswers"); 142 my $previewAnswers = $r->param("previewAnswers"); 143 144 # fields which may be defined when using Problem Editor 145 #my $override_seed = ($permissionLevel>=10) ? $r->param('problemSeed') : undef; 146 #my $override_problem_source = ($permissionLevel>=10) ? $r->param('sourceFilePath') : undef; 147 #my $editMode = undef; 148 #my $submit_button = $r->param('submit_button'); 149 #if ( defined($submit_button ) ) { 150 # $editMode = "temporaryFile" if $submit_button eq 'Refresh'; 151 # $editMode = 'savedFile' if $submit_button eq 'Save'; 152 #} 153 # 154 ##override using the source file data from the form field 155 #$problem->source_file($override_problem_source) if defined($override_problem_source); 156 #$problem->problem_seed($override_seed) if defined($override_seed); 157 # 158 ## store path to source file for title. 159 #$self->{problem_source_name} = $problem->source_file; 160 #$self->{edit_mode} = $editMode; 161 #$self->{current_problem_source} = (defined($override_problem_source) ) ? 162 163 # coerce form fields into CGI::Vars format 164 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 165 166 $self->{displayMode} = $displayMode; 167 $self->{redisplay} = $redisplay; 168 $self->{submitAnswers} = $submitAnswers; 169 $self->{checkAnswers} = $checkAnswers; 170 $self->{previewAnswers} = $previewAnswers; 171 $self->{formFields} = $formFields; 172 173 ##### permissions ##### 174 175 # are we allowed to view this problem? 176 $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0; 177 return unless $self->{isOpen}; 178 179 # what does the user want to do? 180 my %want = ( 181 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, 182 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, 183 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, 184 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, 185 recordAnswers => $submitAnswers, 186 checkAnswers => $checkAnswers, 187 ); 188 189 # are certain options enforced? 190 my %must = ( 191 showOldAnswers => 0, 192 showCorrectAnswers => 0, 193 showHints => 0, 194 showSolutions => 0, 195 recordAnswers => mustRecordAnswers($permissionLevel), 196 checkAnswers => 0, 197 ); 198 199 # does the user have permission to use certain options? 200 my %can = ( 201 showOldAnswers => 1, 202 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date), 203 showHints => 1, 204 showSolutions => canShowSolutions($permissionLevel, $set->answer_date), 205 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, 206 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), 207 # attempts=num_correct+num_incorrect+1, as this happens before updating $problem 208 checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date), 209 ); 210 211 # final values for options 212 my %will; 213 foreach (keys %must) { 214 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 215 } 216 217 ##### sticky answers ##### 218 219 if (not ($submitAnswers or $previewAnswers or $checkAnswers) and $will{showOldAnswers}) { 220 # do this only if new answers are NOT being submitted 221 my %oldAnswers = decodeAnswers($problem->last_answer); 222 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; 223 } 224 225 ##### translation ##### 226 227 $WeBWorK::timer0->continue("begin pg processing") if $timer0_ON; 228 my $pg = WeBWorK::PG->new( 229 $courseEnv, 230 $effectiveUser, 231 $key, 232 $set, 233 $problem, 234 $set->psvn, # FIXME: this field should be removed 235 $formFields, 236 { # translation options 237 displayMode => $displayMode, 238 showHints => $will{showHints}, 239 showSolutions => $will{showSolutions}, 240 refreshMath2img => $will{showHints} || $will{showSolutions}, 241 processAnswers => 1, 242 }, 243 ); 244 245 $WeBWorK::timer0->continue("end pg processing") if $timer0_ON; 246 ##### fix hint/solution options ##### 247 248 $can{showHints} &&= $pg->{flags}->{hintExists}; 249 $can{showSolutions} &&= $pg->{flags}->{solutionExists}; 250 251 ##### store fields ##### 252 253 $self->{want} = \%want; 254 $self->{must} = \%must; 255 $self->{can} = \%can; 256 $self->{will} = \%will; 257 258 $self->{pg} = $pg; 259 } 260 261 #sub if_warnings($$) { 262 # my ($self, $arg) = @_; 263 # return 0 unless $self->{isOpen}; 264 # return $self->{pg}->{warnings} ne ""; 265 #} 266 267 sub if_errors($$) { 268 my ($self, $arg) = @_; 269 return 0 unless $self->{isOpen}; 270 return $self->{pg}->{flags}->{error_flag}; 271 } 272 273 sub head { 274 my $self = shift; 275 return "" unless $self->{isOpen}; 276 return $self->{pg}->{head_text} if $self->{pg}->{head_text}; 277 } 278 279 sub options { 280 my $self = shift; 281 return join("", 282 CGI::start_form("POST", $self->{r}->uri), 283 $self->hidden_authen_fields, 284 CGI::hr(), 285 CGI::start_div({class=>"viewOptions"}), 286 $self->viewOptions(), 287 CGI::end_div(), 288 CGI::end_form() 289 ); 290 } 291 292 sub path { 293 my $self = shift; 294 my $args = $_[-1]; 295 my $setName = $self->{set}->set_id; 296 my $problemNumber = $self->{problem}->problem_id; 297 298 my $ce = $self->{ce}; 299 my $root = $ce->{webworkURLs}->{root}; 300 my $courseName = $ce->{courseName}; 301 return $self->pathMacro($args, 302 "Home" => "$root", 303 $courseName => "$root/$courseName", 304 $setName => "$root/$courseName/$setName", 305 "Problem $problemNumber" => "", 306 ); 307 } 308 309 sub siblings { 310 my $self = shift; 311 my $setName = $self->{set}->set_id; 312 my $problemNumber = $self->{problem}->problem_id; 313 314 my $ce = $self->{ce}; 315 my $db = $self->{db}; 316 my $root = $ce->{webworkURLs}->{root}; 317 my $courseName = $ce->{courseName}; 318 print CGI::strong("Problems"), CGI::br(); 319 320 my $effectiveUser = $self->{r}->param("effectiveUser"); 321 my @problemIDs = $db->listUserProblems($effectiveUser, $setName); 322 foreach my $problem (sort { $a <=> $b } @problemIDs) { 323 print ' '.CGI::a({-href=>"$root/$courseName/$setName/".$problem."/?" 324 . $self->url_authen_args . "&displayMode=" . $self->{displayMode}}, 325 "Problem ".$problem), CGI::br(); 326 } 327 328 return ""; 329 } 330 331 sub nav { 332 $WeBWorK::timer0->continue("begin nav subroutine") if $timer0_ON; 333 my $self = shift; 334 my $args = $_[-1]; 335 my $setName = $self->{set}->set_id; 336 my $problemNumber = $self->{problem}->problem_id; 337 338 my $ce = $self->{ce}; 339 my $db = $self->{db}; 340 my $root = $ce->{webworkURLs}->{root}; 341 my $courseName = $ce->{courseName}; 342 343 my $wwdb = $self->{wwdb}; 344 my $effectiveUser = $self->{r}->param("effectiveUser"); 345 my $tail = "&displayMode=".$self->{displayMode}; 346 347 my @links = ("Problem List" , "$root/$courseName/$setName", "navProbList"); 348 349 my @problemIDs = $db->listUserProblems($effectiveUser, $setName); 350 my ($prevID, $nextID); 351 foreach my $id (@problemIDs) { 352 $prevID = $id if $id < $problemNumber 353 and (not defined $prevID or $id > $prevID); 354 $nextID = $id if $id > $problemNumber 355 and (not defined $nextID or $id < $nextID); 356 } 357 unshift @links, "Previous Problem" , ($prevID 358 ? "$root/$courseName/$setName/".$prevID 359 : "") , "navPrev"; 360 push @links, "Next Problem" , ($nextID 361 ? "$root/$courseName/$setName/".$nextID 362 : "") , "navNext"; 363 364 my $result = $self->navMacro($args, $tail, @links); 365 $WeBWorK::timer0->continue("end nav subroutine") if $timer0_ON; 366 return $result; 367 } 368 369 sub title { 370 my $self = shift; 371 my $setName = $self->{set}->set_id; 372 my $problemNumber = $self->{problem}->problem_id; 373 374 return "$setName : Problem $problemNumber"; 375 } 376 377 sub body { 378 my $self = shift; 379 380 return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open.")) 381 unless $self->{isOpen}; 382 383 # unpack some useful variables 384 my $r = $self->{r}; 385 my $db = $self->{db}; 386 my $set = $self->{set}; 387 my $problem = $self->{problem}; 388 my $editMode = $self->{editMode}; 389 my $permissionLevel = $self->{permissionLevel}; 390 my $submitAnswers = $self->{submitAnswers}; 391 my $checkAnswers = $self->{checkAnswers}; 392 my $previewAnswers = $self->{previewAnswers}; 393 my %want = %{ $self->{want} }; 394 my %can = %{ $self->{can} }; 395 my %must = %{ $self->{must} }; 396 my %will = %{ $self->{will} }; 397 my $pg = $self->{pg}; 398 399 ##### translation errors? ##### 400 401 if ($pg->{flags}->{error_flag}) { 402 return $self->errorOutput($pg->{errors}, $pg->{body_text}); 403 } 404 405 ##### answer processing ##### 406 $WeBWorK::timer0->continue("begin answer processing") if $timer0_ON; 407 # if answers were submitted: 408 my $scoreRecordedMessage; 409 if ($submitAnswers) { 410 # get a "pure" (unmerged) UserProblem to modify 411 # this will be undefined if the problem has not been assigned to this user 412 my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); 413 if (defined $pureProblem) { 414 # store answers in DB for sticky answers 415 my %answersToStore; 416 my %answerHash = %{ $pg->{answers} }; 417 $answersToStore{$_} = $answerHash{$_}->{original_student_ans} 418 foreach (keys %answerHash); 419 my $answerString = encodeAnswers(%answersToStore, 420 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); 421 422 # store last answer to database 423 $problem->last_answer($answerString); 424 $pureProblem->last_answer($answerString); 425 $db->putUserProblem($pureProblem); 426 427 # store state in DB if it makes sense 428 if ($will{recordAnswers}) { 429 $problem->status($pg->{state}->{recorded_score}); 430 $problem->attempted(1); 431 $problem->num_correct($pg->{state}->{num_of_correct_ans}); 432 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 433 $pureProblem->status($pg->{state}->{recorded_score}); 434 $pureProblem->attempted(1); 435 $pureProblem->num_correct($pg->{state}->{num_of_correct_ans}); 436 $pureProblem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 437 if ($db->putUserProblem($pureProblem)) { 438 $scoreRecordedMessage = "Your score was recorded."; 439 } else { 440 $scoreRecordedMessage = "Your score was not recorded because there was a failure in storing the problem record to the database."; 441 } 442 # write to the transaction log, just to make sure 443 writeLog($self->{ce}, "transaction", 444 $problem->problem_id."\t". 445 $problem->set_id."\t". 446 $problem->user_id."\t". 447 $problem->source_file."\t". 448 $problem->value."\t". 449 $problem->max_attempts."\t". 450 $problem->problem_seed."\t". 451 $pureProblem->status."\t". 452 $pureProblem->attempted."\t". 453 $pureProblem->last_answer."\t". 454 $pureProblem->num_correct."\t". 455 $pureProblem->num_incorrect 456 ); 457 } else { 458 if (time < $set->open_date or time > $set->due_date) { 459 $scoreRecordedMessage = "Your score was not recorded because this problem set is closed."; 460 } else { 461 $scoreRecordedMessage = "Your score was not recorded."; 462 } 463 } 464 } else { 465 $scoreRecordedMessage = "Your score was not recorded because this problem has not been built for you."; 466 } 467 } 468 469 # logging student answers 470 471 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 472 if ( defined($answer_log )) { 473 if ($submitAnswers ) { 474 my $answerString = ""; 475 my %answerHash = %{ $pg->{answers} }; 476 $answerString = $answerString . $answerHash{$_}->{original_student_ans}."\t" 477 foreach (sort keys %answerHash); 478 $answerString = '' unless defined($answerString); # insure string is defined. 479 writeCourseLog($self->{ce}, "answer_log", 480 join("", 481 '|', $problem->user_id, 482 '|', $problem->set_id, 483 '|', $problem->problem_id, 484 '|',"\t", 485 time(),"\t", 486 $answerString, 487 ), 488 ); 489 490 } 491 } 492 493 $WeBWorK::timer0->continue("end answer processing") if $timer0_ON; 494 495 ##### output ##### 496 497 print CGI::start_div({class=>"problemHeader"}); 498 499 # custom message for editor 500 if ($permissionLevel >= 10 and defined $editMode) { 501 if ($editMode eq "temporaryFile") { 502 print CGI::p(CGI::i("Editing temporary file: ", $problem->source_file)); 503 } elsif ($editMode eq "savedFile") { 504 print CGI::p(CGI::i("Problem saved to: ", $problem->source_file)); 505 } 506 } 507 508 # attempt summary 509 if ($submitAnswers or $will{showCorrectAnswers}) { 510 # print this if user submitted answers OR requested correct answers 511 print $self->attemptResults($pg, $submitAnswers, 512 $will{showCorrectAnswers}, 513 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); 514 } elsif ($checkAnswers) { 515 # print this if user previewed answers 516 print $self->attemptResults($pg, 1, 0, 1, 1, 1); 517 # show attempt answers 518 # don't show correct answers 519 # show attempt results (correctness) 520 # don't show attempt previews 521 } elsif ($previewAnswers) { 522 # print this if user previewed answers 523 print $self->attemptResults($pg, 1, 0, 0, 0, 1); 524 # show attempt answers 525 # don't show correct answers 526 # don't show attempt results (correctness) 527 # show attempt previews 528 } 529 530 print CGI::end_div(); 531 532 print CGI::start_div({class=>"problem"}); 533 534 # main form 535 print 536 CGI::startform("POST", $r->uri), 537 $self->hidden_authen_fields, 538 CGI::p($pg->{body_text}), 539 CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})), 540 CGI::p( 541 ($can{recordAnswers} 542 ? CGI::submit(-name=>"submitAnswers", 543 -label=>"Submit Answers") 544 : ""), 545 ($can{checkAnswers} 546 ? CGI::submit(-name=>"checkAnswers", 547 -label=>"Check Answers") 548 : ""), 549 CGI::submit(-name=>"previewAnswers", 550 -label=>"Preview Answers"), 551 ); 552 print CGI::end_div(); 553 554 print CGI::start_div({class=>"scoreSummary"}); 555 556 # score summary 557 my $attempts = $problem->num_correct + $problem->num_incorrect; 558 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 559 my $lastScore = sprintf("%.0f%%", $problem->status * 100); # Round to whole number 560 my ($attemptsLeft, $attemptsLeftNoun); 561 if ($problem->max_attempts == -1) { 562 # unlimited attempts 563 $attemptsLeft = "unlimited"; 564 $attemptsLeftNoun = "attempts"; 565 } else { 566 $attemptsLeft = $problem->max_attempts - $attempts; 567 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 568 } 569 570 my $setClosed = 0; 571 my $setClosedMessage; 572 if (time < $set->open_date or time > $set->due_date) { 573 $setClosed = 1; 574 $setClosedMessage = "This problem set is closed."; 575 if ($permissionLevel > 0) { 576 $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; 577 } else { 578 $setClosedMessage .= " Additional attempts will not be recorded."; 579 } 580 } 581 print CGI::p( 582 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", 583 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), 584 $problem->attempted 585 ? "Your recorded score is $lastScore." . CGI::br() 586 : "", 587 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." 588 ); 589 print CGI::end_div(); 590 591 # save state for viewOptions 592 print CGI::hidden( 593 -name => "showOldAnswers", 594 -value => $will{showOldAnswers} 595 ), 596 CGI::hidden( 597 -name => "showCorrectAnswers", 598 -value => $will{showCorrectAnswers} 599 ), 600 CGI::hidden( 601 -name => "showHints", 602 -value => $will{showHints}), 603 CGI::hidden( 604 -name => "showSolutions", 605 -value => $will{showSolutions}, 606 ), 607 CGI::hidden( 608 -name => "displayMode", 609 -value => $self->{displayMode} 610 ); 611 612 # end of main form 613 print CGI::endform(); 614 615 # stuff we need below (pull these out at the beginning?) 616 my $ce = $self->{ce}; 617 my $root = $ce->{webworkURLs}->{root}; 618 my $courseName = $ce->{courseName}; 619 620 print CGI::start_div({class=>"problemFooter"}); 621 622 # arguments for answer inspection button 623 my $prof_url = $ce->{webworkURLs}->{oldProf}; 624 my $webworkURL = $ce->{webworkURLs}->{root}; 625 my $cgi_url = $prof_url; 626 $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl 627 my $authen_args = $self->url_authen_args(); 628 my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/"; 629 630 # print answer inspection button 631 if ($self->{permissionLevel} > 0) { 632 print "\n", 633 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", 634 $self->hidden_authen_fields,"\n", 635 CGI::hidden(-name => 'course', -value=>$courseName), "\n", 636 CGI::hidden(-name => 'problemNumber', -value=>$problem->problem_id), "\n", 637 CGI::hidden(-name => 'setName', -value=>$problem->set_id), "\n", 638 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", 639 CGI::p( {-align=>"left"}, 640 CGI::submit(-name => 'action', -value=>'Show Past Answers') 641 ), "\n", 642 CGI::endform(); 643 } 644 645 #print CGI::end_div(); 646 # 647 #print CGI::start_div(); 648 649 # arguments for feedback form 650 my $feedbackURL = "$root/$courseName/feedback/"; 651 652 #print feedback form 653 print 654 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", 655 $self->hidden_authen_fields,"\n", 656 CGI::hidden("module", __PACKAGE__),"\n", 657 CGI::hidden("set", $set->set_id),"\n", 658 CGI::hidden("problem", $problem->problem_id),"\n", 659 CGI::hidden("displayMode", $self->{displayMode}),"\n", 660 CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", 661 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", 662 CGI::hidden("showHints", $will{showHints}),"\n", 663 CGI::hidden("showSolutions", $will{showSolutions}),"\n", 664 CGI::p({-align=>"left"}, 665 CGI::submit(-name=>"feedbackForm", -label=>"Contact instructor") 666 ), 667 CGI::endform(),"\n"; 668 669 # FIXME print editor link 670 # print editor link if the user is an instructor AND the file is not in temporary editing mode 671 if ($self->{permissionLevel}>=10 and ( (not defined($self->{edit_mode})) or $self->{edit_mode} eq 'savedFile') ) { 672 print CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/".$set->set_id. 673 '/'.$problem->problem_id.'?'.$self->url_authen_args},'Edit this problem'); 674 } 675 676 print CGI::end_div(); 677 678 # warning output 679 #if ($pg->{warnings} ne "") { 680 # print CGI::hr(), $self->warningOutput($pg->{warnings}); 681 #} 682 683 # debugging stuff 684 if (0) { 685 print 686 CGI::hr(), 687 CGI::h2("debugging information"), 688 CGI::h3("form fields"), 689 ref2string($self->{formFields}), 690 CGI::h3("user object"), 691 ref2string($self->{user}), 692 CGI::h3("set object"), 693 ref2string($set), 694 CGI::h3("problem object"), 695 ref2string($problem), 696 CGI::h3("PG object"), 697 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 698 } 699 700 return ""; 701 } 702 703 ##### output utilities ##### 704 705 sub attemptResults($$$$$$) { 706 my $self = shift; 707 my $pg = shift; 708 my $showAttemptAnswers = shift; 709 my $showCorrectAnswers = shift; 710 my $showAttemptResults = $showAttemptAnswers && shift; 711 my $showSummary = shift; 712 my $showAttemptPreview = shift || 0; 713 my $ce = $self->{ce}; 714 my $problemResult = $pg->{result}; # the overall result of the problem 715 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 716 717 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 718 719 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 720 my $imgGen = WeBWorK::PG::ImageGenerator->new( 721 tempDir => $ce->{webworkDirs}->{tmp}, 722 dir => $ce->{courseDirs}->{html_temp}, 723 url => $ce->{courseURLs}->{html_temp}, 724 basename => $basename, 725 latex => $ce->{externalPrograms}->{latex}, 726 dvipng => $ce->{externalPrograms}->{dvipng}, 727 ); 728 729 my $header; 730 #$header .= CGI::th("Part"); 731 $header .= $showAttemptAnswers ? CGI::th("Entered") : ""; 732 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : ""; 733 $header .= $showCorrectAnswers ? CGI::th("Correct") : ""; 734 $header .= $showAttemptResults ? CGI::th("Result") : ""; 735 $header .= $showMessages ? CGI::th("messages") : ""; 736 my @tableRows = ( $header ); 737 my $numCorrect; 738 foreach my $name (@answerNames) { 739 my $answerResult = $pg->{answers}->{$name}; 740 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 741 my $preview = ($showAttemptPreview 742 ? $self->previewAnswer($answerResult, $imgGen) 743 : ""); 744 my $correctAnswer = $answerResult->{correct_ans}; 745 my $answerScore = $answerResult->{score}; 746 my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; 747 748 $numCorrect += $answerScore > 0; 749 my $resultString = $answerScore ? "correct" : "incorrect"; 750 751 # get rid of the goofy prefix on the answer names (supposedly, the format 752 # of the answer names is changeable. this only fixes it for "AnSwEr" 753 $name =~ s/^AnSwEr//; 754 755 my $row; 756 #$row .= CGI::td($name); 757 $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : ""; 758 $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : ""; 759 $row .= $showCorrectAnswers ? CGI::td(nbsp($correctAnswer)) : ""; 760 $row .= $showAttemptResults ? CGI::td(nbsp($resultString)) : ""; 761 $row .= $answerMessage ? CGI::td(nbsp($answerMessage)) : ""; 762 push @tableRows, $row; 763 } 764 765 # render equation images 766 $imgGen->render(refresh => 1); 767 768 my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; 769 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); 770 my $summary = "On this attempt, you answered $numCorrect out of " 771 . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; 772 return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); 773 } 774 sub nbsp { 775 my $str = shift; 776 ($str =~/\S/) ? $str : ' ' ; # returns non-breaking space for empty strings 777 # tricky cases: $str =0; 778 # $str is a complex number 779 } 780 sub viewOptions($) { 781 my $self = shift; 782 my $displayMode = $self->{displayMode}; 783 my %must = %{ $self->{must} }; 784 my %can = %{ $self->{can} }; 785 my %will = %{ $self->{will} }; 786 787 my $optionLine; 788 $can{showOldAnswers} and $optionLine .= join "", 789 "Show: ".CGI::br(), 790 CGI::checkbox( 791 -name => "showOldAnswers", 792 -checked => $will{showOldAnswers}, 793 -label => "Saved answers", 794 ), " ".CGI::br(); 795 $can{showCorrectAnswers} and $optionLine .= join "", 796 CGI::checkbox( 797 -name => "showCorrectAnswers", 798 -checked => $will{showCorrectAnswers}, 799 -label => "Correct answers", 800 ), " ".CGI::br(); 801 $can{showHints} and $optionLine .= join "", 802 CGI::checkbox( 803 -name => "showHints", 804 -checked => $will{showHints}, 805 -label => "Hints", 806 ), " ".CGI::br(); 807 $can{showSolutions} and $optionLine .= join "", 808 CGI::checkbox( 809 -name => "showSolutions", 810 -checked => $will{showSolutions}, 811 -label => "Solutions", 812 ), " ".CGI::br(); 813 $optionLine and $optionLine .= join "", CGI::br(); 814 815 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"}, 816 "View equations as: ".CGI::br(), 817 CGI::radio_group( 818 -name => "displayMode", 819 -values => ['plainText', 'formattedText', 'images'], 820 -default => $displayMode, 821 -linebreak=>'true', 822 -labels => { 823 plainText => "plain", 824 formattedText => "formatted", 825 images => "images", 826 } 827 ), CGI::br(),CGI::hr(), 828 $optionLine, 829 CGI::submit(-name=>"redisplay", -label=>"Save Options"), 830 ); 831 } 832 833 sub previewAnswer($$) { 834 my ($self, $answerResult, $imgGen) = @_; 835 my $ce = $self->{ce}; 836 my $effectiveUser = $self->{effectiveUser}; 837 my $set = $self->{set}; 838 my $problem = $self->{problem}; 839 my $displayMode = $self->{displayMode}; 840 841 # note: right now, we have to do things completely differently when we are 842 # rendering math from INSIDE the translator and from OUTSIDE the translator. 843 # so we'll just deal with each case explicitly here. there's some code 844 # duplication that can be dealt with later by abstracting out tth/dvipng/etc. 845 846 my $tex = $answerResult->{preview_latex_string}; 847 848 return "" unless defined $tex and $tex ne ""; 849 850 if ($displayMode eq "plainText") { 851 return $tex; 852 } elsif ($displayMode eq "formattedText") { 853 my $tthCommand = $ce->{externalPrograms}->{tth} 854 . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" 855 . "\\(".$tex."\\)\n" 856 . "END_OF_INPUT\n"; 857 858 # call tth 859 my $result = `$tthCommand`; 860 if ($?) { 861 return "<b>[tth failed: $? $@]</b>"; 862 } 863 return $result; 864 } elsif ($displayMode eq "images") { 865 ## how are we going to name this? 866 #my $targetPathCommon = "/m2i/" 867 # . $effectiveUser->user_id . "." 868 # . $set->set_id . "." 869 # . $problem->problem_id . "." 870 # . $answerResult->{ans_name} . ".png"; 871 # 872 ## figure out where to put things 873 #my $wd = makeTempDirectory($ce->{courseDirs}->{html_temp}, "webwork-dvipng"); 874 #my $latex = $ce->{externalPrograms}->{latex}; 875 #my $dvipng = $ce->{externalPrograms}->{dvipng}; 876 #my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon; 877 # # should use surePathToTmpFile, but we have to 878 # # isolate it from the problem enivronment first 879 #my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon; 880 # 881 ## call dvipng to generate a preview 882 #dvipng($wd, $latex, $dvipng, $tex, $targetPath); 883 #rmtree($wd, 0, 0); 884 #if (-e $targetPath) { 885 # return "<img src=\"$targetURL\" alt=\"$tex\" />"; 886 #} else { 887 # return "<b>[math2img failed]</b>"; 888 #} 889 $imgGen->add($answerResult->{preview_latex_string}); 890 891 } 892 } 893 894 ##### logging subroutine #### 895 896 897 898 ##### permission queries ##### 899 900 # this stuff should be abstracted out into the permissions system 901 # however, the permission system only knows about things in the 902 # course environment and the username. hmmm... 903 904 # also, i should fix these so that they have a consistent calling 905 # format -- perhaps: 906 # canPERM($courseEnv, $user, $set, $problem, $permissionLevel) 907 908 sub canShowCorrectAnswers($$) { 909 my ($permissionLevel, $answerDate) = @_; 910 return $permissionLevel > 0 || time > $answerDate; 911 } 912 913 sub canShowSolutions($$) { 914 my ($permissionLevel, $answerDate) = @_; 915 return canShowCorrectAnswers($permissionLevel, $answerDate); 916 } 917 918 sub canRecordAnswers($$$$$) { 919 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; 920 my $permHigh = $permissionLevel > 0; 921 my $timeOK = time >= $openDate && time <= $dueDate; 922 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts; 923 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK); 924 return $recordAnswers; 925 } 926 927 sub canCheckAnswers($$) { 928 my ($permissionLevel, $answerDate) = @_; 929 my $permHigh = $permissionLevel > 0; 930 my $timeOK = time >= $answerDate; 931 my $recordAnswers = $permHigh || $timeOK; 932 return $recordAnswers; 933 } 934 935 sub mustRecordAnswers($) { 936 my ($permissionLevel) = @_; 937 return $permissionLevel == 0; 938 } 939 940 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |