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