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