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