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