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