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