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