Parent Directory
| 
Revision Log
Fixed problem in logic which kept an edited problem from reading the .tmp file when the answer was submitted. Now the editMode variable and sourceFilePath variables are passed on as hidden variables by Problem.pm if they exists in the input form. This fixes bug #179 as well as bug #109. The temporary file is now labeled fileName.pg.user.tmp where user is the login name of the person editing the file. If that file exists then pgProblemEditor will attempt to use that as a source file. The revert button forces a read from fileName.pg --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 print( CGI::hidden( 668 -name => 'editMode', 669 -value => $self->{editMode}, 670 ) 671 ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile'; 672 print( CGI::hidden( 673 -name => 'sourceFilePath', 674 -value => $self->{problem}->{source_file} 675 )) if defined($self->{problem}->{source_file}); 676 677 # end of main form 678 print CGI::endform(); 679 680 # stuff we need below (pull these out at the beginning?) 681 my $ce = $self->{ce}; 682 my $root = $ce->{webworkURLs}->{root}; 683 my $courseName = $ce->{courseName}; 684 685 print CGI::start_div({class=>"problemFooter"}); 686 687 # arguments for answer inspection button 688 my $prof_url = $ce->{webworkURLs}->{oldProf}; 689 my $webworkURL = $ce->{webworkURLs}->{root}; 690 my $cgi_url = $prof_url; 691 $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl 692 my $authen_args = $self->url_authen_args(); 693 my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/"; 694 695 # print answer inspection button 696 if ($self->{permissionLevel} > 0) { 697 print "\n", 698 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", 699 $self->hidden_authen_fields,"\n", 700 CGI::hidden(-name => 'course', -value=>$courseName), "\n", 701 CGI::hidden(-name => 'problemNumber', -value=>$problem->problem_id), "\n", 702 CGI::hidden(-name => 'setName', -value=>$problem->set_id), "\n", 703 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", 704 CGI::p( {-align=>"left"}, 705 CGI::submit(-name => 'action', -value=>'Show Past Answers') 706 ), "\n", 707 CGI::endform(); 708 } 709 710 #print CGI::end_div(); 711 # 712 #print CGI::start_div(); 713 714 # arguments for feedback form 715 my $feedbackURL = "$root/$courseName/feedback/"; 716 717 #print feedback form 718 print 719 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", 720 $self->hidden_authen_fields,"\n", 721 CGI::hidden("module", __PACKAGE__),"\n", 722 CGI::hidden("set", $set->set_id),"\n", 723 CGI::hidden("problem", $problem->problem_id),"\n", 724 CGI::hidden("displayMode", $self->{displayMode}),"\n", 725 CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", 726 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", 727 CGI::hidden("showHints", $will{showHints}),"\n", 728 CGI::hidden("showSolutions", $will{showSolutions}),"\n", 729 CGI::p({-align=>"left"}, 730 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") 731 ), 732 CGI::endform(),"\n"; 733 734 # FIXME print editor link 735 # print editor link if the user is an instructor AND the file is not in temporary editing mode 736 if ($self->{permissionLevel}>=10 and ( (not defined($self->{edit_mode})) or $self->{edit_mode} eq 'savedFile') ) { 737 print CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/".$set->set_id. 738 '/'.$problem->problem_id.'?'.$self->url_authen_args},'Edit this problem'); 739 } 740 741 print CGI::end_div(); 742 743 # warning output 744 #if ($pg->{warnings} ne "") { 745 # print CGI::hr(), $self->warningOutput($pg->{warnings}); 746 #} 747 748 # debugging stuff 749 if (0) { 750 print 751 CGI::hr(), 752 CGI::h2("debugging information"), 753 CGI::h3("form fields"), 754 ref2string($self->{formFields}), 755 CGI::h3("user object"), 756 ref2string($self->{user}), 757 CGI::h3("set object"), 758 ref2string($set), 759 CGI::h3("problem object"), 760 ref2string($problem), 761 CGI::h3("PG object"), 762 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 763 } 764 765 return ""; 766 } 767 768 ##### output utilities ##### 769 770 sub attemptResults($$$$$$) { 771 my $self = shift; 772 my $pg = shift; 773 my $showAttemptAnswers = shift; 774 my $showCorrectAnswers = shift; 775 my $showAttemptResults = $showAttemptAnswers && shift; 776 my $showSummary = shift; 777 my $showAttemptPreview = shift || 0; 778 my $ce = $self->{ce}; 779 my $problemResult = $pg->{result}; # the overall result of the problem 780 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 781 782 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 783 784 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 785 my $imgGen = WeBWorK::PG::ImageGenerator->new( 786 tempDir => $ce->{webworkDirs}->{tmp}, 787 latex => $ce->{externalPrograms}->{latex}, 788 dvipng => $ce->{externalPrograms}->{dvipng}, 789 useCache => 1, 790 cacheDir => $ce->{webworkDirs}->{equationCache}, 791 cacheURL => $ce->{webworkURLs}->{equationCache}, 792 cacheDB => $ce->{webworkFiles}->{equationCacheDB}, 793 ); 794 795 my $header; 796 #$header .= CGI::th("Part"); 797 $header .= $showAttemptAnswers ? CGI::th("Entered") : ""; 798 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : ""; 799 $header .= $showCorrectAnswers ? CGI::th("Correct") : ""; 800 $header .= $showAttemptResults ? CGI::th("Result") : ""; 801 $header .= $showMessages ? CGI::th("messages") : ""; 802 my @tableRows = ( $header ); 803 my $numCorrect; 804 foreach my $name (@answerNames) { 805 my $answerResult = $pg->{answers}->{$name}; 806 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 807 my $preview = ($showAttemptPreview 808 ? $self->previewAnswer($answerResult, $imgGen) 809 : ""); 810 my $correctAnswer = $answerResult->{correct_ans}; 811 my $answerScore = $answerResult->{score}; 812 my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; 813 #FIXME --Can we be sure that $answerScore is an integer-- could the problem give partial credit? 814 $numCorrect += $answerScore > 0; 815 my $resultString = $answerScore ? "correct" : "incorrect"; 816 817 # get rid of the goofy prefix on the answer names (supposedly, the format 818 # of the answer names is changeable. this only fixes it for "AnSwEr" 819 #$name =~ s/^AnSwEr//; 820 821 my $row; 822 #$row .= CGI::td($name); 823 $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : ""; 824 $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : ""; 825 $row .= $showCorrectAnswers ? CGI::td(nbsp($correctAnswer)) : ""; 826 $row .= $showAttemptResults ? CGI::td(nbsp($resultString)) : ""; 827 $row .= $answerMessage ? CGI::td(nbsp($answerMessage)) : ""; 828 push @tableRows, $row; 829 } 830 831 # render equation images 832 $imgGen->render(refresh => 1); 833 834 # my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; 835 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); 836 # FIXME -- I left the old code in in case we have to back out. 837 # my $summary = "On this attempt, you answered $numCorrect out of " 838 # . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; 839 my $summary = ""; 840 if (scalar @answerNames == 1) { 841 if ($numCorrect == scalar @answerNames) { 842 $summary .= "The above answer is correct."; 843 } else { 844 $summary .= "The above answer is NOT correct."; 845 } 846 } else { 847 if ($numCorrect == scalar @answerNames) { 848 $summary .= "All of the above answers are correct."; 849 } else { 850 $summary .= "At least one of the above answers is NOT correct."; 851 } 852 } 853 #FIXME there must be a better way to force refresh. 854 my $refresh_warning = 'Hold down shift and click "refresh" or "reload" to update answer preview images.'; 855 return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . 856 CGI::div({style=>'color:red; font-size:10pt'},$refresh_warning) . 857 ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); 858 } 859 sub nbsp { 860 my $str = shift; 861 ($str =~/\S/) ? $str : ' ' ; # returns non-breaking space for empty strings 862 # tricky cases: $str =0; 863 # $str is a complex number 864 } 865 sub viewOptions($) { 866 my $self = shift; 867 my $displayMode = $self->{displayMode}; 868 my %must = %{ $self->{must} }; 869 my %can = %{ $self->{can} }; 870 my %will = %{ $self->{will} }; 871 872 my $optionLine; 873 $can{showOldAnswers} and $optionLine .= join "", 874 "Show: ".CGI::br(), 875 CGI::checkbox( 876 -name => "showOldAnswers", 877 -checked => $will{showOldAnswers}, 878 -label => "Saved answers", 879 ), " ".CGI::br(); 880 881 $optionLine and $optionLine .= join "", CGI::br(); 882 883 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"}, 884 "View equations as: ".CGI::br(), 885 CGI::radio_group( 886 -name => "displayMode", 887 -values => ['plainText', 'formattedText', 'images'], 888 -default => $displayMode, 889 -linebreak=>'true', 890 -labels => { 891 plainText => "plain", 892 formattedText => "formatted", 893 images => "images", 894 } 895 ), CGI::br(),CGI::hr(), 896 $optionLine, 897 CGI::submit(-name=>"redisplay", -label=>"Save Options"), 898 ); 899 } 900 901 sub previewAnswer($$) { 902 my ($self, $answerResult, $imgGen) = @_; 903 my $ce = $self->{ce}; 904 my $effectiveUser = $self->{effectiveUser}; 905 my $set = $self->{set}; 906 my $problem = $self->{problem}; 907 my $displayMode = $self->{displayMode}; 908 909 # note: right now, we have to do things completely differently when we are 910 # rendering math from INSIDE the translator and from OUTSIDE the translator. 911 # so we'll just deal with each case explicitly here. there's some code 912 # duplication that can be dealt with later by abstracting out tth/dvipng/etc. 913 914 my $tex = $answerResult->{preview_latex_string}; 915 916 return "" unless defined $tex and $tex ne ""; 917 918 if ($displayMode eq "plainText") { 919 return $tex; 920 } elsif ($displayMode eq "formattedText") { 921 my $tthCommand = $ce->{externalPrograms}->{tth} 922 . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" 923 . "\\(".$tex."\\)\n" 924 . "END_OF_INPUT\n"; 925 926 # call tth 927 my $result = `$tthCommand`; 928 if ($?) { 929 return "<b>[tth failed: $? $@]</b>"; 930 } 931 return $result; 932 } elsif ($displayMode eq "images") { 933 ## how are we going to name this? 934 #my $targetPathCommon = "/m2i/" 935 # . $effectiveUser->user_id . "." 936 # . $set->set_id . "." 937 # . $problem->problem_id . "." 938 # . $answerResult->{ans_name} . ".png"; 939 # 940 ## figure out where to put things 941 #my $wd = makeTempDirectory($ce->{courseDirs}->{html_temp}, "webwork-dvipng"); 942 #my $latex = $ce->{externalPrograms}->{latex}; 943 #my $dvipng = $ce->{externalPrograms}->{dvipng}; 944 #my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon; 945 # # should use surePathToTmpFile, but we have to 946 # # isolate it from the problem enivronment first 947 #my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon; 948 # 949 ## call dvipng to generate a preview 950 #dvipng($wd, $latex, $dvipng, $tex, $targetPath); 951 #rmtree($wd, 0, 0); 952 #if (-e $targetPath) { 953 # return "<img src=\"$targetURL\" alt=\"$tex\" />"; 954 #} else { 955 # return "<b>[math2img failed]</b>"; 956 #} 957 $imgGen->add($answerResult->{preview_latex_string}); 958 959 } 960 } 961 962 ##### logging subroutine #### 963 964 965 966 ##### permission queries ##### 967 968 # this stuff should be abstracted out into the permissions system 969 # however, the permission system only knows about things in the 970 # course environment and the username. hmmm... 971 972 # also, i should fix these so that they have a consistent calling 973 # format -- perhaps: 974 # canPERM($courseEnv, $user, $set, $problem, $permissionLevel) 975 976 sub canShowCorrectAnswers($$) { 977 my ($permissionLevel, $answerDate) = @_; 978 return $permissionLevel > 0 || time > $answerDate; 979 } 980 981 sub canShowSolutions($$) { 982 my ($permissionLevel, $answerDate) = @_; 983 return canShowCorrectAnswers($permissionLevel, $answerDate); 984 } 985 986 sub canRecordAnswers($$$$$) { 987 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; 988 my $permHigh = $permissionLevel > 0; 989 my $timeOK = time >= $openDate && time <= $dueDate; 990 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts; 991 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK); 992 return $recordAnswers; 993 } 994 995 sub canCheckAnswers($$) { 996 my ($permissionLevel, $answerDate) = @_; 997 my $permHigh = $permissionLevel > 0; 998 my $timeOK = time >= $answerDate; 999 my $recordAnswers = $permHigh || $timeOK; 1000 return $recordAnswers; 1001 } 1002 1003 sub mustRecordAnswers($) { 1004 my ($permissionLevel) = @_; 1005 return $permissionLevel == 0; 1006 } 1007 1008 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |