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