Parent Directory
| 
Revision Log
Add active javascript timer to gateway quiz module.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm,v 1.9.4.2 2004/07/16 20:06:03 glarose Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::GatewayQuiz; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::GatewayQuiz - display a quiz of problems on one page, 23 deal with versioning sets 24 25 =cut 26 27 # ASSUMPTIONS ABOUT DATABASE DATA 28 # set data includes the new entries: 29 # assignment_type 30 # attempts_per_version 31 # time_interval 32 # versions_per_interval 33 # version_time_limit 34 # version_creation_time 35 # problem_randorder 36 37 use strict; 38 use warnings; 39 use CGI qw(); 40 use File::Path qw(rmtree); 41 use WeBWorK::Form; 42 use WeBWorK::PG; 43 use WeBWorK::PG::ImageGenerator; 44 use WeBWorK::PG::IO; 45 use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory); 46 use WeBWorK::DB::Utils qw(global2user user2global findDefaults); 47 use WeBWorK::Timing; 48 49 use WeBWorK::ContentGenerator::Instructor qw(assignSetVersionToUser); 50 51 # template method 52 sub templateName { 53 return "gateway"; 54 } 55 56 57 ################################################################################ 58 # "can" methods 59 ################################################################################ 60 61 # Subroutines to determine if a user "can" perform an action. Each subroutine is 62 # called with the following arguments: 63 # 64 # ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) 65 66 # *** The "can" routines are taken from Problem.pm, with small modifications 67 # *** to look at number of attempts per version, not per set, and to allow 68 # *** showing of correct answers after all attempts at a version are used 69 70 sub can_showOldAnswers { 71 #my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) = @_; 72 73 return 1; 74 } 75 76 # gateway change here: add $submitAnswers as an optional additional argument 77 # to be included if it's defined 78 sub can_showCorrectAnswers { 79 my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, 80 $submitAnswers) = @_; 81 my $authz = $self->r->authz; 82 83 # gateway change here to allow correct answers to be viewed after all attempts 84 # at a version are exhausted as well as if it's after the answer date 85 # $addOne allows us to count the current submission 86 my $addOne = defined( $submitAnswers ) ? $submitAnswers : 0; 87 my $maxAttempts = $Set->attempts_per_version(); 88 my $attemptsUsed = $Problem->num_correct + $Problem->num_incorrect + 89 $addOne; 90 91 return ( ( after( $Set->answer_date ) || 92 $attemptsUsed >= $maxAttempts ) || 93 $authz->hasPermissions($User->user_id, 94 "show_correct_answers_before_answer_date") ) 95 ; 96 } 97 98 sub can_showHints { 99 #my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) = @_; 100 101 return 1; 102 } 103 104 # gateway change here: add $submitAnswers as an optional additional argument 105 # to be included if it's defined 106 sub can_showSolutions { 107 my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, 108 $submitAnswers) = @_; 109 my $authz = $self->r->authz; 110 111 # this is the same as can_showCorrectAnswers 112 # gateway change here to allow correct answers to be viewed after all attempts 113 # at a version are exhausted as well as if it's after the answer date 114 # $addOne allows us to count the current submission 115 my $addOne = defined( $submitAnswers ) ? $submitAnswers : 0; 116 my $maxAttempts = $Set->attempts_per_version(); 117 my $attemptsUsed = $Problem->num_correct+$Problem->num_incorrect+$addOne; 118 119 return ( ( after( $Set->answer_date ) || 120 $attemptsUsed >= $maxAttempts ) || 121 $authz->hasPermissions($User->user_id, 122 "show_correct_answers_before_answer_date") ) 123 ; 124 } 125 126 # gateway change here: add $submitAnswers as an optional additional argument 127 # to be included if it's defined 128 sub can_recordAnswers { 129 my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, 130 $submitAnswers) = @_; 131 my $authz = $self->r->authz; 132 133 # warn("canrecord: set open/close = " . $Set->open_date . ", " . $Set->due_date . "\n"); 134 135 if ($User->user_id ne $EffectiveUser->user_id) { 136 return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student"); 137 } 138 if (before($Set->open_date)) { 139 # warn("ack1\n"); 140 return $authz->hasPermissions($User->user_id, "record_answers_before_open_date"); 141 } elsif (between($Set->open_date, $Set->due_date)) { 142 143 # gateway change here; we look at maximum attempts per version, not for the set, 144 # to determine the number of attempts allowed 145 # $addOne allows us to count the current submission 146 my $addOne = defined( $submitAnswers ) ? $submitAnswers : 0; 147 my $max_attempts = $Set->attempts_per_version(); 148 my $attempts_used = $Problem->num_correct+$Problem->num_incorrect+$addOne; 149 # warn("max_attempts = $max_attempts, addOne = $addOne, attempts_used = $attempts_used\n"); 150 if ($max_attempts == -1 or $attempts_used < $max_attempts) { 151 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts"); 152 } else { 153 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts"); 154 } 155 } elsif (between($Set->due_date, $Set->answer_date)) { 156 # warn("ack2\n"); 157 return $authz->hasPermissions($User->user_id, "record_answers_after_due_date"); 158 } elsif (after($Set->answer_date)) { 159 # warn("ack3\n"); 160 return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date"); 161 } 162 } 163 164 # gateway change here: add $submitAnswers as an optional additional argument 165 # to be included if it's defined 166 sub can_checkAnswers { 167 my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, 168 $submitAnswers) = @_; 169 my $authz = $self->r->authz; 170 171 if (before($Set->open_date)) { 172 return $authz->hasPermissions($User->user_id, "check_answers_before_open_date"); 173 } elsif (between($Set->open_date, $Set->due_date)) { 174 175 # gateway change here; we look at maximum attempts per version, not for the set, 176 # to determine the number of attempts allowed 177 # $addOne allows us to count the current submission 178 my $addOne = defined( $submitAnswers ) ? $submitAnswers : 0; 179 my $max_attempts = $Set->attempts_per_version(); 180 my $attempts_used = $Problem->num_correct+$Problem->num_incorrect+$addOne; 181 182 if ($max_attempts == -1 or $attempts_used < $max_attempts) { 183 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts"); 184 } else { 185 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts"); 186 } 187 } elsif (between($Set->due_date, $Set->answer_date)) { 188 return $authz->hasPermissions($User->user_id, "check_answers_after_due_date"); 189 } elsif (after($Set->answer_date)) { 190 return $authz->hasPermissions($User->user_id, "check_answers_after_answer_date"); 191 } 192 } 193 194 # Helper functions for calculating times 195 sub before { return time <= $_[0] } 196 sub after { return time >= $_[0] } 197 sub between { my $t = time; return $t > $_[0] && $t < $_[1] } 198 199 ################################################################################ 200 # output utilities 201 ################################################################################ 202 203 # subroutine is modified from that in Problem.pm to produce a different 204 # table format 205 sub attemptResults { 206 my $self = shift; 207 my $pg = shift; 208 my $showAttemptAnswers = shift; 209 my $showCorrectAnswers = shift; 210 my $showAttemptResults = $showAttemptAnswers && shift; 211 my $showSummary = shift; 212 my $showAttemptPreview = shift || 0; 213 214 my $ce = $self->r->ce; 215 216 my $problemResult = $pg->{result}; # the overall result of the problem 217 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 218 219 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 220 221 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 222 223 # to make grabbing these options easier, we'll pull them out now... 224 my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}}; 225 226 my $imgGen = WeBWorK::PG::ImageGenerator->new( 227 tempDir => $ce->{webworkDirs}->{tmp}, 228 latex => $ce->{externalPrograms}->{latex}, 229 dvipng => $ce->{externalPrograms}->{dvipng}, 230 useCache => 1, 231 cacheDir => $ce->{webworkDirs}->{equationCache}, 232 cacheURL => $ce->{webworkURLs}->{equationCache}, 233 cacheDB => $ce->{webworkFiles}->{equationCacheDB}, 234 dvipng_align => $imagesModeOptions{dvipng_align}, 235 dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, 236 ); 237 238 my %resultsData = (); 239 $resultsData{'Entered'} = CGI::td({-class=>"label"}, "Your answer parses as:"); 240 $resultsData{'Preview'} = CGI::td({-class=>"label"}, "Your answer previews as:"); 241 $resultsData{'Correct'} = CGI::td({-class=>"label"}, "The correct answer is:"); 242 $resultsData{'Results'} = CGI::td({-class=>"label"}, "Result:"); 243 $resultsData{'Messages'} = CGI::td({-class=>"label"}, "Messages:"); 244 245 my %resultsRows = (); 246 foreach ( qw( Entered Preview Correct Results Messages ) ) { 247 $resultsRows{$_} = ""; 248 } 249 250 my $numCorrect = 0; 251 my $numAns = 0; 252 foreach my $name (@answerNames) { 253 my $answerResult = $pg->{answers}->{$name}; 254 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 255 my $preview = ($showAttemptPreview 256 ? $self->previewAnswer($answerResult, $imgGen) 257 : ""); 258 my $correctAnswer = $answerResult->{correct_ans}; 259 my $answerScore = $answerResult->{score}; 260 my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; 261 #FIXME --Can we be sure that $answerScore is an integer-- could the problem give partial credit? 262 $numCorrect += $answerScore > 0; 263 my $resultString = $answerScore == 1 ? "correct" : "incorrect"; 264 265 # get rid of the goofy prefix on the answer names (supposedly, the format 266 # of the answer names is changeable. this only fixes it for "AnSwEr" 267 #$name =~ s/^AnSwEr//; 268 269 my $pre = $numAns ? CGI::td(" ") : ""; 270 271 $resultsRows{'Entered'} .= $showAttemptAnswers ? 272 CGI::Tr( $pre . $resultsData{'Entered'} . 273 CGI::td({-class=>"output"}, $self->nbsp($studentAnswer))) : ""; 274 $resultsData{'Entered'} = ''; 275 $resultsRows{'Preview'} .= $showAttemptPreview ? 276 CGI::Tr( $pre . $resultsData{'Preview'} . 277 CGI::td({-class=>"output"}, $self->nbsp($preview)) ) : ""; 278 $resultsData{'Preview'} = ''; 279 $resultsRows{'Correct'} .= $showCorrectAnswers ? 280 CGI::Tr( $pre . $resultsData{'Correct'} . 281 CGI::td({-class=>"output"}, $self->nbsp($correctAnswer)) ) : ""; 282 $resultsData{'Correct'} = ''; 283 $resultsRows{'Results'} .= $showAttemptResults ? 284 CGI::Tr( $pre . $resultsData{'Results'} . 285 CGI::td({-class=>"output"}, $self->nbsp($resultString)) ) : ""; 286 $resultsRows{'Results'} = ''; 287 $resultsRows{'Messages'} .= $showMessages ? 288 CGI::Tr( $pre . $resultsData{'Messages'} . 289 CGI::td({-class=>"output"}, $self->nbsp($answerMessage)) ) : ""; 290 291 $numAns++; 292 } 293 294 # render equation images 295 $imgGen->render(refresh => 1); 296 297 # my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; 298 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); 299 # FIXME -- I left the old code in in case we have to back out. 300 # my $summary = "On this attempt, you answered $numCorrect out of " 301 # . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; 302 303 # *GW* / FIXME we probably want to change this to give a more logical answer 304 # for gateway tests 305 306 my $summary = ""; 307 if (scalar @answerNames == 1) { 308 if ($numCorrect == scalar @answerNames) { 309 $summary .= CGI::div({class=>"gwCorrect"},"This answer is correct."); 310 } else { 311 $summary .= CGI::div({class=>"gwIncorrect"},"This answer is NOT correct."); 312 } 313 } else { 314 if ($numCorrect == scalar @answerNames) { 315 $summary .= CGI::div({class=>"gwCorrect"},"All of these answers are correct."); 316 } else { 317 $summary .= CGI::div({class=>"gwIncorrect"},"At least one of these answers is NOT correct."); 318 } 319 } 320 321 return 322 # CGI::table({-class=>"attemptResults"}, $resultsRows{'Entered'}, 323 CGI::table({-class=>"gwAttemptResults"}, $resultsRows{'Entered'}, 324 $resultsRows{'Preview'}, $resultsRows{'Correct'}, 325 $resultsRows{'Results'}, $resultsRows{'Messages'}) . 326 ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); 327 # CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) 328 # . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); 329 } 330 331 # *BeginPPM* ################################################################### 332 # this code taken from Problem.pm; excerpted section ends at *EndPPM* 333 # modifications are flagged with comments *GW* 334 335 sub viewOptions { 336 my ($self) = @_; 337 my $ce = $self->r->ce; 338 339 # don't show options if we don't have anything to show 340 # return if $self->{invalidSet} or $self->{invalidProblem}; 341 # return unless $self->{isOpen}; 342 return if $self->{invalidSet}; 343 344 my $displayMode = $self->{displayMode}; 345 my %must = %{ $self->{must} }; 346 my %can = %{ $self->{can} }; 347 my %will = %{ $self->{will} }; 348 349 my $optionLine; 350 $can{showOldAnswers} and $optionLine .= join "", 351 "Show: ".CGI::br(), 352 CGI::checkbox( 353 -name => "showOldAnswers", 354 -checked => $will{showOldAnswers}, 355 -label => "Saved answers", 356 ), " ".CGI::br(); 357 358 $optionLine and $optionLine .= join "", CGI::br(); 359 360 my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()}; 361 my @active_modes = grep { exists $display_modes{$_} } 362 @{$ce->{pg}->{displayModes}}; 363 my $modeLine = (scalar(@active_modes) > 1) ? 364 "View equations as: ".CGI::br(). 365 CGI::radio_group( 366 -name => "displayMode", 367 -values => \@active_modes, 368 -default => $displayMode, 369 -linebreak=>'true', 370 -labels => { 371 plainText => "plain", 372 formattedText => "formatted", 373 images => "images", 374 jsMath => "jsMath", 375 asciimath => "asciimath", 376 }, 377 ). CGI::br().CGI::hr() : ''; 378 379 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"}, 380 $modeLine, 381 $optionLine, 382 CGI::submit(-name=>"redisplay", -label=>"Apply Options"), 383 ); 384 } 385 386 sub previewAnswer { 387 my ($self, $answerResult, $imgGen) = @_; 388 my $ce = $self->r->ce; 389 my $EffectiveUser = $self->{effectiveUser}; 390 my $set = $self->{set}; 391 my $problem = $self->{problem}; 392 my $displayMode = $self->{displayMode}; 393 394 # note: right now, we have to do things completely differently when we are 395 # rendering math from INSIDE the translator and from OUTSIDE the translator. 396 # so we'll just deal with each case explicitly here. there's some code 397 # duplication that can be dealt with later by abstracting out tth/dvipng/etc. 398 399 my $tex = $answerResult->{preview_latex_string}; 400 401 return "" unless defined $tex and $tex ne ""; 402 403 if ($displayMode eq "plainText") { 404 return $tex; 405 } elsif ($displayMode eq "formattedText") { 406 my $tthCommand = $ce->{externalPrograms}->{tth} 407 . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" 408 . "\\(".$tex."\\)\n" 409 . "END_OF_INPUT\n"; 410 411 # call tth 412 my $result = `$tthCommand`; 413 if ($?) { 414 return "<b>[tth failed: $? $@]</b>"; 415 } else { 416 return $result; 417 } 418 } elsif ($displayMode eq "images") { 419 $imgGen->add($tex); 420 } elsif ($displayMode eq "jsMath") { 421 return '<DIV CLASS="math">'.$tex.'</DIV>' ; 422 } 423 } 424 425 # *EndPPM ###################################################################### 426 427 ################################################################################ 428 # Template escape implementations 429 ################################################################################ 430 431 # FIXME need to make $Set and $set be used consistently 432 433 sub pre_header_initialize { 434 my ($self) = @_; 435 436 my $r = $self->r; 437 my $ce = $r->ce; 438 my $db = $r->db; 439 my $authz = $r->authz; 440 my $urlpath = $r->urlpath; 441 442 my $setName = $urlpath->arg("setID"); 443 my $userName = $r->param('user'); 444 my $effectiveUserName = $r->param('effectiveUser'); 445 my $key = $r->param('key'); 446 447 # this is a horrible hack to allow use of a javascript link to trigger 448 # the preview of the page: set previewAnswers to yes if either the 449 # "previewAnswers" or "previewhack" inputs are set 450 my $prevOr = $r->param('previewAnswers') || $r->param('previewHack'); 451 $r->param('previewAnswers', $prevOr) if ( defined( $prevOr ) ); 452 453 my $User = $db->getUser($userName); 454 die "record for user $userName (real user) does not exist." 455 unless defined $User; 456 my $EffectiveUser = $db->getUser($effectiveUserName); 457 die "record for user $effectiveUserName (effective user) does not exist." 458 unless defined $EffectiveUser; 459 460 my $PermissionLevel = $db->getPermissionLevel($userName); 461 die "permission level record for $userName does not exist (but the " . 462 "user does? odd...)" unless defined($PermissionLevel); 463 my $permissionLevel = $PermissionLevel->permission; 464 465 # we could be coming in with $setName = the versioned or nonversioned set 466 # deal with that first 467 my $requestedVersion = ( $setName =~ /,v(\d+)$/ ) ? $1 : ''; 468 $setName =~ s/,v\d+$//; 469 # note that if we're already working with a version we want to be sure to stick 470 # with that version. we do this after we've validated that the user is 471 # assigned the set, below 472 473 ################################### 474 # gateway content generator tests 475 ################################### 476 477 # get template set: the non-versioned set that's assigned to the user 478 my $tmplSet = $db->getMergedSet( $effectiveUserName, $setName ); 479 die( "Set $setName hasn't been assigned to effective user " . 480 $effectiveUserName ) unless( defined( $tmplSet ) ); 481 482 # ok, get the version number if we should be required to stay with a version 483 $requestedVersion = 484 $db->getUserSetVersionNumber($effectiveUserName, $setName) 485 if ( ( $r->param("previewAnswers") || $r->param("checkAnswers") || 486 $r->param("submitAnswers") ) && ! $requestedVersion ); 487 die("Requested version 0 when returning to problem?!") 488 if ( ( $r->param("previewAnswers") || $r->param("checkAnswers") || 489 $r->param("submitAnswers") ) && ! $requestedVersion ); 490 491 # FIXME should we be more subtle than just die()ing here? c.f. Problem.pm 492 # $self->{invalidSet} FIXME (also, if getMergedSet() returns undef for 493 # sets not assigned to users, why does Problem.pm resort to the logic 494 # (grep /^$setName/, $db->listUserSets($effectiveUserName)) == 0)? 495 die( "Invalid set $setName requested" ) 496 if ( ! ( $tmplSet->published || 497 $authz->hasPermissions($userName,"view_unpublished_sets") ) ); 498 499 # if this set isn't a gateway test, we're in the wrong content generator 500 die("Set $setName isn't a gateway test. Error in ContentGenerator " . 501 "call.") if ( ! defined( $tmplSet->assignment_type() ) || 502 $tmplSet->assignment_type() !~ /gateway/i ); 503 504 # now we know that we're in a gateway test, save the assignment test for 505 # the processing of proctor keys for graded proctored tests 506 $self->{'assignment_type'} = $tmplSet->assignment_type(); 507 508 # to test for a proctored test, we need the set version, not the template, 509 # which allows for a finished proctored test to be checked as an 510 # unproctored test. so we get the versioned set here 511 my $set = $db->getMergedVersionedSet($effectiveUserName, $setName, 512 $requestedVersion); 513 unless (defined $set) { 514 my $userSetClass = $ce->{dbLayout}->{set_user}->{record}; 515 $set = global2user($userSetClass, $db->getGlobalSet($setName)); 516 die "set $setName not found." unless $set; 517 $set->user_id($effectiveUserName); 518 $set->psvn('000'); 519 $set->set_id("$setName,v0"); # set to establish the version number only 520 } 521 my $setVersionName = $set->set_id(); 522 my ($setVersionNumber) = ($setVersionName =~ /.*,v(\d+)$/); 523 524 # debugging global2user 525 # if ( defined($set) ) { 526 # my $str = ''; 527 # foreach ( map {$_} $db->newUserSet->FIELDS ) { 528 # $str .= "** $_ => " . $set->$_ . "\n"; 529 # } 530 # warn("** got set $setName (reqVer = $requestedVersion)\n$str\n"); 531 # } 532 533 # FIXME: this needs to check the set version, not the template, for the 534 # case of a finished proctored test FIXME 535 # and check for a valid proctor login, to be sure that no one is trying 536 # to abuse the url path to sneak in the back door on a proctored test 537 die("Set $setName requires a valid proctor login.") 538 if ( $tmplSet->assignment_type() =~ /proctored/i && 539 ! WeBWorK::Authen->new($r, $ce, $db)->verifyProctor() ); 540 541 ################################# 542 # assemble gateway parameters 543 ################################# 544 545 # we get the open/close dates for the gateway from the template set. 546 # note $isOpen/Closed give the open/close dates for the gateway as a whole 547 my $isOpen = after($tmplSet->open_date()) || 548 $authz->hasPermissions($userName, "view_unopened_sets"); 549 550 # FIXME for $isClosed, "record_answers_after_due_date" isn't quite the 551 # right description, but it's probably reasonable for our purposes FIXME 552 my $isClosed = after($tmplSet->due_date()) && 553 ! $authz->hasPermissions($userName, "record_answers_after_due_date"); 554 555 # to determine if we need a new version, we need to know whether this 556 # version exceeds the number of attempts per version. (among other 557 # things,) the number of attempts is a property of the problem, so 558 # get a problem to check that. note that for a gateway/quiz all 559 # problems will have the same number of attempts. 560 # note that this might not be defined, if the set hasn't been versioned 561 # to the user yet--this gets fixed when we assign the setVersion 562 my $Problem = 563 $db->getMergedVersionedProblem($EffectiveUser->user_id, 564 $setName, $setVersionName, 1); 565 566 # FIXME: is there any case where $maxAttemptsPerVersion shouldn't be 567 # finite? For the moment we don't deal with this here FIXME 568 my $maxAttemptsPerVersion = $tmplSet->attempts_per_version(); 569 my $timeInterval = $tmplSet->time_interval(); 570 my $versionsPerInterval = $tmplSet->versions_per_interval(); 571 my $timeLimit = $tmplSet->version_time_limit(); 572 573 # these both work because every problem in the set must have the same 574 # submission characteristics 575 my $currentNumAttempts = ( defined($Problem) ? $Problem->num_correct() + 576 $Problem->num_incorrect() : 0 ); 577 578 # $maxAttempts turns into the maximum number of versions we can create; 579 # if $Problem isn't defined, we can't have made any attempts, so it 580 # doesn't matter 581 # FIXME: I'm using max_attempts == 0, instead of -1; does this matter? 582 my $maxAttempts = ( defined($Problem) && 583 defined($Problem->max_attempts()) && 584 $Problem->max_attempts() != -1 ? 585 $Problem->max_attempts() : 0 ); 586 587 # finding the number of versions per time interval is a little harder. we 588 # interpret the time interval as a rolling interval: that is, if we allow 589 # two sets per day, that's two sets in any 24 hour period. this is 590 # probably not what we really want, but it's more extensible to a 591 # limitation like "one version per hour", and we can set it to two sets 592 # per 12 hours for most "2ce daily" type applications 593 my $timeNow = time(); 594 my $currentNumVersions = 0; # this is the number of versions in the last 595 # time interval 596 my $totalNumVersions = 0; 597 598 if ( $setVersionNumber ) { 599 my @setVersions = $db->getUserSetVersions($effectiveUserName,$setName, 600 $setVersionNumber); 601 foreach ( @setVersions ) { 602 $totalNumVersions++; 603 $currentNumVersions++ 604 if ( $_->version_creation_time() > ($timeNow - $timeInterval) ); 605 } 606 } 607 608 #################################### 609 # new version creation conditional 610 #################################### 611 612 my $versionIsOpen = 0; # can we do anything to this version? 613 $timeNow -= 5; # be safe with $timeNow 614 615 if ( $isOpen && ! $isClosed ) { # this makes sense, really 616 617 # if no specific version is requested, we can create a new one if 618 # need be 619 if ( ! $requestedVersion ) { 620 if ( 621 ( ! $maxAttempts || $totalNumVersions < $maxAttempts ) 622 && 623 ( $setVersionNumber == 0 || 624 ( 625 ( $currentNumAttempts >= $maxAttemptsPerVersion 626 || 627 $timeNow >= $set->due_date ) 628 && 629 ( ! $versionsPerInterval 630 || 631 $currentNumVersions < $versionsPerInterval ) 632 ) 633 ) 634 && 635 ( $effectiveUserName eq $userName || 636 $authz->hasPermissions($effectiveUserName, 637 "record_answers_when_acting_as_student") ) 638 ) { 639 640 # assign set, get the right name, version number, etc., and redefine 641 # the $set and $Problem we're working with 642 my $setTmpl = $db->getUserSet($effectiveUserName,$setName); 643 WeBWorK::ContentGenerator::Instructor::assignSetVersionToUser( 644 $self, $effectiveUserName, $setTmpl); 645 $setVersionNumber++; 646 $setVersionName = "$setName,v$setVersionNumber"; 647 $set = $db->getMergedVersionedSet($userName,$setName, 648 $setVersionNumber); 649 # debugging problem merging 650 # if ( defined($set) ) { 651 # my $str = ''; 652 # foreach ( map {$_} $db->newUserSet->FIELDS ) { 653 # $str .= "** $_ => >" . $set->$_ . "<\n"; 654 # } 655 # warn("** got set $setName (reqVer = $requestedVersion)\n$str\n"); 656 # } 657 $Problem = $db->getMergedVersionedProblem($userName,$setName, 658 $setVersionName,1); 659 # because we're creating this on the fly, it should be published 660 $set->published(1); 661 # set up creation time, open and due dates 662 $set->version_creation_time( $timeNow ); 663 $set->open_date( $timeNow ); 664 $set->due_date( $timeNow+$timeLimit ); 665 $set->answer_date( $timeNow+$timeLimit ); 666 # put this new info into the database. note that this means that -all- of 667 # the merged information gets put back into the database. as long as 668 # the version doesn't have a long lifespan, this is ok... 669 $db->putVersionedUserSet( $set ); 670 671 # we have a new set version, so it's open 672 $versionIsOpen = 1; 673 674 # also reset the number of attempts for this set; this will be zero 675 $currentNumAttempts = $Problem->num_correct() + 676 $Problem->num_incorrect(); 677 678 } elsif ( $maxAttempts && $totalNumVersions > $maxAttempts ) { 679 $self->{invalidSet} = "No new versions of this assignment " . 680 "are available,\nbecause you have already taken the " . 681 "maximum number\nallowed."; 682 683 } elsif ( $currentNumAttempts < $maxAttemptsPerVersion && 684 $timeNow < $set->due_date() ) { 685 686 if ( between($timeNow, $set->open_date(), $set->due_date()) ) { 687 $versionIsOpen = 1; 688 } else { 689 $versionIsOpen = 0; # redundant; default is 0 690 } 691 692 } elsif ( $versionsPerInterval && 693 ( $currentNumVersions >= $versionsPerInterval ) ) { 694 $self->{invalidSet} = "You have already taken all available " . 695 "versions of this\ntest in the current time interval. " . 696 "You may take the\ntest again after the time interval " . 697 "has expired."; 698 699 # old conditional 700 # } elsif ( 701 # ( $currentNumAttempts < $maxAttemptsPerVersion ) 702 # && 703 # ( $effectiveUserName eq $userName || 704 # $authz->hasPermissions($effectiveUserName, 705 # "record_answers_when_acting_as_student") ) 706 # ) { 707 # # only check to see if the version is open 708 # if ( between($timeNow, $set->open_date(), $set->due_date()) ) { 709 # $versionIsOpen = 1; 710 # } else { 711 # $versionIsOpen = 0; # redundant; default is 0 712 # } 713 # this resets times on every preview. not what we want. 714 # # reset times for the existing set if we're allowed another attempt 715 # $set->open_date( $timeNow ); 716 # $set->due_date( $timeNow+$timeLimit ); 717 # $set->answer_date( $timeNow+$timeLimit ); 718 # # put this new info into the database. note that this means that -all- of 719 # # the merged information gets put back into the database. as long as 720 # # the version doesn't have a long lifespan, this is ok... 721 # $db->putVersionedUserSet( $set ); 722 } 723 724 } else { 725 # (we're still in the $isOpen && ! $isClosed conditional here) 726 # if a specific version is requested, then we only check to see if it's open 727 if ( 728 ( $currentNumAttempts < $maxAttemptsPerVersion ) 729 && 730 ( $effectiveUserName eq $userName || 731 $authz->hasPermissions($effectiveUserName, 732 "record_answers_when_acting_as_student") ) 733 ) { 734 if ( between($timeNow, $set->open_date(), $set->due_date()) ) { 735 $versionIsOpen = 1; 736 } else { 737 $versionIsOpen = 0; # redundant; default is 0 738 } 739 } 740 } 741 742 # set isn't available. 743 } else { 744 # die("No available set version is available for $userName, and " . 745 # "none can be created after the due date.") 746 $self->{invalidSet} = "This assignment is not open."; 747 if ( $isClosed) { 748 $self->{invalidSet} .= "\nPreviously completed versions " . 749 "may be available for practice,\n but no new versions " . 750 "may be obtained at this time.\n"; 751 } 752 } 753 754 755 #################################### 756 # save problem and user data 757 #################################### 758 759 my $psvn = $set->psvn(); 760 $self->{set} = $set; 761 $self->{problem} = $Problem; 762 $self->{requestedVersion} = $requestedVersion; 763 764 $self->{userName} = $userName; 765 $self->{effectiveUserName} = $effectiveUserName; 766 $self->{user} = $User; 767 $self->{effectiveUser} = $EffectiveUser; 768 $self->{permissionLevel} = $permissionLevel; 769 770 $self->{isOpen} = $isOpen; 771 $self->{isClosed} = $isClosed; 772 $self->{versionIsOpen} = $versionIsOpen; 773 774 #################################### 775 # form processing 776 #################################### 777 778 # *BeginPPM* ################################################################### 779 780 # set options from form fields (see comment at top of file for names) 781 my $displayMode = $r->param("displayMode") || 782 $ce->{pg}->{options}->{displayMode}; 783 my $redisplay = $r->param("redisplay"); 784 my $submitAnswers = $r->param("submitAnswers"); 785 my $checkAnswers = $r->param("checkAnswers"); 786 my $previewAnswers = $r->param("previewAnswers"); 787 788 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 789 790 $self->{displayMode} = $displayMode; 791 $self->{redisplay} = $redisplay; 792 $self->{submitAnswers} = $submitAnswers; 793 $self->{checkAnswers} = $checkAnswers; 794 $self->{previewAnswers} = $previewAnswers; 795 $self->{formFields} = $formFields; 796 797 # get result and send to message 798 my $success = $r->param("sucess"); 799 my $failure = $r->param("failure"); 800 $self->addbadmessage(CGI::p($failure)) if $failure; 801 $self->addgoodmessage(CGI::p($success)) if $success; 802 803 # now that we've set all the necessary variables quit out if the set or 804 # problem is invalid 805 return if $self->{invalidSet} || $self->{invalidProblem}; 806 807 # *EndPPM* ##################################################################### 808 809 #################################### 810 # permissions 811 #################################### 812 813 # bail without doing anything if the set isn't yet open for this user 814 return unless $self->{isOpen}; 815 816 # what does the user want to do? 817 my %want = 818 (showOldAnswers => $r->param("showOldAnswers") || 819 $ce->{pg}->{options}->{showOldAnswers}, 820 showCorrectAnswers => $r->param("showCorrectAnswers") || 821 $ce->{pg}->{options}->{showCorrectAnswers}, 822 showHints => $r->param("showHints") || 823 $ce->{pg}->{options}->{showHints}, 824 showSolutions => $r->param("showSolutions") || 825 $ce->{pg}->{options}->{showSolutions}, 826 recordAnswers => $submitAnswers, 827 checkAnswers => $checkAnswers, 828 ); 829 830 # are certain options enforced? 831 my %must = 832 (showOldAnswers => 0, 833 showCorrectAnswers => 0, 834 showHints => 0, 835 showSolutions => 0, 836 recordAnswers => ! $authz->hasPermissions($userName, 837 "avoid_recording_answers"), 838 checkAnswers => 0, 839 ); 840 841 # does the user have permission to use certain options? 842 my @args = ($User, $PermissionLevel, $EffectiveUser, $set, $Problem ); 843 my $sAns = ( $submitAnswers ? 1 : 0 ); 844 my %can = 845 (showOldAnswers => $self->can_showOldAnswers(@args), 846 showCorrectAnswers => $self->can_showCorrectAnswers(@args, $sAns), 847 showHints => $self->can_showHints(@args), 848 showSolutions => $self->can_showSolutions(@args, $sAns), 849 recordAnswers => $self->can_recordAnswers(@args), 850 checkAnswers => $self->can_checkAnswers(@args), 851 recordAnswersNextTime => $self->can_recordAnswers(@args, $sAns), 852 checkAnswersNextTime => $self->can_checkAnswers(@args, $sAns), 853 ); 854 855 # final values for options 856 # warn("back - next time, " . $can{recordAnswersNextTime} . "\n"); 857 my %will; 858 foreach (keys %must) { 859 $will{$_} = $can{$_} && ($must{$_} || $want{$_}) ; 860 } 861 862 ##### store fields ##### 863 864 ## FIXME: the following is present in Problem.pm, but missing here. how do we 865 ## deal with it in the context of multiple problems with possible hints? 866 ## ##### fix hint/solution options ##### 867 ## $can{showHints} &&= $pg->{flags}->{hintExists} 868 ## &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; 869 ## $can{showSolutions} &&= $pg->{flags}->{solutionExists}; 870 871 $self->{want} = \%want; 872 $self->{must} = \%must; 873 $self->{can} = \%can; 874 $self->{will} = \%will; 875 876 877 #################################### 878 # process problems 879 #################################### 880 881 my @problemNumbers = $db->listUserProblems($effectiveUserName, 882 $setVersionName); 883 my @problems = (); 884 my @pg_results = (); 885 886 foreach my $problemNumber (sort {$a<=>$b } @problemNumbers) { 887 my $ProblemN = $db->getMergedVersionedProblem($effectiveUserName, 888 $setName, 889 $setVersionName, 890 $problemNumber); 891 892 # sticky answers are set up here 893 if ( not ( $submitAnswers or $previewAnswers or $checkAnswers ) 894 and $will{showOldAnswers} ) { 895 my %oldAnswers = decodeAnswers( $ProblemN->last_answer ); 896 $formFields->{$_} = $oldAnswers{$_} foreach ( keys %oldAnswers ); 897 } 898 push( @problems, $ProblemN ); 899 900 # this is the actual translation of each problem. errors are stored in 901 # @{$self->{errors}} in each case 902 # warn("going into gph: merged problem:\n"); 903 # foreach my $kk ( keys %$ProblemN ) { 904 # warn(" $kk => " . $ProblemN->{$kk} . "\n"); 905 # } 906 my $pg = $self->getProblemHTML( $self->{effectiveUser}, $setVersionName, 907 $formFields, $ProblemN ); 908 push(@pg_results, $pg); 909 } 910 $self->{ra_problems} = \@problems; 911 $self->{ra_pg_results}=\@pg_results; 912 913 } 914 915 sub path { 916 my ( $self, $args ) = @_; 917 918 my $r = $self->{r}; 919 my $setName = $r->urlpath->arg("setID"); 920 my $ce = $self->{ce}; 921 my $root = $ce->{webworkURLs}->{root}; 922 my $courseName = $ce->{courseName}; 923 924 return $self->pathMacro( $args, "Home" => "$root", 925 $courseName => "$root/$courseName", 926 $setName => "" ); 927 } 928 929 sub nav { 930 my ($self, $args) = @_; 931 932 my $r = $self->{r}; 933 my $setName = $r->urlpath->arg("setID"); 934 my $ce = $self->{ce}; 935 my $root = $ce->{webworkURLs}->{root}; 936 my $courseName = $ce->{courseName}; 937 my @links = ("Problem Sets" , "$root/$courseName", "navUp"); 938 my $tail = ""; 939 940 return $self->navMacro($args, $tail, @links); 941 } 942 943 sub options { 944 my ($self) = @_; 945 946 return "" if $self->{invalidProblem}; 947 my $sourceFilePathfield = ''; 948 if($self->r->param("sourceFilePath")) { 949 $sourceFilePathfield = CGI::hidden(-name => "sourceFilePath", 950 -value => $self->r->param("sourceFilePath")); 951 } 952 953 return join("", 954 CGI::start_form("POST", $self->{r}->uri), 955 $self->hidden_authen_fields, 956 $sourceFilePathfield, 957 CGI::hr(), 958 CGI::start_div({class=>"viewOptions"}), 959 $self->viewOptions(), 960 CGI::end_div(), 961 CGI::end_form() 962 ); 963 } 964 965 sub body { 966 my $self = shift(); 967 my $r = $self->r; 968 my $ce = $r->ce; 969 my $db = $r->db; 970 my $authz = $r->authz; 971 my $urlpath = $r->urlpath; 972 my $user = $r->param('user'); 973 my $effectiveUser = $r->param('effectiveUser'); 974 975 ######################################### 976 # preliminary error checking and output 977 ######################################### 978 979 # basic error checking: is the set actually open? 980 unless ( $self->{isOpen} ) { 981 return CGI::div({class=>"ResultsWithError"}, 982 CGI::p("This assignment is not open yet, and " . 983 "therefore is not yet available")); 984 } 985 # if we set the invalid flag, we may want this too 986 if ($self->{invalidSet}) { 987 # delete any proctor keys that are floating around 988 if ( $self->{'assignment_type'} eq 'proctored_gateway' ) { 989 my $proctorID = $r->param('proctor_user'); 990 eval{ $db->deleteKey( "$effectiveUser,$proctorID" ); }; 991 eval{ $db->deleteKey( "$effectiveUser,$proctorID,g" ); }; 992 } 993 994 return CGI::div({class=>"ResultsWithError"}, 995 CGI::p("The selected problem set (" . 996 $urlpath->arg("setID") . ") is not a valid set" . 997 " for $effectiveUser."), 998 CGI::p("This is because: " . $self->{invalidSet})); 999 } 1000 1001 my $set = $self->{set}; 1002 my $Problem = $self->{problem}; 1003 my $permissionLevel = $self->{permissionLevel}; 1004 my $submitAnswers = $self->{submitAnswers}; 1005 my $checkAnswers = $self->{checkAnswers}; 1006 my $previewAnswers = $self->{previewAnswers}; 1007 my %want = %{ $self->{want} }; 1008 my %can = %{ $self->{can} }; 1009 my %must = %{ $self->{must} }; 1010 my %will = %{ $self->{will} }; 1011 my @problems = @{ $self->{ra_problems} }; 1012 my @pg_results = @{ $self->{ra_pg_results} }; 1013 my @pg_errors = @{ $self->{errors} }; 1014 my $requestedVersion = $self->{requestedVersion}; 1015 1016 my $setVersionName = $set->set_id; 1017 my ( $setName ) = ( $setVersionName =~ /(.*),v\d+$/ ); 1018 1019 # translation errors -- we use the same output routine as Problem.pm, but 1020 # play around to allow for errors on multiple translations because we 1021 # have an array of problems to deal with. 1022 if ( @pg_errors ) { 1023 my $errorNum = 1; 1024 my ( $message, $context ) = ( '', '' ); 1025 foreach ( @pg_errors ) { 1026 1027 $message .= "$errorNum. " if ( @pg_errors > 1 ); 1028 $message .= $_->{message} . CGI::br() . "\n"; 1029 1030 $context .= CGI::p( (@pg_errors > 1 ? "$errorNum." : '') . 1031 $_->{context} ) . "\n\n" . CGI::hr() . "\n\n"; 1032 } 1033 return $self->errorOutput( $message, $context ); 1034 } 1035 1036 #################################### 1037 # answer processing 1038 #################################### 1039 1040 $WeBWorK::timer->continue("begin answer processing") 1041 if defined($WeBWorK::timer); 1042 1043 my @scoreRecordedMessage = ('') x scalar(@problems); 1044 1045 if ( $submitAnswers ) { 1046 1047 # if we're submitting answers for a proctored exam, we want to delete 1048 # the proctor keys that authorized that grading, so that it isn't possible 1049 # to just log in and take another proctored test without getting 1050 # reauthorized 1051 if ( $self->{'assignment_type'} eq 'proctored_gateway' ) { 1052 my $proctorID = $r->param('proctor_user'); 1053 eval{ $db->deleteKey( "$effectiveUser,$proctorID" ); }; 1054 # we should be more subtle than die()ing, but this is a potentially 1055 # big problem 1056 if ( $@ ) { 1057 die("ERROR RESETTING PROCTOR KEY: $@\n"); 1058 } 1059 eval{ $db->deleteKey( "$effectiveUser,$proctorID,g" ); }; 1060 if ( $@ ) { 1061 die("ERROR RESETTING PROCTOR GRADING KEY: $@\n"); 1062 } 1063 } 1064 1065 foreach my $i ( 0 .. $#problems ) { # process each problem in g/w 1066 # this code is essentially that from Problem.pm 1067 my $pureProblem = $db->getUserProblem( $problems[$i]->user_id, 1068 $setVersionName, 1069 $problems[$i]->problem_id ); 1070 # this should be defined unless it's not assigned yet, in which case 1071 # we should have die()ed earlier, but what's an extra conditional 1072 # between friends? 1073 if ( defined( $pureProblem ) ) { 1074 # store answers in problem for sticky answers later 1075 my %answersToStore; 1076 my %answerHash = %{$pg_results[$i]->{answers}}; 1077 $answersToStore{$_} = 1078 $self->{formFields}->{$_} foreach ( keys %answerHash ); 1079 # check for extra answers that slipped by---e.g. for matrices, and get 1080 # them from the original input form 1081 my @extra_answer_names = 1082 @{ $pg_results[$i]->{flags}->{KEPT_EXTRA_ANSWERS} }; 1083 $answersToStore{$_} = 1084 $self->{formFields}->{$_} foreach ( @extra_answer_names ); 1085 # now encode all answers 1086 my @answer_order = 1087 ( @{$pg_results[$i]->{flags}->{ANSWER_ENTRY_ORDER}}, 1088 @extra_answer_names ); 1089 my $answerString = encodeAnswers( %answersToStore, 1090 @answer_order ); 1091 # and store the last answer to the database 1092 $problems[$i]->last_answer( $answerString ); 1093 $pureProblem->last_answer( $answerString ); 1094 my $versioned = 1; 1095 $db->putUserProblem( $pureProblem, $versioned ); 1096 1097 # next, store the state in the database if that makes sense 1098 if ( $will{recordAnswers} ) { 1099 $problems[$i]->status($pg_results[$i]->{state}->{recorded_score}); 1100 $problems[$i]->attempted(1); 1101 $problems[$i]->num_correct($pg_results[$i]->{state}->{num_of_correct_ans}); 1102 $problems[$i]->num_incorrect($pg_results[$i]->{state}->{num_of_incorrect_ans}); 1103 $pureProblem->status($pg_results[$i]->{state}->{recorded_score}); 1104 $pureProblem->attempted(1); 1105 $pureProblem->num_correct($pg_results[$i]->{state}->{num_of_correct_ans}); 1106 $pureProblem->num_incorrect($pg_results[$i]->{state}->{num_of_incorrect_ans}); 1107 1108 if ( $db->putUserProblem( $pureProblem, $versioned ) ) { 1109 $scoreRecordedMessage[$i] = "Your score on this " . 1110 "problem was recorded."; 1111 } else { 1112 $scoreRecordedMessage[$i] = "Your score was not " . 1113 "recorded because there was a failure in storing " . 1114 "the problem record to the database."; 1115 } 1116 # write the transaction log 1117 writeLog( $self->{ce}, "transaction", 1118 $problems[$i]->problem_id . "\t" . 1119 $problems[$i]->set_id . "\t" . 1120 $problems[$i]->user_id . "\t" . 1121 $problems[$i]->source_file . "\t" . 1122 $problems[$i]->value . "\t" . 1123 $problems[$i]->max_attempts . "\t" . 1124 $problems[$i]->problem_seed . "\t" . 1125 $problems[$i]->status . "\t" . 1126 $problems[$i]->attempted . "\t" . 1127 $problems[$i]->last_answer . "\t" . 1128 $problems[$i]->num_correct . "\t" . 1129 $problems[$i]->num_incorrect 1130 ); 1131 } else { 1132 1133 if ($self->{isClosed}) { 1134 $scoreRecordedMessage[$i] = "Your score was not " . 1135 "recorded because this problem set version is " . 1136 "not open."; 1137 } elsif ( $problems[$i]->num_correct + 1138 $problems[$i]->num_incorrect >= 1139 $set->attempts_per_version ) { 1140 $scoreRecordedMessage[$i] = "Your score was not " . 1141 "recorded because you have no attempts " . 1142 "remaining on this set version."; 1143 } elsif ( ! $self->{versionIsOpen} ) { 1144 $scoreRecordedMessage[$i] = "Your score was not " . 1145 "recorded because you have exceeded the time " . 1146 "limit for this test."; 1147 } else { 1148 $scoreRecordedMessage[$i] = "Your score was not " . 1149 "recorded."; 1150 } 1151 } 1152 } else { 1153 # I don't think this should ever happen, because we die() out of the 1154 # pre_header_initialize routine when we have the same situation 1155 $scoreRecordedMessage[$i] = "Your score was not recorded, " . 1156 "because this problem set has not been assigned to you."; 1157 } 1158 # log student answers 1159 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 1160 1161 # this is carried over from Problem.pm 1162 if ( defined( $answer_log ) && defined( $pureProblem ) ) { 1163 if ( $submitAnswers ) { 1164 my $answerString = ''; 1165 my %answerHash = %{ $pg_results[$i]->{answers} }; 1166 # FIXME fix carried over from Problem.pm for "line 552 error" 1167 1168 foreach ( sort keys %answerHash ) { 1169 my $student_ans = 1170 $answerHash{$_}->{original_student_ans} || ''; 1171 $answerString .= $student_ans . "\t"; 1172 } 1173 $answerString = '' unless defined( $answerString ); 1174 1175 writeCourseLog( $self->{ce}, "answer_log", 1176 join("", '|', $problems[$i]->user_id, 1177 '|', $problems[$i]->set_id, 1178 '|', $problems[$i]->problem_id, 1179 '|', "\t", time(), "\t", 1180 $answerString), 1181 ); 1182 } 1183 } 1184 } # end loop through problems 1185 } # end if submitAnswers conditional 1186 $WeBWorK::timer->continue("end answer processing") 1187 if defined( $WeBWorK::timer ); 1188 1189 #################################### 1190 # output 1191 #################################### 1192 1193 my $overallScore = -1; # is there a total score we should be reporting? 1194 my $totPossible = 0; 1195 if ( $submitAnswers ) { 1196 $overallScore = 0; 1197 foreach ( @pg_results ) { 1198 $overallScore += $_->{state}->{recorded_score}; 1199 # FIXME we need to worry about weight, both for score and total possible 1200 # $totPossible += $_->value; 1201 $totPossible++; 1202 } 1203 } 1204 1205 # FIXME the following should probably be in the gateway 1206 # template file, once that exists FIXME 1207 # print CGI::h3("Gateway $setName"); 1208 1209 if ( $overallScore > -1 ) { 1210 my $divClass = ''; 1211 my $ansRecorded = 1; 1212 my $recdMsg = ''; 1213 foreach ( @scoreRecordedMessage ) { 1214 if ( $_ ne 'Your score on this problem was recorded.' ) { 1215 $ansRecorded = 0; 1216 $recdMsg = $_; 1217 last; 1218 } 1219 } 1220 if ( $ansRecorded ) { 1221 $divClass = 'ResultsWithoutError'; 1222 $recdMsg = "Your score on this test was recorded."; 1223 } else { 1224 $divClass = 'ResultsWithError'; 1225 # inherit saved value from above 1226 $recdMsg = "Your score on this test was NOT recorded. " . $recdMsg; 1227 } 1228 1229 print CGI::div({class=>"$divClass"}, 1230 CGI::strong("Score on this attempt = " . 1231 "$overallScore / $totPossible"), 1232 CGI::br(), 1233 CGI::strong("$recdMsg")),"\n\n"; 1234 } 1235 1236 if ( ! $can{recordAnswersNextTime} ) { 1237 print CGI::start_div({class=>"gwMessage"}); 1238 my $mesg = ( $requestedVersion ) ? '' : 1239 ", because you have used all available attempts on it or " . 1240 "because its time limit has expired.\n" . 1241 "To attempt the set again, please try again after the time " . 1242 "limit between versions has expired.\n"; 1243 print CGI::p(CGI::strong("Note: this set version can no longer be " . 1244 "submitted for a grade"),"\n",$mesg,"\n", 1245 "You may, however, check your answers to see what you did" . 1246 " right or wrong."), "\n\n"; 1247 print CGI::end_div(); 1248 } else { 1249 1250 # FIXME: This assumes that there IS a time limit! 1251 # FIXME: We need to drop this out gracefully if there isn't! 1252 # set up a timer 1253 my $timeNow = time(); 1254 my $timeLeft = $set->due_date() - $timeNow; # this is in seconds 1255 print CGI::start_div({class=>"gwTiming"}); 1256 print CGI::startform({-name=>"gwtimer", -method=>"POST", 1257 -action=>$r->uri}), "\n"; 1258 print CGI::hidden({-name=>"gwpagetimeleft", -value=>$timeLeft}), "\n"; 1259 print CGI::strong("Time Remaining:"); 1260 print CGI::textfield({-name=>'gwtime', -default=>0, -size=>8}), 1261 CGI::strong("min:sec"), CGI::br(), "\n"; 1262 print CGI::endform(); 1263 if ( $timeLeft < 1 ) { 1264 print CGI::span({-class=>"resultsWithError"}, 1265 CGI::b("You have less than 1 minute to ", 1266 "complete this test.\n")); 1267 } 1268 print CGI::end_div(); 1269 # print CGI::strong("Time Remaining: 1270 # scalar(localtime($set->open_date())), 1271 # CGI::br(),"\nTime limit : ", 1272 # ($set->version_time_limit()/60), 1273 # " minutes (must be completed by: ", 1274 # scalar(localtime($set->due_date())), ")", CGI::br(), 1275 # "The current time is ", scalar(localtime())), "\n\n"; 1276 } 1277 1278 1279 print CGI::startform({-name=>"gwquiz", -method=>"POST", -action=>$r->uri}), $self->hidden_authen_fields, 1280 $self->hidden_proctor_authen_fields; 1281 1282 # FIXME RETURNTO 1283 # this is a horrible hack to try and let us use a javascript link to 1284 # trigger previews 1285 print CGI::hidden({-name=>'previewHack', -value=>''}), CGI::br(); 1286 # and the text for the link 1287 my $jsprevlink = 'javascript:document.gwquiz.previewHack.value="1";' . 1288 'document.gwquiz.submit();'; 1289 1290 # some links to easily move between problems 1291 my $jumpLinks = "Jump to problem: "; 1292 for my $i ( 0 .. $#pg_results ) { 1293 my $pn = $i+1; 1294 $jumpLinks .= "/ " . CGI::a({-href=>".", -onclick=>"jumpTo($pn);return false;"}, "$pn") . " /"; 1295 } 1296 print CGI::p($jumpLinks,"\n"); 1297 1298 # print out problems and attempt results, as appropriate 1299 # note: args to attemptResults are (self,) $pg, $showAttemptAnswers, 1300 # $showCorrectAnswers, $showAttemptResults (and-ed with 1301 # $showAttemptAnswers), $showSummary, $showAttemptPreview (or-ed with zero) 1302 my $problemNumber = 0; 1303 1304 # deal with ordering 1305 my @probOrder = ( 0 .. $#pg_results ); 1306 1307 # there's a routine to do this somewhere, I think... 1308 if ( defined( $set->problem_randorder ) && $set->problem_randorder ) { 1309 my @newOrder = (); 1310 # we need to keep the random order the same each time the set is loaded! 1311 # this requires either saving the order in the set definition, or being 1312 # sure that the random seed that we use is the same each time the same 1313 # set is called. we'll do the latter by setting the seed to the psvn 1314 # of the problem set 1315 srand( $set->psvn ); 1316 while ( @probOrder ) { 1317 my $i = int(rand(@probOrder)); 1318 push( @newOrder, $probOrder[$i] ); 1319 splice(@probOrder, $i, 1); 1320 } 1321 @probOrder = @newOrder; 1322 } 1323 1324 foreach my $i ( 0 .. $#pg_results ) { 1325 my $pg = $pg_results[$probOrder[$i]]; 1326 $problemNumber++; 1327 1328 # print "pCA = >", (defined($pg->{flags}->{showPartialCorrectAnswers}) ? $pg->{flags}->{showPartialCorrectAnswers} : "undef"), "<"; 1329 1330 my $recordMessage = ''; 1331 my $resultsTable = ''; 1332 1333 # print CGI::start_div({class=>"problemHeader", -style=>"border: solid black 1px;"}); 1334 1335 # FIXME: I've coded the "ResultsWithError" style into the recordMessage strings 1336 # FIXME: manually; this should be pushed out to the template or stylesheet. 1337 1338 if ($pg->{flags}->{showPartialCorrectAnswers} >= 0 && $submitAnswers) { 1339 if ( $scoreRecordedMessage[$probOrder[$i]] ne 1340 "Your score on this problem was recorded." ) { 1341 $recordMessage = CGI::span({class=>"resultsWithError"}, 1342 "ANSWERS NOT RECORDED --", 1343 $scoreRecordedMessage[$probOrder[$i]]); 1344 # print CGI::div({class=>'ResultsWithError'}, 1345 # "ANSWERS NOT RECORDED --", 1346 # $scoreRecordedMessage[$probOrder[$i]],CGI::br()); 1347 } 1348 $resultsTable = 1349 $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1350 $pg->{flags}->{showPartialCorrectAnswers}, 1351 1, 1); 1352 # print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1353 # $pg->{flags}->{showPartialCorrectAnswers}, 1354 # 1, 1); 1355 1356 } elsif ( $checkAnswers ) { 1357 $recordMessage = CGI::span({class=>"resultsWithError"}, 1358 "ANSWERS ONLY CHECKED -- ", 1359 "ANSWERS NOT RECORDED"); 1360 # print CGI::div({class=>'ResultsWithError'}, 1361 # "ANSWERS ONLY CHECKED -- ", 1362 # "ANSWERS NOT RECORDED", CGI::br() ); 1363 $resultsTable = 1364 $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1365 $pg->{flags}->{showPartialCorrectAnswers}, 1366 1, 1); 1367 # print 1368 # $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1369 # $pg->{flags}->{showPartialCorrectAnswers}, 1370 # 1, 1); 1371 } elsif ( $previewAnswers ) { 1372 $recordMessage = CGI::span({class=>"resultsWithError"}, 1373 "PREVIEW ONLY -- ANSWERS NOT RECORDED"); 1374 # print CGI::div({class=>'ResultsWithError'}, 1375 # "PREVIEW ONLY -- ANSWERS NOT RECORDED", CGI::br() ); 1376 $resultsTable = $self->attemptResults($pg, 1, 0, 0, 0, 1); 1377 # print $self->attemptResults($pg, 1, 0, 0, 0, 1); 1378 } 1379 1380 print CGI::start_div({class=>"gwProblem"}); 1381 my $i1 = $i+1; 1382 print CGI::a({-name=>"#$i1"},""); 1383 print CGI::strong("Problem $problemNumber."), "\n", $recordMessage; 1384 print CGI::p($pg->{body_text}), 1385 CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", 1386 CGI::i($pg->{result}->{msg})); 1387 print CGI::p({class=>"gwPreview"}, 1388 CGI::a({-href=>"$jsprevlink"}, "preview problems")); 1389 # print CGI::end_div(); 1390 1391 print $resultsTable if $resultsTable; 1392 1393 print CGI::end_div(); 1394 1395 print "\n", CGI::hr(), "\n"; 1396 } 1397 print CGI::p($jumpLinks, "\n"); 1398 1399 if ($can{showCorrectAnswers}) { 1400 print CGI::checkbox(-name => "showCorrectAnswers", 1401 -checked => $will{showCorrectAnswers}, 1402 -label => "Show correct answers", 1403 ); 1404 } 1405 # if ($can{showHints}) { 1406 # print CGI::div({style=>"color:red"}, 1407 # CGI::checkbox(-name => "showHints", 1408 # -checked => $will{showHints}, 1409 # -label => "Show Hints", 1410 # ) 1411 # ); 1412 # } 1413 if ($can{showSolutions}) { 1414 print CGI::checkbox(-name => "showSolutions", 1415 -checked => $will{showSolutions}, 1416 -label => "Show Solutions", 1417 ); 1418 } 1419 1420 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) { 1421 print CGI::br(); 1422 } 1423 1424 # Note: because of the way these things are grouped, the submit/et al buttons 1425 # in this form are getting put outside of the problem div, while on a regular 1426 # problem they'd fall inside. Does this matter? We shall see. 1427 print CGI::p( CGI::submit( -name=>"previewAnswers", 1428 -label=>"Preview Answers" ), 1429 ($can{recordAnswersNextTime} ? 1430 CGI::submit( -name=>"submitAnswers", 1431 -label=>"Grade Gateway" ) : " "), 1432 ($can{checkAnswersNextTime} && ! $can{recordAnswersNextTime} ? 1433 CGI::submit( -name=>"checkAnswers", 1434 -label=>"Check Answers" ) : " ") ); 1435 1436 print CGI::endform(); 1437 1438 # we exclude the feedback form from gateway tests. they can use the feedback 1439 # button on the preceding or following pages 1440 # my $ce = $r->ce; 1441 # my $root = $ce->{webworkURLs}->{root}; 1442 # my $courseName = $ce->{courseName}; 1443 # my $feedbackURL = "$root/$courseName/feedback/"; 1444 # print CGI::startform("POST", $feedbackURL), 1445 # $self->hidden_authen_fields, 1446 # CGI::hidden("module", __PACKAGE__), 1447 # CGI::hidden("set", $self->{set}->set_id), 1448 # CGI::p({-align=>"right"}, 1449 # CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback") 1450 # ), 1451 # CGI::endform(); 1452 1453 return ""; 1454 1455 } 1456 1457 1458 ########################################################################### 1459 # Evaluation utilities 1460 ############################################################################ 1461 1462 sub getProblemHTML { 1463 my ( $self, $EffectiveUser, $setVersionName, $formFields, 1464 $mergedProblem, $pgFile ) = @_; 1465 # in: $EffectiveUser is the effective user we're working as, $setVersionName 1466 # the versioned set name (setID,vN), %$formFields the form fields from 1467 # the input form that we need to worry about putting into the HTML we're 1468 # generating, and $mergedProblem and $pgFile are what we'd expect. 1469 # $pgFile is optional 1470 # out: the translated problem is returned 1471 1472 my $r = $self->r; 1473 my $ce = $r->ce; 1474 my $db = $r->db; 1475 my $key = $r->param('key'); 1476 1477 # this isn't good because it doesn't include the sticky answers that we 1478 # might want. so off with its head! 1479 ## my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 1480 1481 my $permissionLevel = $self->{permissionLevel}; 1482 my $set = $db->getMergedVersionedSet( $EffectiveUser->user_id, 1483 $setVersionName ); 1484 1485 # should this ever happen? I think we should have die()ed way earlier than 1486 # this if the set doesn't exist, but it can't hurt to try and die() here 1487 # too 1488 die "set $setVersionName for effectiveUser " . $EffectiveUser->user_id . 1489 " not found." unless $set; 1490 1491 my $psvn = $set->psvn(); 1492 my ($setName) = ($setVersionName =~ /^(.*),v\d+/); 1493 1494 if ( defined($mergedProblem) && $mergedProblem->problem_id ) { 1495 # nothing needs to be done 1496 1497 } elsif ($pgFile) { 1498 $mergedProblem = 1499 WeBWorK::DB::Record::UserProblem->new( 1500 set_id => $set->set_id, 1501 problem_id => 0, 1502 login_id => $EffectiveUser->user_id, 1503 source_file => $pgFile, 1504 # the rest of Problem's fields are not needed, i think 1505 ); 1506 } 1507 # figure out if we're allowed to get solutions and call PG->new accordingly. 1508 my $showCorrectAnswers = $self->{will}->{showCorrectAnswers}; 1509 my $showHints = $self->{will}->{showHints}; 1510 my $showSolutions = $self->{will}->{showSolutions}; 1511 my $processAnswers = $self->{will}->{checkAnswers}; 1512 1513 # FIXME I'm not sure that problem_id is what we want here FIXME 1514 my $problemNumber = $mergedProblem->problem_id; 1515 1516 # WARN STATEMENT HERE 1517 # warn("merged problem:\n"); 1518 # foreach my $kk ( keys %$mergedProblem ) { 1519 # warn(" $kk => " . $mergedProblem->{$kk} . "\n"); 1520 # } 1521 my $pg = 1522 WeBWorK::PG->new( 1523 $ce, 1524 $EffectiveUser, 1525 $key, 1526 $set, 1527 $mergedProblem, 1528 $psvn, 1529 $formFields, 1530 { # translation options 1531 displayMode => $self->{displayMode}, 1532 showHints => $showHints, 1533 showSolutions => $showSolutions, 1534 refreshMath2img => $showHints || $showSolutions, 1535 processAnswers => 1, 1536 QUIZ_PREFIX => 'Q' . 1537 sprintf("%04d",$problemNumber) . '_', 1538 }, 1539 ); 1540 1541 # FIXME is problem_id the correct thing in the following two stanzas? FIXME 1542 # the original version had "problem number", which is what we want. I think 1543 # problem_id will work, too 1544 if ($pg->{warnings} ne "") { 1545 push @{$self->{warnings}}, { 1546 set => $setVersionName, 1547 problem => $mergedProblem->problem_id, 1548 message => $pg->{warnings}, 1549 }; 1550 } 1551 1552 $self->{errors} = []; # initialize this to no errors 1553 if ($pg->{flags}->{error_flag}) { 1554 push @{$self->{errors}}, { 1555 set => $setVersionName, 1556 problem => $mergedProblem->problem_id, 1557 message => $pg->{errors}, 1558 context => $pg->{body_text}, 1559 }; 1560 # if there was an error, body_text contains 1561 # the error context, not TeX code 1562 $pg->{body_text} = undef; 1563 } 1564 # WARN STATEMENT HERE 1565 # warn("body text = " . $pg->{body_text} . "\n"); 1566 return $pg; 1567 } 1568 1569 ##### output utilities ##### 1570 sub problemListRow($$$) { 1571 my $self = shift; 1572 my $set = shift; 1573 my $Problem = shift; 1574 1575 my $name = $Problem->problem_id; 1576 my $interactiveURL = "$name/?" . $self->url_authen_args; 1577 my $interactive = CGI::a({-href=>$interactiveURL}, "Problem $name"); 1578 my $attempts = $Problem->num_correct + $Problem->num_incorrect; 1579 my $remaining = $Problem->max_attempts < 0 1580 ? "unlimited" 1581 : $Problem->max_attempts - $attempts; 1582 my $status = sprintf("%.0f%%", $Problem->status * 100); # round to whole number 1583 1584 return CGI::Tr(CGI::td({-nowrap=>1}, [ 1585 $interactive, 1586 $attempts, 1587 $remaining, 1588 $status, 1589 ])); 1590 } 1591 # sub nbsp { 1592 # my $str = shift; 1593 # ($str) ? $str : ' '; # returns non-breaking space for empty strings 1594 # } 1595 1596 ##### logging subroutine #### 1597 1598 1599 1600 1601 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |