Parent Directory
| 
Revision Log
When recording answers the answer strings are now obtained directly from the original formField entries, rather than from the processed version in the answer hashes. This insures that the memorized answers will be identical with the ones that would have been submitted from the form. This is important for answers with multiple values which are represented by null separated strings. The answer evaluation process converts these strings to references to arrays, and -- in order to have good display properties -- the original_student_answer slot in the AnswerHash contains a representation such as ( 4, 5, 6). This is NOT suitable for resubmitting as an answer in a form field and is therefore not the right thing to store in the data base when saving answers. --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 $can{showSolutions} &&= $pg->{flags}->{solutionExists}; 280 281 ##### store fields ##### 282 283 $self->{want} = \%want; 284 $self->{must} = \%must; 285 $self->{can} = \%can; 286 $self->{will} = \%will; 287 288 $self->{pg} = $pg; 289 } 290 291 #sub if_warnings($$) { 292 # my ($self, $arg) = @_; 293 # return 0 unless $self->{isOpen}; 294 # return $self->{pg}->{warnings} ne ""; 295 #} 296 297 sub if_errors($$) { 298 my ($self, $arg) = @_; 299 return 0 unless $self->{isOpen}; 300 return $self->{pg}->{flags}->{error_flag}; 301 } 302 303 sub head { 304 my $self = shift; 305 return "" unless $self->{isOpen}; 306 return $self->{pg}->{head_text} if $self->{pg}->{head_text}; 307 } 308 309 sub options { 310 my $self = shift; 311 return join("", 312 CGI::start_form("POST", $self->{r}->uri), 313 $self->hidden_authen_fields, 314 CGI::hr(), 315 CGI::start_div({class=>"viewOptions"}), 316 $self->viewOptions(), 317 CGI::end_div(), 318 CGI::end_form() 319 ); 320 } 321 322 sub path { 323 my $self = shift; 324 my $args = $_[-1]; 325 my $setName = $self->{set}->set_id; 326 my $problemNumber = $self->{problem}->problem_id; 327 328 my $ce = $self->{ce}; 329 my $root = $ce->{webworkURLs}->{root}; 330 my $courseName = $ce->{courseName}; 331 return $self->pathMacro($args, 332 "Home" => "$root", 333 $courseName => "$root/$courseName", 334 $setName => "$root/$courseName/$setName", 335 "Problem $problemNumber" => "", 336 ); 337 } 338 339 sub siblings { 340 my $self = shift; 341 my $setName = $self->{set}->set_id; 342 my $problemNumber = $self->{problem}->problem_id; 343 344 my $ce = $self->{ce}; 345 my $db = $self->{db}; 346 my $root = $ce->{webworkURLs}->{root}; 347 my $courseName = $ce->{courseName}; 348 print CGI::strong("Problems"), CGI::br(); 349 350 my $effectiveUser = $self->{r}->param("effectiveUser"); 351 my @problemIDs = $db->listUserProblems($effectiveUser, $setName); 352 foreach my $problem (sort { $a <=> $b } @problemIDs) { 353 print ' '.CGI::a({-href=>"$root/$courseName/$setName/".$problem."/?" 354 . $self->url_authen_args . "&displayMode=" . $self->{displayMode}}, 355 "Problem ".$problem), CGI::br(); 356 } 357 358 return ""; 359 } 360 361 sub nav { 362 $WeBWorK::timer0->continue("begin nav subroutine") if $timer0_ON; 363 my $self = shift; 364 my $args = $_[-1]; 365 my $setName = $self->{set}->set_id; 366 my $problemNumber = $self->{problem}->problem_id; 367 368 my $ce = $self->{ce}; 369 my $db = $self->{db}; 370 my $root = $ce->{webworkURLs}->{root}; 371 my $courseName = $ce->{courseName}; 372 373 my $wwdb = $self->{wwdb}; 374 my $effectiveUser = $self->{r}->param("effectiveUser"); 375 my $tail = "&displayMode=".$self->{displayMode}; 376 377 my @links = ("Problem List" , "$root/$courseName/$setName", "navProbList"); 378 379 my @problemIDs = $db->listUserProblems($effectiveUser, $setName); 380 my ($prevID, $nextID); 381 foreach my $id (@problemIDs) { 382 $prevID = $id if $id < $problemNumber 383 and (not defined $prevID or $id > $prevID); 384 $nextID = $id if $id > $problemNumber 385 and (not defined $nextID or $id < $nextID); 386 } 387 unshift @links, "Previous Problem" , ($prevID 388 ? "$root/$courseName/$setName/".$prevID 389 : "") , "navPrev"; 390 push @links, "Next Problem" , ($nextID 391 ? "$root/$courseName/$setName/".$nextID 392 : "") , "navNext"; 393 394 my $result = $self->navMacro($args, $tail, @links); 395 $WeBWorK::timer0->continue("end nav subroutine") if $timer0_ON; 396 return $result; 397 } 398 399 sub title { 400 my $self = shift; 401 my $setName = $self->{set}->set_id; 402 my $problemNumber = $self->{problem}->problem_id; 403 404 return "$setName : Problem $problemNumber"; 405 } 406 407 sub body { 408 my $self = shift; 409 410 return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open.")) 411 unless $self->{isOpen}; 412 413 # unpack some useful variables 414 my $r = $self->{r}; 415 my $db = $self->{db}; 416 my $set = $self->{set}; 417 my $problem = $self->{problem}; 418 my $editMode = $self->{editMode}; 419 my $permissionLevel = $self->{permissionLevel}; 420 my $submitAnswers = $self->{submitAnswers}; 421 my $checkAnswers = $self->{checkAnswers}; 422 my $previewAnswers = $self->{previewAnswers}; 423 my %want = %{ $self->{want} }; 424 my %can = %{ $self->{can} }; 425 my %must = %{ $self->{must} }; 426 my %will = %{ $self->{will} }; 427 my $pg = $self->{pg}; 428 429 ##### translation errors? ##### 430 431 if ($pg->{flags}->{error_flag}) { 432 return $self->errorOutput($pg->{errors}, $pg->{body_text}); 433 } 434 435 ##### answer processing ##### 436 $WeBWorK::timer0->continue("begin answer processing") if $timer0_ON; 437 # if answers were submitted: 438 my $scoreRecordedMessage; 439 if ($submitAnswers) { 440 # get a "pure" (unmerged) UserProblem to modify 441 # this will be undefined if the problem has not been assigned to this user 442 my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); 443 if (defined $pureProblem) { 444 # store answers in DB for sticky answers 445 my %answersToStore; 446 my %answerHash = %{ $pg->{answers} }; 447 $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!! 448 foreach (keys %answerHash); 449 # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating 450 # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs 451 # however we need to store them. Fortunately they are still in the input form. 452 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}}; 453 454 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names); 455 456 # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order 457 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names); 458 my $answerString = encodeAnswers(%answersToStore, 459 @answer_order); 460 461 # store last answer to database 462 $problem->last_answer($answerString); 463 $pureProblem->last_answer($answerString); 464 $db->putUserProblem($pureProblem); 465 466 # store state in DB if it makes sense 467 if ($will{recordAnswers}) { 468 $problem->status($pg->{state}->{recorded_score}); 469 $problem->attempted(1); 470 $problem->num_correct($pg->{state}->{num_of_correct_ans}); 471 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 472 $pureProblem->status($pg->{state}->{recorded_score}); 473 $pureProblem->attempted(1); 474 $pureProblem->num_correct($pg->{state}->{num_of_correct_ans}); 475 $pureProblem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 476 if ($db->putUserProblem($pureProblem)) { 477 $scoreRecordedMessage = "Your score was recorded."; 478 } else { 479 $scoreRecordedMessage = "Your score was not recorded because there was a failure in storing the problem record to the database."; 480 } 481 # write to the transaction log, just to make sure 482 writeLog($self->{ce}, "transaction", 483 $problem->problem_id."\t". 484 $problem->set_id."\t". 485 $problem->user_id."\t". 486 $problem->source_file."\t". 487 $problem->value."\t". 488 $problem->max_attempts."\t". 489 $problem->problem_seed."\t". 490 $pureProblem->status."\t". 491 $pureProblem->attempted."\t". 492 $pureProblem->last_answer."\t". 493 $pureProblem->num_correct."\t". 494 $pureProblem->num_incorrect 495 ); 496 } else { 497 if (time < $set->open_date or time > $set->due_date) { 498 $scoreRecordedMessage = "Your score was not recorded because this problem set is closed."; 499 } else { 500 $scoreRecordedMessage = "Your score was not recorded."; 501 } 502 } 503 } else { 504 $scoreRecordedMessage = "Your score was not recorded because this problem has not been built for you."; 505 } 506 } 507 508 # logging student answers 509 510 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 511 if ( defined($answer_log )) { 512 if ($submitAnswers ) { 513 my $answerString = ""; 514 my %answerHash = %{ $pg->{answers} }; 515 $answerString = $answerString . $answerHash{$_}->{original_student_ans}."\t" 516 foreach (sort keys %answerHash); 517 $answerString = '' unless defined($answerString); # insure string is defined. 518 writeCourseLog($self->{ce}, "answer_log", 519 join("", 520 '|', $problem->user_id, 521 '|', $problem->set_id, 522 '|', $problem->problem_id, 523 '|',"\t", 524 time(),"\t", 525 $answerString, 526 ), 527 ); 528 529 } 530 } 531 532 $WeBWorK::timer0->continue("end answer processing") if $timer0_ON; 533 534 ##### output ##### 535 536 print CGI::start_div({class=>"problemHeader"}); 537 538 # custom message for editor 539 if ($permissionLevel >= 10 and defined $editMode) { 540 if ($editMode eq "temporaryFile") { 541 print CGI::p(CGI::i("Editing temporary file: ", $problem->source_file)); 542 } elsif ($editMode eq "savedFile") { 543 print CGI::p(CGI::i("Problem saved to: ", $problem->source_file)); 544 } 545 } 546 547 # attempt summary 548 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. 549 # until after the due date 550 # do I need to check $wills{howCorrectAnswers} to make preflight work?? 551 if (($pg->{flags}->{showPartialCorrectAnswers}>= 0 and $submitAnswers) ) { 552 # print this if user submitted answers OR requested correct answers 553 554 print $self->attemptResults($pg, 1, 555 $will{showCorrectAnswers}, 556 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); 557 } elsif ($checkAnswers) { 558 # print this if user previewed answers 559 print "ANSWERS ONLY CHECKED -- ",CGI::br(),"ANSWERS NOT RECORDED", CGI::br(); 560 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); 561 # show attempt answers 562 # show correct answers if asked 563 # show attempt results (correctness) 564 # show attempt previews 565 } elsif ($previewAnswers) { 566 # print this if user previewed answers 567 print "PREVIEW ONLY -- NOT RECORDED",CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); 568 # show attempt answers 569 # don't show correct answers 570 # don't show attempt results (correctness) 571 # show attempt previews 572 } 573 574 print CGI::end_div(); 575 576 print CGI::start_div({class=>"problem"}); 577 578 # main form 579 print 580 CGI::startform("POST", $r->uri), 581 $self->hidden_authen_fields, 582 CGI::p($pg->{body_text}), 583 CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})), 584 CGI::p( 585 ($can{showCorrectAnswers} 586 ? CGI::checkbox( 587 -name => "showCorrectAnswers", 588 -checked => $will{showCorrectAnswers}, 589 -label => "Show correct answers", 590 ) ." " 591 : "" ), 592 ($can{showHints} 593 ? CGI::checkbox( 594 -name => "showHints", 595 -checked => $will{showHints}, 596 -label => "Show Hints", 597 ) . " " 598 : " " ), 599 ($can{showSolutions} 600 ? CGI::checkbox( 601 -name => "showSolutions", 602 -checked => $will{showSolutions}, 603 -label => "Show Solutions", 604 ) . " " 605 : " " ),CGI::br(), 606 CGI::submit(-name=>"previewAnswers", 607 -label=>"Preview Answers"), 608 ($can{recordAnswers} 609 ? CGI::submit(-name=>"submitAnswers", 610 -label=>"Submit Answers") 611 : ""), 612 ( $can{checkAnswers} 613 ? CGI::submit(-name=>"checkAnswers", 614 -label=>"Check Answers") 615 : ""), 616 ); 617 print CGI::end_div(); 618 619 print CGI::start_div({class=>"scoreSummary"}); 620 621 # score summary 622 my $attempts = $problem->num_correct + $problem->num_incorrect; 623 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 624 my $lastScore = sprintf("%.0f%%", $problem->status * 100); # Round to whole number 625 my ($attemptsLeft, $attemptsLeftNoun); 626 if ($problem->max_attempts == -1) { 627 # unlimited attempts 628 $attemptsLeft = "unlimited"; 629 $attemptsLeftNoun = "attempts"; 630 } else { 631 $attemptsLeft = $problem->max_attempts - $attempts; 632 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 633 } 634 635 my $setClosed = 0; 636 my $setClosedMessage; 637 if (time < $set->open_date or time > $set->due_date) { 638 $setClosed = 1; 639 $setClosedMessage = "This problem set is closed."; 640 if ($permissionLevel > 0) { 641 $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; 642 } else { 643 $setClosedMessage .= " Additional attempts will not be recorded."; 644 } 645 } 646 print CGI::p( 647 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", 648 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), 649 $problem->attempted 650 ? "Your recorded score is $lastScore." . CGI::br() 651 : "", 652 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." 653 ); 654 print CGI::end_div(); 655 656 # save state for viewOptions 657 print CGI::hidden( 658 -name => "showOldAnswers", 659 -value => $will{showOldAnswers} 660 ), 661 662 CGI::hidden( 663 -name => "displayMode", 664 -value => $self->{displayMode} 665 ); 666 667 # end of main form 668 print CGI::endform(); 669 670 # stuff we need below (pull these out at the beginning?) 671 my $ce = $self->{ce}; 672 my $root = $ce->{webworkURLs}->{root}; 673 my $courseName = $ce->{courseName}; 674 675 print CGI::start_div({class=>"problemFooter"}); 676 677 # arguments for answer inspection button 678 my $prof_url = $ce->{webworkURLs}->{oldProf}; 679 my $webworkURL = $ce->{webworkURLs}->{root}; 680 my $cgi_url = $prof_url; 681 $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl 682 my $authen_args = $self->url_authen_args(); 683 my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/"; 684 685 # print answer inspection button 686 if ($self->{permissionLevel} > 0) { 687 print "\n", 688 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", 689 $self->hidden_authen_fields,"\n", 690 CGI::hidden(-name => 'course', -value=>$courseName), "\n", 691 CGI::hidden(-name => 'problemNumber', -value=>$problem->problem_id), "\n", 692 CGI::hidden(-name => 'setName', -value=>$problem->set_id), "\n", 693 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", 694 CGI::p( {-align=>"left"}, 695 CGI::submit(-name => 'action', -value=>'Show Past Answers') 696 ), "\n", 697 CGI::endform(); 698 } 699 700 #print CGI::end_div(); 701 # 702 #print CGI::start_div(); 703 704 # arguments for feedback form 705 my $feedbackURL = "$root/$courseName/feedback/"; 706 707 #print feedback form 708 print 709 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", 710 $self->hidden_authen_fields,"\n", 711 CGI::hidden("module", __PACKAGE__),"\n", 712 CGI::hidden("set", $set->set_id),"\n", 713 CGI::hidden("problem", $problem->problem_id),"\n", 714 CGI::hidden("displayMode", $self->{displayMode}),"\n", 715 CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", 716 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", 717 CGI::hidden("showHints", $will{showHints}),"\n", 718 CGI::hidden("showSolutions", $will{showSolutions}),"\n", 719 CGI::p({-align=>"left"}, 720 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") 721 ), 722 CGI::endform(),"\n"; 723 724 # FIXME print editor link 725 # print editor link if the user is an instructor AND the file is not in temporary editing mode 726 if ($self->{permissionLevel}>=10 and ( (not defined($self->{edit_mode})) or $self->{edit_mode} eq 'savedFile') ) { 727 print CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/".$set->set_id. 728 '/'.$problem->problem_id.'?'.$self->url_authen_args},'Edit this problem'); 729 } 730 731 print CGI::end_div(); 732 733 # warning output 734 #if ($pg->{warnings} ne "") { 735 # print CGI::hr(), $self->warningOutput($pg->{warnings}); 736 #} 737 738 # debugging stuff 739 if (0) { 740 print 741 CGI::hr(), 742 CGI::h2("debugging information"), 743 CGI::h3("form fields"), 744 ref2string($self->{formFields}), 745 CGI::h3("user object"), 746 ref2string($self->{user}), 747 CGI::h3("set object"), 748 ref2string($set), 749 CGI::h3("problem object"), 750 ref2string($problem), 751 CGI::h3("PG object"), 752 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 753 } 754 755 return ""; 756 } 757 758 ##### output utilities ##### 759 760 sub attemptResults($$$$$$) { 761 my $self = shift; 762 my $pg = shift; 763 my $showAttemptAnswers = shift; 764 my $showCorrectAnswers = shift; 765 my $showAttemptResults = $showAttemptAnswers && shift; 766 my $showSummary = shift; 767 my $showAttemptPreview = shift || 0; 768 my $ce = $self->{ce}; 769 my $problemResult = $pg->{result}; # the overall result of the problem 770 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 771 772 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 773 774 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 775 my $imgGen = WeBWorK::PG::ImageGenerator->new( 776 tempDir => $ce->{webworkDirs}->{tmp}, 777 latex => $ce->{externalPrograms}->{latex}, 778 dvipng => $ce->{externalPrograms}->{dvipng}, 779 useCache => 1, 780 cacheDir => $ce->{webworkDirs}->{equationCache}, 781 cacheURL => $ce->{webworkURLs}->{equationCache}, 782 cacheDB => $ce->{webworkFiles}->{equationCacheDB}, 783 ); 784 785 my $header; 786 #$header .= CGI::th("Part"); 787 $header .= $showAttemptAnswers ? CGI::th("Entered") : ""; 788 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : ""; 789 $header .= $showCorrectAnswers ? CGI::th("Correct") : ""; 790 $header .= $showAttemptResults ? CGI::th("Result") : ""; 791 $header .= $showMessages ? CGI::th("messages") : ""; 792 my @tableRows = ( $header ); 793 my $numCorrect; 794 foreach my $name (@answerNames) { 795 my $answerResult = $pg->{answers}->{$name}; 796 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 797 my $preview = ($showAttemptPreview 798 ? $self->previewAnswer($answerResult, $imgGen) 799 : ""); 800 my $correctAnswer = $answerResult->{correct_ans}; 801 my $answerScore = $answerResult->{score}; 802 my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; 803 #FIXME --Can we be sure that $answerScore is an integer-- could the problem give partial credit? 804 $numCorrect += $answerScore > 0; 805 my $resultString = $answerScore ? "correct" : "incorrect"; 806 807 # get rid of the goofy prefix on the answer names (supposedly, the format 808 # of the answer names is changeable. this only fixes it for "AnSwEr" 809 #$name =~ s/^AnSwEr//; 810 811 my $row; 812 #$row .= CGI::td($name); 813 $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : ""; 814 $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : ""; 815 $row .= $showCorrectAnswers ? CGI::td(nbsp($correctAnswer)) : ""; 816 $row .= $showAttemptResults ? CGI::td(nbsp($resultString)) : ""; 817 $row .= $answerMessage ? CGI::td(nbsp($answerMessage)) : ""; 818 push @tableRows, $row; 819 } 820 821 # render equation images 822 $imgGen->render(refresh => 1); 823 824 # my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; 825 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); 826 # FIXME -- I left the old code in in case we have to back out. 827 # my $summary = "On this attempt, you answered $numCorrect out of " 828 # . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; 829 my $summary = ""; 830 if (scalar @answerNames == 1) { 831 if ($numCorrect == scalar @answerNames) { 832 $summary .= "The above answer is correct."; 833 } else { 834 $summary .= "The above answer is NOT correct."; 835 } 836 } else { 837 if ($numCorrect == scalar @answerNames) { 838 $summary .= "All of the above answers are correct."; 839 } else { 840 $summary .= "At least one of the above answers is NOT correct."; 841 } 842 } 843 #FIXME there must be a better way to force refresh. 844 my $refresh_warning = 'Hold down shift and click "refresh" or "reload" to update answer preview images.'; 845 return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . 846 CGI::div({style=>'color:red; font-size:10pt'},$refresh_warning) . 847 ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); 848 } 849 sub nbsp { 850 my $str = shift; 851 ($str =~/\S/) ? $str : ' ' ; # returns non-breaking space for empty strings 852 # tricky cases: $str =0; 853 # $str is a complex number 854 } 855 sub viewOptions($) { 856 my $self = shift; 857 my $displayMode = $self->{displayMode}; 858 my %must = %{ $self->{must} }; 859 my %can = %{ $self->{can} }; 860 my %will = %{ $self->{will} }; 861 862 my $optionLine; 863 $can{showOldAnswers} and $optionLine .= join "", 864 "Show: ".CGI::br(), 865 CGI::checkbox( 866 -name => "showOldAnswers", 867 -checked => $will{showOldAnswers}, 868 -label => "Saved answers", 869 ), " ".CGI::br(); 870 871 $optionLine and $optionLine .= join "", CGI::br(); 872 873 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"}, 874 "View equations as: ".CGI::br(), 875 CGI::radio_group( 876 -name => "displayMode", 877 -values => ['plainText', 'formattedText', 'images'], 878 -default => $displayMode, 879 -linebreak=>'true', 880 -labels => { 881 plainText => "plain", 882 formattedText => "formatted", 883 images => "images", 884 } 885 ), CGI::br(),CGI::hr(), 886 $optionLine, 887 CGI::submit(-name=>"redisplay", -label=>"Save Options"), 888 ); 889 } 890 891 sub previewAnswer($$) { 892 my ($self, $answerResult, $imgGen) = @_; 893 my $ce = $self->{ce}; 894 my $effectiveUser = $self->{effectiveUser}; 895 my $set = $self->{set}; 896 my $problem = $self->{problem}; 897 my $displayMode = $self->{displayMode}; 898 899 # note: right now, we have to do things completely differently when we are 900 # rendering math from INSIDE the translator and from OUTSIDE the translator. 901 # so we'll just deal with each case explicitly here. there's some code 902 # duplication that can be dealt with later by abstracting out tth/dvipng/etc. 903 904 my $tex = $answerResult->{preview_latex_string}; 905 906 return "" unless defined $tex and $tex ne ""; 907 908 if ($displayMode eq "plainText") { 909 return $tex; 910 } elsif ($displayMode eq "formattedText") { 911 my $tthCommand = $ce->{externalPrograms}->{tth} 912 . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" 913 . "\\(".$tex."\\)\n" 914 . "END_OF_INPUT\n"; 915 916 # call tth 917 my $result = `$tthCommand`; 918 if ($?) { 919 return "<b>[tth failed: $? $@]</b>"; 920 } 921 return $result; 922 } elsif ($displayMode eq "images") { 923 ## how are we going to name this? 924 #my $targetPathCommon = "/m2i/" 925 # . $effectiveUser->user_id . "." 926 # . $set->set_id . "." 927 # . $problem->problem_id . "." 928 # . $answerResult->{ans_name} . ".png"; 929 # 930 ## figure out where to put things 931 #my $wd = makeTempDirectory($ce->{courseDirs}->{html_temp}, "webwork-dvipng"); 932 #my $latex = $ce->{externalPrograms}->{latex}; 933 #my $dvipng = $ce->{externalPrograms}->{dvipng}; 934 #my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon; 935 # # should use surePathToTmpFile, but we have to 936 # # isolate it from the problem enivronment first 937 #my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon; 938 # 939 ## call dvipng to generate a preview 940 #dvipng($wd, $latex, $dvipng, $tex, $targetPath); 941 #rmtree($wd, 0, 0); 942 #if (-e $targetPath) { 943 # return "<img src=\"$targetURL\" alt=\"$tex\" />"; 944 #} else { 945 # return "<b>[math2img failed]</b>"; 946 #} 947 $imgGen->add($answerResult->{preview_latex_string}); 948 949 } 950 } 951 952 ##### logging subroutine #### 953 954 955 956 ##### permission queries ##### 957 958 # this stuff should be abstracted out into the permissions system 959 # however, the permission system only knows about things in the 960 # course environment and the username. hmmm... 961 962 # also, i should fix these so that they have a consistent calling 963 # format -- perhaps: 964 # canPERM($courseEnv, $user, $set, $problem, $permissionLevel) 965 966 sub canShowCorrectAnswers($$) { 967 my ($permissionLevel, $answerDate) = @_; 968 return $permissionLevel > 0 || time > $answerDate; 969 } 970 971 sub canShowSolutions($$) { 972 my ($permissionLevel, $answerDate) = @_; 973 return canShowCorrectAnswers($permissionLevel, $answerDate); 974 } 975 976 sub canRecordAnswers($$$$$) { 977 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; 978 my $permHigh = $permissionLevel > 0; 979 my $timeOK = time >= $openDate && time <= $dueDate; 980 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts; 981 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK); 982 return $recordAnswers; 983 } 984 985 sub canCheckAnswers($$) { 986 my ($permissionLevel, $answerDate) = @_; 987 my $permHigh = $permissionLevel > 0; 988 my $timeOK = time >= $answerDate; 989 my $recordAnswers = $permHigh || $timeOK; 990 return $recordAnswers; 991 } 992 993 sub mustRecordAnswers($) { 994 my ($permissionLevel) = @_; 995 return $permissionLevel == 0; 996 } 997 998 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |