Parent Directory
| 
Revision Log
updated copyright dates
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm,v 1.48 2007/05/31 14:39:10 glarose Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::GatewayQuiz; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::GatewayQuiz - display a quiz of problems on one page, 23 deal with versioning sets 24 25 =cut 26 27 use strict; 28 use warnings; 29 #use CGI qw(-nosticky ); 30 use WeBWorK::CGI; 31 use File::Path qw(rmtree); 32 use WeBWorK::Form; 33 use WeBWorK::PG; 34 use WeBWorK::PG::ImageGenerator; 35 use WeBWorK::PG::IO; 36 use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers 37 ref2string makeTempDirectory sortByName before after between 38 formatDateTime); 39 use WeBWorK::DB::Utils qw(global2user user2global); 40 use WeBWorK::Debug; 41 use WeBWorK::ContentGenerator::Instructor qw(assignSetVersionToUser); 42 use PGrandom; 43 44 # template method 45 sub templateName { 46 return "gateway"; 47 } 48 49 50 ################################################################################ 51 # "can" methods 52 ################################################################################ 53 54 # Subroutines to determine if a user "can" perform an action. Each subroutine is 55 # called with the following arguments: 56 # 57 # ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) 58 59 # *** The "can" routines are taken from Problem.pm, with small modifications 60 # *** to look at number of attempts per version, not per set, and to allow 61 # *** showing of correct answers after all attempts at a version are used 62 63 sub can_showOldAnswers { 64 my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, $tmplSet ) = @_; 65 my $authz = $self->r->authz; 66 # we'd like to use "! $Set->hide_work()", but that hides students' work 67 # as they're working on the set, which isn't quite right. so use instead: 68 return( before( $Set->due_date() ) || 69 70 $authz->hasPermissions($User->user_id,"view_hidden_work") || 71 ( $Set->hide_work() eq 'N' || 72 ( $Set->hide_work() eq 'BeforeAnswerDate' && time > $tmplSet->answer_date ) ) ); 73 } 74 75 # gateway change here: add $submitAnswers as an optional additional argument 76 # to be included if it's defined 77 sub can_showCorrectAnswers { 78 my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, 79 $tmplSet, $submitAnswers) = @_; 80 my $authz = $self->r->authz; 81 82 # gateway change here to allow correct answers to be viewed after all attempts 83 # at a version are exhausted as well as if it's after the answer date 84 # $addOne allows us to count the current submission 85 my $addOne = defined( $submitAnswers ) ? $submitAnswers : 0; 86 my $maxAttempts = $Set->attempts_per_version(); 87 my $attemptsUsed = $Problem->num_correct + $Problem->num_incorrect + 88 $addOne; 89 90 # this is complicated by trying to address hiding scores by problem---that 91 # is, if $set->hide_score_by_problem and $set->hide_score are both set, 92 # then we should allow scores to be shown, but not show the score on 93 # any individual problem. to deal with this, we make 94 # can_showCorrectAnswers give the least restrictive view of hiding, and 95 # then filter scores for the problems themselves later 96 my $canShowScores = ( $Set->hide_score eq 'N' || 97 $Set->hide_score_by_problem eq 'Y' || 98 ( $Set->hide_score eq 'BeforeAnswerDate' && 99 after($tmplSet->answer_date) ) ); 100 101 return ( ( ( after( $Set->answer_date ) || 102 ( $attemptsUsed >= $maxAttempts && 103 $Set->due_date() == $Set->answer_date() ) ) || 104 $authz->hasPermissions($User->user_id, 105 "show_correct_answers_before_answer_date") ) && 106 ( $authz->hasPermissions($User->user_id, "view_hidden_work") || 107 $canShowScores ) ); 108 } 109 110 sub can_showHints { 111 #my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) = @_; 112 113 return 1; 114 } 115 116 # gateway change here: add $submitAnswers as an optional additional argument 117 # to be included if it's defined 118 sub can_showSolutions { 119 my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, 120 $tmplSet, $submitAnswers) = @_; 121 my $authz = $self->r->authz; 122 123 # this is the same as can_showCorrectAnswers 124 # gateway change here to allow correct answers to be viewed after all attempts 125 # at a version are exhausted as well as if it's after the answer date 126 # $addOne allows us to count the current submission 127 my $addOne = defined( $submitAnswers ) ? $submitAnswers : 0; 128 my $maxAttempts = $Set->attempts_per_version(); 129 my $attemptsUsed = $Problem->num_correct+$Problem->num_incorrect+$addOne; 130 131 # this is complicated by trying to address hiding scores by problem---that 132 # is, if $set->hide_score_by_problem and $set->hide_score are both set, 133 # then we should allow scores to be shown, but not show the score on 134 # any individual problem. to deal with this, we make can_showSolutions 135 # give the least restrictive view of hiding, and then filter scores for 136 # the problems themselves later 137 my $canShowScores = ( $Set->hide_score eq 'N' || 138 $Set->hide_score_by_problem eq 'Y' || 139 ( $Set->hide_score eq 'BeforeAnswerDate' && 140 after($tmplSet->answer_date) ) ); 141 142 return ( ( ( after( $Set->answer_date ) || 143 ( $attemptsUsed >= $maxAttempts && 144 $Set->due_date() == $Set->answer_date() ) ) || 145 $authz->hasPermissions($User->user_id, 146 "show_correct_answers_before_answer_date") ) && 147 ( $authz->hasPermissions($User->user_id, "view_hidden_work") || 148 $canShowScores ) ); 149 } 150 151 # gateway change here: add $submitAnswers as an optional additional argument 152 # to be included if it's defined 153 # we also allow for a version_last_attempt_time which is the time the set was 154 # submitted; if that's present we use that instead of the current time to 155 # decide if we can record the answers. this deals with the time between the 156 # submission time and the proctor authorization. 157 sub can_recordAnswers { 158 my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, 159 $tmplSet, $submitAnswers) = @_; 160 my $authz = $self->r->authz; 161 162 my $timeNow = ( defined($self->{timeNow}) ) ? $self->{timeNow} : time(); 163 # get the sag time after the due date in which we'll still grade the test 164 my $grace = $self->{ce}->{gatewayGracePeriod}; 165 166 my $submitTime = ( defined($Set->version_last_attempt_time()) && 167 $Set->version_last_attempt_time() ) ? 168 $Set->version_last_attempt_time() : $timeNow; 169 170 if ($User->user_id ne $EffectiveUser->user_id) { 171 return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student"); 172 } 173 174 if (before($Set->open_date, $submitTime)) { 175 warn("case 0\n"); 176 return $authz->hasPermissions($User->user_id, "record_answers_before_open_date"); 177 } elsif (between($Set->open_date, ($Set->due_date + $grace), $submitTime)) { 178 179 # gateway change here; we look at maximum attempts per version, not for the set, 180 # to determine the number of attempts allowed 181 # $addOne allows us to count the current submission 182 my $addOne = ( defined( $submitAnswers ) && $submitAnswers ) ? 183 1 : 0; 184 my $max_attempts = $Set->attempts_per_version(); 185 my $attempts_used = $Problem->num_correct+$Problem->num_incorrect+$addOne; 186 if ($max_attempts == -1 or $attempts_used < $max_attempts) { 187 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts"); 188 } else { 189 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts"); 190 } 191 } elsif (between(($Set->due_date + $grace), $Set->answer_date, $submitTime)) { 192 return $authz->hasPermissions($User->user_id, "record_answers_after_due_date"); 193 } elsif (after($Set->answer_date, $submitTime)) { 194 return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date"); 195 } 196 } 197 198 # gateway change here: add $submitAnswers as an optional additional argument 199 # to be included if it's defined 200 # we also allow for a version_last_attempt_time which is the time the set was 201 # submitted; if that's present we use that instead of the current time to 202 # decide if we can check the answers. this deals with the time between the 203 # submission time and the proctor authorization. 204 sub can_checkAnswers { 205 my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, 206 $tmplSet, $submitAnswers) = @_; 207 my $authz = $self->r->authz; 208 209 my $timeNow = ( defined($self->{timeNow}) ) ? $self->{timeNow} : time(); 210 # get the sag time after the due date in which we'll still grade the test 211 my $grace = $self->{ce}->{gatewayGracePeriod}; 212 213 my $submitTime = ( defined($Set->version_last_attempt_time()) && 214 $Set->version_last_attempt_time() ) ? 215 $Set->version_last_attempt_time() : $timeNow; 216 217 # this is further complicated by trying to address hiding scores by 218 # problem---that is, if $set->hide_score_by_problem and 219 # $set->hide_score are both set, then we should allow scores to 220 # be shown, but not show the score on any individual problem. 221 # to deal with this, we use the least restrictive view of hiding 222 # here, and then filter for the problems themselves later 223 my $canShowScores = ( $Set->hide_score eq 'N' || 224 $Set->hide_score_by_problem eq 'Y' || 225 ( $Set->hide_score eq 'BeforeAnswerDate' && 226 after($tmplSet->answer_date) ) ); 227 228 if (before($Set->open_date, $submitTime)) { 229 return $authz->hasPermissions($User->user_id, "check_answers_before_open_date"); 230 } elsif (between($Set->open_date, ($Set->due_date + $grace), $submitTime)) { 231 232 # gateway change here; we look at maximum attempts per version, not for the set, 233 # to determine the number of attempts allowed 234 # $addOne allows us to count the current submission 235 my $addOne = (defined( $submitAnswers ) && $submitAnswers) ? 236 1 : 0; 237 my $max_attempts = $Set->attempts_per_version(); 238 my $attempts_used = $Problem->num_correct+$Problem->num_incorrect+$addOne; 239 240 if ($max_attempts == -1 or $attempts_used < $max_attempts) { 241 return ( $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts") && 242 ( $authz->hasPermissions($User->user_id, "view_hidden_work") || 243 $canShowScores ) ); 244 } else { 245 return ( $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts") && 246 ( $authz->hasPermissions($User->user_id, "view_hidden_work") || 247 $canShowScores ) ); 248 } 249 } elsif (between(($Set->due_date + $grace), $Set->answer_date, $submitTime)) { 250 return ( $authz->hasPermissions($User->user_id, "check_answers_after_due_date") && 251 ( $authz->hasPermissions($User->user_id, "view_hidden_work") || 252 $canShowScores ) ); 253 } elsif (after($Set->answer_date, $submitTime)) { 254 return ( $authz->hasPermissions($User->user_id, "check_answers_after_answer_date") && 255 ( $authz->hasPermissions($User->user_id, "view_hidden_work") || 256 $canShowScores ) ); 257 } 258 } 259 260 sub can_showScore { 261 my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem, 262 $tmplSet, $submitAnswers) = @_; 263 my $authz = $self->r->authz; 264 265 my $timeNow = ( defined($self->{timeNow}) ) ? $self->{timeNow} : time(); 266 267 # address hiding scores by problem 268 my $canShowScores = ( $Set->hide_score eq 'N' || 269 $Set->hide_score_by_problem eq 'Y' || 270 ( $Set->hide_score eq 'BeforeAnswerDate' && 271 after($tmplSet->answer_date) ) ); 272 273 return( $authz->hasPermissions($User->user_id,"view_hidden_work") || 274 $canShowScores ); 275 } 276 277 ################################################################################ 278 # output utilities 279 ################################################################################ 280 281 # subroutine is modified from that in Problem.pm to produce a different 282 # table format 283 sub attemptResults { 284 my $self = shift; 285 my $pg = shift; 286 my $showAttemptAnswers = shift; 287 my $showCorrectAnswers = shift; 288 my $showAttemptResults = $showAttemptAnswers && shift; 289 my $showSummary = shift; 290 my $showAttemptPreview = shift || 0; 291 292 my $r = $self->{r}; 293 my $setName = $r->urlpath->arg("setID"); 294 my $ce = $self->{ce}; 295 my $root = $ce->{webworkURLs}->{root}; 296 my $courseName = $ce->{courseName}; 297 my @links = ("Homework Sets" , "$root/$courseName", "navUp"); 298 my $tail = ""; 299 300 my $problemResult = $pg->{result}; # the overall result of the problem 301 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 302 303 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 304 305 # present in ver 1.10; why is this checked here? 306 # return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the homework set that contains it is not yet open.")) 307 # unless $self->{isOpen}; 308 309 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 310 311 # to make grabbing these options easier, we'll pull them out now... 312 my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}}; 313 314 my $imgGen = WeBWorK::PG::ImageGenerator->new( 315 tempDir => $ce->{webworkDirs}->{tmp}, 316 latex => $ce->{externalPrograms}->{latex}, 317 dvipng => $ce->{externalPrograms}->{dvipng}, 318 useCache => 1, 319 cacheDir => $ce->{webworkDirs}->{equationCache}, 320 cacheURL => $ce->{webworkURLs}->{equationCache}, 321 cacheDB => $ce->{webworkFiles}->{equationCacheDB}, 322 dvipng_align => $imagesModeOptions{dvipng_align}, 323 dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, 324 ); 325 326 my %resultsData = (); 327 $resultsData{'Entered'} = CGI::td({-class=>"label"}, "Your answer parses as:"); 328 $resultsData{'Preview'} = CGI::td({-class=>"label"}, "Your answer previews as:"); 329 $resultsData{'Correct'} = CGI::td({-class=>"label"}, "The correct answer is:"); 330 $resultsData{'Results'} = CGI::td({-class=>"label"}, "Result:"); 331 $resultsData{'Messages'} = CGI::td({-class=>"label"}, "Messages:"); 332 333 my %resultsRows = (); 334 foreach ( qw( Entered Preview Correct Results Messages ) ) { 335 $resultsRows{$_} = ""; 336 } 337 338 my $numCorrect = 0; 339 my $numAns = 0; 340 foreach my $name (@answerNames) { 341 my $answerResult = $pg->{answers}->{$name}; 342 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 343 my $preview = ($showAttemptPreview 344 ? $self->previewAnswer($answerResult, $imgGen) 345 : ""); 346 my $correctAnswer = $answerResult->{correct_ans}; 347 my $answerScore = $answerResult->{score}; 348 my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; 349 #FIXME --Can we be sure that $answerScore is an integer-- could the problem give partial credit? 350 $numCorrect += $answerScore > 0; 351 my $resultString = $answerScore == 1 ? "correct" : "incorrect"; 352 353 # get rid of the goofy prefix on the answer names (supposedly, the format 354 # of the answer names is changeable. this only fixes it for "AnSwEr" 355 #$name =~ s/^AnSwEr//; 356 357 my $pre = $numAns ? CGI::td(" ") : ""; 358 359 $resultsRows{'Entered'} .= $showAttemptAnswers ? 360 CGI::Tr( $pre . $resultsData{'Entered'} . 361 CGI::td({-class=>"output"}, $self->nbsp($studentAnswer))) : ""; 362 $resultsData{'Entered'} = ''; 363 $resultsRows{'Preview'} .= $showAttemptPreview ? 364 CGI::Tr( $pre . $resultsData{'Preview'} . 365 CGI::td({-class=>"output"}, $self->nbsp($preview)) ) : ""; 366 $resultsData{'Preview'} = ''; 367 $resultsRows{'Correct'} .= $showCorrectAnswers ? 368 CGI::Tr( $pre . $resultsData{'Correct'} . 369 CGI::td({-class=>"output"}, $self->nbsp($correctAnswer)) ) : ""; 370 $resultsData{'Correct'} = ''; 371 $resultsRows{'Results'} .= $showAttemptResults ? 372 CGI::Tr( $pre . $resultsData{'Results'} . 373 CGI::td({-class=>"output"}, $self->nbsp($resultString)) ) : ""; 374 $resultsData{'Results'} = ''; 375 $resultsRows{'Messages'} .= $showMessages ? 376 CGI::Tr( $pre . $resultsData{'Messages'} . 377 CGI::td({-class=>"output"}, $self->nbsp($answerMessage)) ) : ""; 378 379 $numAns++; 380 } 381 382 # render equation images 383 $imgGen->render(refresh => 1); 384 385 # my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; 386 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); 387 # FIXME -- I left the old code in in case we have to back out. 388 # my $summary = "On this attempt, you answered $numCorrect out of " 389 # . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; 390 391 my $summary = ""; 392 if (scalar @answerNames == 1) { 393 if ($numCorrect == scalar @answerNames) { 394 $summary .= CGI::div({class=>"gwCorrect"},"This answer is correct."); 395 } else { 396 $summary .= CGI::div({class=>"gwIncorrect"},"This answer is NOT correct."); 397 } 398 } else { 399 if ($numCorrect == scalar @answerNames) { 400 $summary .= CGI::div({class=>"gwCorrect"},"All of these answers are correct."); 401 } else { 402 $summary .= CGI::div({class=>"gwIncorrect"},"At least one of these answers is NOT correct."); 403 } 404 } 405 406 return 407 # CGI::table({-class=>"attemptResults"}, $resultsRows{'Entered'}, 408 CGI::table({-class=>"gwAttemptResults"}, $resultsRows{'Entered'}, 409 $resultsRows{'Preview'}, $resultsRows{'Correct'}, 410 $resultsRows{'Results'}, $resultsRows{'Messages'}) . 411 ($showSummary ? CGI::p({class=>'attemptResultsSummary'},$summary) : ""); 412 # CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) 413 # . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); 414 } 415 416 # *BeginPPM* ################################################################### 417 # this code taken from Problem.pm; excerpted section ends at *EndPPM* 418 # modifications are flagged with comments *GW* 419 420 sub previewAnswer { 421 my ($self, $answerResult, $imgGen) = @_; 422 my $ce = $self->r->ce; 423 my $EffectiveUser = $self->{effectiveUser}; 424 my $set = $self->{set}; 425 my $problem = $self->{problem}; 426 my $displayMode = $self->{displayMode}; 427 428 # note: right now, we have to do things completely differently when we are 429 # rendering math from INSIDE the translator and from OUTSIDE the translator. 430 # so we'll just deal with each case explicitly here. there's some code 431 # duplication that can be dealt with later by abstracting out tth/dvipng/etc. 432 433 my $tex = $answerResult->{preview_latex_string}; 434 435 return "" unless defined $tex and $tex ne ""; 436 437 if ($displayMode eq "plainText") { 438 return $tex; 439 } elsif ($displayMode eq "formattedText") { 440 my $tthCommand = $ce->{externalPrograms}->{tth} 441 . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" 442 . "\\(".$tex."\\)\n" 443 . "END_OF_INPUT\n"; 444 445 # call tth 446 my $result = `$tthCommand`; 447 if ($?) { 448 return "<b>[tth failed: $? $@]</b>"; 449 } else { 450 return $result; 451 } 452 } elsif ($displayMode eq "images") { 453 $imgGen->add($tex); 454 } elsif ($displayMode eq "jsMath") { 455 $tex =~ s/</</g; $tex =~ s/>/>/g; 456 return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>'; 457 } 458 } 459 460 # *EndPPM ###################################################################### 461 462 ################################################################################ 463 # Template escape implementations 464 ################################################################################ 465 466 # FIXME need to make $Set and $set be used consistently 467 468 sub pre_header_initialize { 469 my ($self) = @_; 470 471 my $r = $self->r; 472 my $ce = $r->ce; 473 my $db = $r->db; 474 my $authz = $r->authz; 475 my $urlpath = $r->urlpath; 476 477 my $setName = $urlpath->arg("setID"); 478 my $userName = $r->param('user'); 479 my $effectiveUserName = $r->param('effectiveUser'); 480 my $key = $r->param('key'); 481 482 # user checks 483 my $User = $db->getUser($userName); 484 die "record for user $userName (real user) does not exist." 485 unless defined $User; 486 my $EffectiveUser = $db->getUser($effectiveUserName); 487 die "record for user $effectiveUserName (effective user) does " . 488 "not exist." unless defined $EffectiveUser; 489 490 my $PermissionLevel = $db->getPermissionLevel($userName); 491 die "permission level record for $userName does not exist (but the " . 492 "user does? odd...)" unless defined($PermissionLevel); 493 my $permissionLevel = $PermissionLevel->permission; 494 495 # we could be coming in with $setName = the versioned or nonversioned set 496 # deal with that first 497 my $requestedVersion = ( $setName =~ /,v(\d+)$/ ) ? $1 : 0; 498 $setName =~ s/,v\d+$//; 499 # note that if we're already working with a version we want to be sure to stick 500 # with that version. we do this after we've validated that the user is 501 # assigned the set, below 502 503 ################################### 504 # gateway content generator tests 505 ################################### 506 507 # get template set: the non-versioned set that's assigned to the user 508 # if this fails/failed in authz->checkSet, then $self->{invalidSet} is 509 # set 510 my $tmplSet = $db->getMergedSet( $effectiveUserName, $setName ); 511 512 # now we know that we're in a gateway test, save the assignment test 513 # for the processing of proctor keys for graded proctored tests; 514 # if we failed to get the set from the database, we store a fake 515 # value here to be able to continue 516 $self->{'assignment_type'} = $tmplSet->assignment_type() || 'gateway'; 517 518 # next, get the latest (current) version of the set if we don't have a 519 # requested version number 520 my @allVersionIds = $db->listSetVersions($effectiveUserName, $setName); 521 my $latestVersion = ( @allVersionIds ? $allVersionIds[-1] : 0 ); 522 523 # double check that any requested version makes sense 524 $requestedVersion = $latestVersion 525 if ( $requestedVersion !~ /^\d+$/ || 526 $requestedVersion > $latestVersion || 527 $requestedVersion < 0 ); 528 529 die("No requested version when returning to problem?!") 530 if ( ($r->param("previewAnswers") || $r->param("checkAnswers") || 531 $r->param("submitAnswers") || $r->param("newPage")) 532 && ! $requestedVersion ); 533 534 # to test for a proctored test, we need the set version, not the 535 # template, to allow a finished proctored test to be checked as an 536 # unproctored test. so we get the versioned set here 537 my $set; 538 if ( $requestedVersion ) { 539 # if a specific set version was requested, it was stored in the $authz 540 # object when we did the set check 541 $set = $db->getMergedSetVersion($effectiveUserName, $setName, 542 $requestedVersion); 543 } elsif ( $latestVersion ) { 544 # otherwise, if there's a current version, which we take to be the 545 # latest version taken, we use that 546 $set = $db->getMergedSetVersion($effectiveUserName, $setName, 547 $latestVersion); 548 } else { 549 # and if neither of those work, get a dummy set so that we have 550 # something to work with 551 my $userSetClass = $ce->{dbLayout}->{set_version}->{record}; 552 # FIXME RETURN TO: should this be global2version? 553 $set = global2user($userSetClass, $db->getGlobalSet($setName)); 554 die "set $setName not found." unless $set; 555 $set->user_id($effectiveUserName); 556 $set->psvn('000'); 557 $set->set_id("$setName"); # redundant? 558 $set->version_id(0); 559 } 560 my $setVersionNumber = $set->version_id(); 561 562 ################################# 563 # assemble gateway parameters 564 ################################# 565 566 # we get the open/close dates for the gateway from the template set. 567 # note $isOpen/Closed give the open/close dates for the gateway 568 # as a whole (that is, the merged user|global set). because the 569 # set could be bad (if $self->{invalidSet}), we check ->open_date 570 # before actually testing the date 571 my $isOpen = $tmplSet->open_date && 572 ( after($tmplSet->open_date()) || 573 $authz->hasPermissions($userName, "view_unopened_sets") ); 574 575 # FIXME for $isClosed, "record_answers_after_due_date" isn't quite 576 # the right description, but it seems reasonable 577 my $isClosed = $tmplSet->due_date && 578 ( after($tmplSet->due_date()) && 579 ! $authz->hasPermissions($userName, "record_answers_after_due_date") ); 580 581 # to determine if we need a new version, we need to know whether this 582 # version exceeds the number of attempts per version. (among other 583 # things,) the number of attempts is a property of the problem, so 584 # get a problem to check that. note that for a gateway/quiz all 585 # problems will have the same number of attempts. This means that 586 # if the set doesn't have any problems we're up a creek, so check 587 # for that here and bail if it's the case 588 my @setPNum = $db->listUserProblems($EffectiveUser->user_id, $setName); 589 die("Set $setName contains no problems.") if ( ! @setPNum ); 590 591 # the Problem here can be undefined, if the set hasn't been versioned 592 # to the user yet--this gets fixed when we assign the setVersion 593 my $Problem = $setVersionNumber ? 594 $db->getMergedProblemVersion($EffectiveUser->user_id, $setName, 595 $setVersionNumber, $setPNum[0]) : 596 undef; 597 598 # note that having $maxAttemptsPerVersion set to an infinite/0 value is 599 # nonsensical; if we did that, why have versions? 600 my $maxAttemptsPerVersion = $tmplSet->attempts_per_version(); 601 my $timeInterval = $tmplSet->time_interval(); 602 my $versionsPerInterval = $tmplSet->versions_per_interval(); 603 my $timeLimit = $tmplSet->version_time_limit(); 604 605 # what happens if someone didn't set one of these? I think this can 606 # happen if we're handed a malformed set, where the values in the 607 # database are null. 608 $timeInterval = 0 if (! defined($timeInterval) || $timeInterval eq ''); 609 $versionsPerInterval = 0 if (! defined($versionsPerInterval) || 610 $versionsPerInterval eq ''); 611 612 # every problem in the set must have the same submission characteristics 613 my $currentNumAttempts = ( defined($Problem) ? 614 $Problem->num_correct() + 615 $Problem->num_incorrect() : 0 ); 616 617 # $maxAttempts turns into the maximum number of versions we can create; 618 # if $Problem isn't defined, we can't have made any attempts, so it 619 # doesn't matter 620 my $maxAttempts = ( defined($Problem) && 621 defined($Problem->max_attempts()) ? 622 $Problem->max_attempts() : -1 ); 623 624 # finding the number of versions per time interval is a little harder. 625 # we interpret the time interval as a rolling interval: that is, 626 # if we allow two sets per day, that's two sets in any 24 hour 627 # period. this is probably not what we really want, but it's 628 # more extensible to a limitation like "one version per hour", 629 # and we can set it to two sets per 12 hours for most "2ce daily" 630 # type applications 631 my $timeNow = time(); 632 my $grace = $ce->{gatewayGracePeriod}; 633 634 my $currentNumVersions = 0; # this is the number of versions in the 635 # time interval 636 my $totalNumVersions = 0; 637 638 # we don't need to check this if $self->{invalidSet} is already set 639 if ( $setVersionNumber && ! $self->{invalidSet} ) { 640 my @setVersionIDs = $db->listSetVersions($effectiveUserName, $setName); 641 my @setVersions = $db->getSetVersions(map {[$effectiveUserName, $setName,, $_]} @setVersionIDs); 642 foreach ( @setVersions ) { 643 $totalNumVersions++; 644 $currentNumVersions++ 645 if ( ! $timeInterval || 646 $_->version_creation_time() > ($timeNow - $timeInterval) ); 647 } 648 } 649 650 #################################### 651 # new version creation conditional 652 #################################### 653 654 my $versionIsOpen = 0; # can we do anything to this version? 655 656 # recall $isOpen = timeNow > openDate [for the merged userset] and 657 # $isClosed = timeNow > dueDate [for the merged userset] 658 # again, if $self->{invalidSet} is already set, we don't need to 659 # to check this 660 if ( $isOpen && ! $isClosed && ! $self->{invalidSet} ) { 661 662 # if no specific version is requested, we can create a new one if 663 # need be 664 if ( ! $requestedVersion ) { 665 if ( ( $maxAttempts == -1 || 666 $totalNumVersions < $maxAttempts ) 667 && 668 ( $setVersionNumber == 0 || 669 ( 670 ( $currentNumAttempts>=$maxAttemptsPerVersion 671 || 672 $timeNow >= $set->due_date + $grace ) 673 && 674 ( ! $versionsPerInterval 675 || 676 $currentNumVersions < $versionsPerInterval ) 677 ) 678 ) 679 && 680 ( $effectiveUserName eq $userName || 681 $authz->hasPermissions($userName, "record_answers_when_acting_as_student") ) 682 ) { 683 # assign set, get the right name, version 684 # number, etc., and redefine the $set 685 # and $Problem we're working with 686 my $setTmpl = $db->getUserSet($effectiveUserName,$setName); 687 WeBWorK::ContentGenerator::Instructor::assignSetVersionToUser($self, $effectiveUserName, $setTmpl); 688 $setVersionNumber++; 689 $set = $db->getMergedSetVersion($userName, 690 $setName, 691 $setVersionNumber); 692 693 $Problem = $db->getMergedProblemVersion($userName, $setName, $setVersionNumber, 1); 694 # because we're creating this on the fly, 695 # it should be published 696 $set->published(1); 697 # set up creation time, open and due dates 698 my $ansOffset = $set->answer_date() - 699 $set->due_date(); 700 $set->version_creation_time( $timeNow ); 701 $set->open_date( $timeNow ); 702 $set->due_date( $timeNow+$timeLimit ) 703 if (! $set->time_limit_cap || 704 $timeNow+$timeLimit<$set->due_date); 705 $set->answer_date($set->due_date + $ansOffset); 706 $set->version_last_attempt_time( 0 ); 707 # put this new info into the database. note 708 # that this means that -all- of the merged 709 # information gets put back into the 710 # database. as long as the version doesn't 711 # have a long lifespan, this is ok... 712 $db->putSetVersion( $set ); 713 714 # we have a new set version, so it's open 715 $versionIsOpen = 1; 716 717 # also reset the number of attempts for this 718 # set to zero 719 $currentNumAttempts = 0; 720 721 } elsif ( $maxAttempts != -1 && 722 $totalNumVersions > $maxAttempts ) { 723 $self->{invalidSet} = "No new versions of " . 724 "this assignment are available,\n" . 725 "because you have already taken the " . 726 "maximum number\nallowed."; 727 728 } elsif ( $effectiveUserName ne $userName && 729 ! $authz->hasPermissions($userName, "record_answers_when_acting_as_student") ) { 730 $self->{invalidSet} = "User " . 731 "$effectiveUserName is being acted " . 732 "as. When acting as another user, " . 733 "new versions of the set cannot be " . 734 "created."; 735 736 } elsif ($currentNumAttempts < $maxAttemptsPerVersion && 737 $timeNow < $set->due_date() + $grace ) { 738 if ( between($set->open_date(), 739 $set->due_date() + $grace, 740 $timeNow) ) { 741 $versionIsOpen = 1; 742 } else { 743 $versionIsOpen = 0; # redundant 744 $self->{invalidSet} = "No new " . 745 " versions of this assignment" . 746 " are available,\nbecause the" . 747 " set is not open or its time" . 748 " limit has expired.\n"; 749 } 750 751 } elsif ($versionsPerInterval && 752 ($currentNumVersions >= $versionsPerInterval)){ 753 $self->{invalidSet} = "You have already taken" . 754 " all available versions of this\n" . 755 "test in the current time interval. " . 756 "You may take the\ntest again after " . 757 "the time interval has expired."; 758 759 } elsif ( $effectiveUserName ne $userName ) { 760 $self->{invalidSet} = "You are acting as a " . 761 "student, and cannot start new " . 762 "versions of a set for the student."; 763 } 764 765 } else { 766 # (we're still in the $isOpen && ! $isClosed conditional here) 767 # if a specific version is requested, then we only check to 768 # see if it's open 769 if ( 770 ( $currentNumAttempts < $maxAttemptsPerVersion ) 771 && 772 ( $effectiveUserName eq $userName || 773 $authz->hasPermissions($userName, 774 "record_answers_when_acting_as_student") ) 775 ) { 776 if ( between($set->open_date(), 777 $set->due_date() + $grace, 778 $timeNow) ) { 779 $versionIsOpen = 1; 780 } else { 781 $versionIsOpen = 0; # redundant 782 } 783 } 784 } 785 786 # closed set, with attempt at a new one 787 } elsif ( ! $self->{invalidSet} && ! $requestedVersion ) { 788 $self->{invalidSet} = "This set is closed. No new set " . 789 "versions may be taken."; 790 } 791 792 793 #################################### 794 # save problem and user data 795 #################################### 796 797 my $psvn = $set->psvn(); 798 $self->{tmplSet} = $tmplSet; 799 $self->{set} = $set; 800 $self->{problem} = $Problem; 801 $self->{requestedVersion} = $requestedVersion; 802 803 $self->{userName} = $userName; 804 $self->{effectiveUserName} = $effectiveUserName; 805 $self->{user} = $User; 806 $self->{effectiveUser} = $EffectiveUser; 807 $self->{permissionLevel} = $permissionLevel; 808 809 $self->{isOpen} = $isOpen; 810 $self->{isClosed} = $isClosed; 811 $self->{versionIsOpen} = $versionIsOpen; 812 813 $self->{timeNow} = $timeNow; 814 815 #################################### 816 # form processing 817 #################################### 818 819 # this is the same as the following, but doesn't appear in Problem.pm 820 my $newPage = $r->param("newPage"); 821 $self->{newPage} = $newPage; 822 823 # also get the current page, if it's given 824 my $currentPage = $r->param("currentPage") || 1; 825 826 # this is a hack manage previewing a page. we set previewAnswers to 827 # yes if either of the following are true: 828 # 1. the "previewAnswers" input is set (the "preview" button was 829 # clicked), or 830 # 2. the "previewHack" input is set (a preview link was used) 831 my $prevOr = $r->param('previewAnswers') || $r->param('previewHack'); 832 $r->param('previewAnswers', $prevOr) if ( defined( $prevOr ) ); 833 834 # [This section lifted from Problem.pm] ############################## 835 836 # set options from form fields (see comment at top of file for names) 837 my $displayMode = $r->param("displayMode") || 838 $ce->{pg}->{options}->{displayMode}; 839 my $redisplay = $r->param("redisplay"); 840 my $submitAnswers = $r->param("submitAnswers"); 841 my $checkAnswers = $r->param("checkAnswers"); 842 my $previewAnswers = $r->param("previewAnswers"); 843 844 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 845 846 $self->{displayMode} = $displayMode; 847 $self->{redisplay} = $redisplay; 848 $self->{submitAnswers} = $submitAnswers; 849 $self->{checkAnswers} = $checkAnswers; 850 $self->{previewAnswers} = $previewAnswers; 851 $self->{formFields} = $formFields; 852 853 # now that we've set all the necessary variables quit out if the set or 854 # problem is invalid 855 return if $self->{invalidSet} || $self->{invalidProblem}; 856 857 # [End lifted section] ############################################### 858 859 #################################### 860 # permissions 861 #################################### 862 863 # bail without doing anything if the set isn't yet open for this user 864 return unless $self->{isOpen}; 865 866 # what does the user want to do? 867 my %want = 868 (showOldAnswers => $r->param("showOldAnswers") || 869 $ce->{pg}->{options}->{showOldAnswers}, 870 showCorrectAnswers => ($r->param("showCorrectAnswers") || 871 $ce->{pg}->{options}->{showCorrectAnswers}) && 872 ($submitAnswers || $checkAnswers), 873 showHints => $r->param("showHints") || 874 $ce->{pg}->{options}->{showHints}, 875 showSolutions => ($r->param("showSolutions") || 876 $ce->{pg}->{options}->{showSolutions}) && 877 ($submitAnswers || $checkAnswers), 878 recordAnswers => $submitAnswers, 879 # we also want to check answers if we were checking answers and are 880 # switching between pages 881 checkAnswers => $checkAnswers, 882 ); 883 884 # are certain options enforced? 885 my %must = 886 (showOldAnswers => 0, 887 showCorrectAnswers => 0, 888 showHints => 0, 889 showSolutions => 0, 890 recordAnswers => ! $authz->hasPermissions($userName, 891 "avoid_recording_answers"), 892 checkAnswers => 0, 893 ); 894 895 # does the user have permission to use certain options? 896 my @args = ($User, $PermissionLevel, $EffectiveUser, $set, $Problem, 897 $tmplSet); 898 my $sAns = ( $submitAnswers ? 1 : 0 ); 899 my %can = 900 (showOldAnswers => $self->can_showOldAnswers(@args), 901 showCorrectAnswers => $self->can_showCorrectAnswers(@args, $sAns), 902 showHints => $self->can_showHints(@args), 903 showSolutions => $self->can_showSolutions(@args, $sAns), 904 recordAnswers => $self->can_recordAnswers(@args), 905 checkAnswers => $self->can_checkAnswers(@args), 906 recordAnswersNextTime => $self->can_recordAnswers(@args, $sAns), 907 checkAnswersNextTime => $self->can_checkAnswers(@args, $sAns), 908 showScore => $self->can_showScore(@args), 909 ); 910 911 # final values for options 912 my %will; 913 foreach (keys %must) { 914 $will{$_} = $can{$_} && ($must{$_} || $want{$_}) ; 915 } 916 917 ##### store fields ##### 918 919 ## FIXME: the following is present in Problem.pm, but missing here. how do we 920 ## deal with it in the context of multiple problems with possible hints? 921 ## ##### fix hint/solution options ##### 922 ## $can{showHints} &&= $pg->{flags}->{hintExists} 923 ## &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; 924 ## $can{showSolutions} &&= $pg->{flags}->{solutionExists}; 925 926 $self->{want} = \%want; 927 $self->{must} = \%must; 928 $self->{can} = \%can; 929 $self->{will} = \%will; 930 931 932 #################################### 933 # set up problem numbering and multipage variables 934 #################################### 935 936 my @problemNumbers = $db->listProblemVersions($effectiveUserName, 937 $setName, 938 $setVersionNumber); 939 940 # to speed up processing of long (multi-page) tests, we want to only 941 # translate those problems that are being submitted or are currently 942 # being displayed. so work out here which problems are on the 943 # current page. 944 my ( $numPages, $pageNumber, $numProbPerPage ) = ( 1, 0, 0 ); 945 my ( $startProb, $endProb ) = ( 0, $#problemNumbers ); 946 947 # update startProb and endProb for multipage tests 948 if ( defined($set->problems_per_page) && $set->problems_per_page ) { 949 $numProbPerPage = $set->problems_per_page; 950 $pageNumber = ($newPage) ? $newPage : $currentPage; 951 952 $numPages = scalar(@problemNumbers)/$numProbPerPage; 953 $numPages = int($numPages) + 1 if (int($numPages) != $numPages); 954 955 $startProb = ($pageNumber - 1)*$numProbPerPage; 956 $startProb = 0 if ( $startProb < 0 || 957 $startProb > $#problemNumbers ); 958 $endProb = ($startProb + $numProbPerPage > $#problemNumbers) ? 959 $#problemNumbers : $startProb + $numProbPerPage - 1; 960 } 961 962 963 # set up problem list for randomly ordered tests 964 my @probOrder = (0..$#problemNumbers); 965 966 # there's a routine to do this somewhere, I think... 967 if ( $set->problem_randorder ) { 968 my @newOrder = (); 969 # we need to keep the random order the same each time the set is loaded! 970 # this requires either saving the order in the set definition, or 971 # being sure that the random seed that we use is the same each time 972 # the same set is called. we'll do the latter by setting the seed 973 # to the psvn of the problem set. we use a local PGrandom object 974 # to avoid mucking with the system seed. 975 my $pgrand = PGrandom->new(); 976 $pgrand->srand( $set->psvn ); 977 while ( @probOrder ) { 978 my $i = int($pgrand->rand(scalar(@probOrder))); 979 push( @newOrder, $probOrder[$i] ); 980 splice(@probOrder, $i, 1); 981 } 982 @probOrder = @newOrder; 983 } 984 # now $probOrder[i] = the problem number, numbered from zero, that's 985 # displayed in the ith position on the test 986 987 # make a list of those problems we're displaying 988 my @probsToDisplay = (); 989 for ( my $i=0; $i<@probOrder; $i++ ) { 990 push(@probsToDisplay, $probOrder[$i]) 991 if ( $i >= $startProb && $i <= $endProb ); 992 } 993 994 #################################### 995 # process problems 996 #################################### 997 998 my @problems = (); 999 my @pg_results = (); 1000 # pg errors are stored here; initialize it to empty to start 1001 $self->{errors} = [ ]; 1002 1003 # process the problems as needed 1004 my @mergedProblems = $db->getAllMergedProblemVersions($effectiveUserName, $setName, $setVersionNumber); 1005 foreach my $problemNumber (sort {$a<=>$b } @problemNumbers) { 1006 1007 # pIndex numbers from zero 1008 my $pIndex = $problemNumber - 1; 1009 if ( ! defined( $mergedProblems[$pIndex] ) ) { 1010 $self->{invalidSet} = "One or more of the problems " . 1011 "in this set have not been assigned to you."; 1012 return; 1013 } 1014 my $ProblemN = $mergedProblems[$pIndex]; 1015 1016 # sticky answers are set up here 1017 if ( not ( $submitAnswers or $previewAnswers or $checkAnswers or 1018 $newPage ) and $will{showOldAnswers} ) { 1019 1020 my %oldAnswers = decodeAnswers( $ProblemN->last_answer); 1021 $formFields->{$_} = $oldAnswers{$_} foreach ( keys %oldAnswers ); 1022 } 1023 push( @problems, $ProblemN ); 1024 1025 # if we don't have to translate this problem, just save the 1026 # problem number 1027 my $pg = $problemNumber; 1028 # this is the actual translation of each problem. errors are 1029 # stored in @{$self->{errors}} in each case 1030 if ( (grep /^$pIndex$/, @probsToDisplay) || $submitAnswers ) { 1031 $pg = $self->getProblemHTML($self->{effectiveUser}, 1032 $setName,$setVersionNumber, 1033 $formFields, $ProblemN); 1034 } 1035 push(@pg_results, $pg); 1036 } 1037 $self->{ra_problems} = \@problems; 1038 $self->{ra_pg_results}=\@pg_results; 1039 1040 $self->{startProb} = $startProb; 1041 $self->{endProb} = $endProb; 1042 $self->{numPages} = $numPages; 1043 $self->{pageNumber} = $pageNumber; 1044 $self->{ra_probOrder} = \@probOrder; 1045 } 1046 1047 sub path { 1048 my ( $self, $args ) = @_; 1049 1050 my $r = $self->{r}; 1051 my $setName = $r->urlpath->arg("setID"); 1052 my $ce = $self->{ce}; 1053 my $root = $ce->{webworkURLs}->{root}; 1054 my $courseName = $ce->{courseName}; 1055 1056 return $self->pathMacro( $args, "Home" => "$root", 1057 $courseName => "$root/$courseName", 1058 $setName => "" ); 1059 } 1060 1061 sub nav { 1062 my ($self, $args) = @_; 1063 1064 my $r = $self->{r}; 1065 my $setName = $r->urlpath->arg("setID"); 1066 my $ce = $self->{ce}; 1067 my $root = $ce->{webworkURLs}->{root}; 1068 my $courseName = $ce->{courseName}; 1069 my @links = ("Problem Sets" , "$root/$courseName", "navUp"); 1070 my $tail = ""; 1071 1072 return $self->navMacro($args, $tail, @links); 1073 } 1074 1075 sub options { 1076 my ($self) = @_; 1077 #warn "doing options in GatewayQuiz"; 1078 1079 # don't show options if we don't have anything to show 1080 return if $self->{invalidSet} or $self->{invalidProblem}; 1081 return unless $self->{isOpen}; 1082 1083 my $displayMode = $self->{displayMode}; 1084 my %can = %{ $self->{can} }; 1085 1086 my @options_to_show = "displayMode"; 1087 push @options_to_show, "showOldAnswers" if $can{showOldAnswers}; 1088 push @options_to_show, "showHints" if $can{showHints}; 1089 push @options_to_show, "showSolutions" if $can{showSolutions}; 1090 1091 return $self->optionsMacro( 1092 options_to_show => \@options_to_show, 1093 ); 1094 } 1095 1096 sub body { 1097 my $self = shift(); 1098 my $r = $self->r; 1099 my $ce = $r->ce; 1100 my $db = $r->db; 1101 my $authz = $r->authz; 1102 my $urlpath = $r->urlpath; 1103 my $user = $r->param('user'); 1104 my $effectiveUser = $r->param('effectiveUser'); 1105 1106 # report everything with the same time that we started with 1107 my $timeNow = $self->{timeNow}; 1108 my $grace = $ce->{gatewayGracePeriod}; 1109 1110 ######################################### 1111 # preliminary error checking and output 1112 ######################################### 1113 1114 # if $self->{invalidSet} is set, then we have an error and should 1115 # just bail with the appropriate error message 1116 1117 if ($self->{invalidSet}) { 1118 # delete any proctor keys that are floating around 1119 if ( $self->{'assignment_type'} eq 'proctored_gateway' ) { 1120 my $proctorID = $r->param('proctor_user'); 1121 if ( $proctorID ) { 1122 eval{ $db->deleteKey("$effectiveUser,$proctorID"); }; 1123 eval{ $db->deleteKey("$effectiveUser,$proctorID,g"); }; 1124 } 1125 } 1126 1127 return CGI::div({class=>"ResultsWithError"}, 1128 CGI::p("The selected problem set (" . 1129 $urlpath->arg("setID") . ") is not " . 1130 "a valid set for $effectiveUser:"), 1131 CGI::p($self->{invalidSet})); 1132 } 1133 1134 my $tmplSet = $self->{tmplSet}; 1135 my $set = $self->{set}; 1136 my $Problem = $self->{problem}; 1137 my $permissionLevel = $self->{permissionLevel}; 1138 my $submitAnswers = $self->{submitAnswers}; 1139 my $checkAnswers = $self->{checkAnswers}; 1140 my $previewAnswers = $self->{previewAnswers}; 1141 my $newPage = $self->{newPage}; 1142 my %want = %{ $self->{want} }; 1143 my %can = %{ $self->{can} }; 1144 my %must = %{ $self->{must} }; 1145 my %will = %{ $self->{will} }; 1146 1147 my @problems = @{ $self->{ra_problems} }; 1148 my @pg_results = @{ $self->{ra_pg_results} }; 1149 my @pg_errors = @{ $self->{errors} }; 1150 my $requestedVersion = $self->{requestedVersion}; 1151 1152 my $startProb = $self->{startProb}; 1153 my $endProb = $self->{endProb}; 1154 my $numPages = $self->{numPages}; 1155 my $pageNumber = $self->{pageNumber}; 1156 my @probOrder = @{$self->{ra_probOrder}}; 1157 1158 my $setName = $set->set_id; 1159 my $versionNumber = $set->version_id; 1160 my $setVName = "$setName,v$versionNumber"; 1161 my $numProbPerPage = $set->problems_per_page; 1162 1163 # translation errors -- we use the same output routine as Problem.pm, 1164 # but play around to allow for errors on multiple translations 1165 # because we have an array of problems to deal with. 1166 if ( @pg_errors ) { 1167 my $errorNum = 1; 1168 my ( $message, $context ) = ( '', '' ); 1169 foreach ( @pg_errors ) { 1170 1171 $message .= "$errorNum. " if ( @pg_errors > 1 ); 1172 $message .= $_->{message} . CGI::br() . "\n"; 1173 1174 $context .= CGI::p((@pg_errors > 1? "$errorNum.": '') . 1175 $_->{context} ) . "\n\n" . 1176 CGI::hr() . "\n\n"; 1177 } 1178 return $self->errorOutput( $message, $context ); 1179 } 1180 1181 #################################### 1182 # answer processing 1183 #################################### 1184 1185 debug("begin answer processing"); 1186 1187 my @scoreRecordedMessage = ('') x scalar(@problems); 1188 1189 #################################### 1190 # save results to database as appropriate 1191 #################################### 1192 if ( $submitAnswers || ( ($previewAnswers || $newPage) && 1193 $can{recordAnswers} ) ) { 1194 # if we're submitting answers, we have to save the problems 1195 # to the database. 1196 # if we're previewing or switching pages and can still 1197 # record answers, we save the last answer for future 1198 # reference 1199 1200 # first, if we're submitting answers for a proctored exam, 1201 # we want to delete the proctor keys that authorized 1202 # that grading, so that it isn't possible to just log 1203 # in and take another proctored test without getting 1204 # reauthorized 1205 if ( $submitAnswers && 1206 $self->{'assignment_type'} eq 'proctored_gateway' ) { 1207 my $proctorID = $r->param('proctor_user'); 1208 1209 # if we don't have attempts left, delete all 1210 # proctor keys for this user 1211 if ( $set->attempts_per_version - 1 - 1212 $Problem->num_correct - $Problem->num_incorrect 1213 <= 0 ) { 1214 eval{ $db->deleteAllProctorKeys( $effectiveUser ); }; 1215 } else { 1216 # otherwise, delete only the grading key 1217 eval{ $db->deleteKey("$effectiveUser,$proctorID,g"); }; 1218 # in this case we may have a past, login, 1219 # proctor key that we can keep so that 1220 # we don't have to get another login to 1221 # continue working the test 1222 if ( $r->param("past_proctor_user") && 1223 $r->param("past_proctor_key") ) { 1224 $r->param("proctor_user", $r->param("past_proctor_user")); 1225 $r->param("proctor_key", $r->param("past_proctor_key")); 1226 } 1227 } 1228 # this is unsubtle, but we'd rather not have bogus 1229 # keys sitting around 1230 if ( $@ ) { 1231 die("ERROR RESETTING PROCTOR GRADING KEY(S): $@\n"); 1232 } 1233 1234 } 1235 1236 my @pureProblems = $db->getAllProblemVersions($effectiveUser, 1237 $setName, 1238 $versionNumber); 1239 foreach my $i ( 0 .. $#problems ) { # process each problem 1240 # this code is essentially that from Problem.pm 1241 my $pureProblem = $pureProblems[$i]; 1242 1243 # store answers in problem for sticky answers later 1244 my %answersToStore; 1245 1246 # we have to be a little careful about getting the 1247 # answers that we're saving, because we don't have 1248 # a pg_results object for all problems if we're not 1249 # submitting 1250 my %answerHash = (); 1251 my @answer_order = (); 1252 if ( ref( $pg_results[$i] ) ) { 1253 %answerHash = %{$pg_results[$i]->{answers}}; 1254 $answersToStore{$_} = $self->{formFields}->{$_} 1255 foreach (keys %answerHash); 1256 # check for extra answers that slipped 1257 # by---e.g. for matrices, and get them 1258 # from the original input form 1259 my @extra_answer_names = 1260 @{ $pg_results[$i]->{flags}->{KEPT_EXTRA_ANSWERS} }; 1261 $answersToStore{$_} = 1262 $self->{formFields}->{$_} foreach (@extra_answer_names); 1263 @answer_order = 1264 ( @{$pg_results[$i]->{flags}->{ANSWER_ENTRY_ORDER}}, 1265 @extra_answer_names ); 1266 } else { 1267 my $prefix = sprintf('Q%04d_',$i+1); 1268 my @fields = sort grep {/^$prefix/} (keys %{$self->{formFields}}); 1269 %answersToStore = map {$_ => $self->{formFields}->{$_}} @fields; 1270 @answer_order = @fields; 1271 } 1272 my $answerString = encodeAnswers( %answersToStore, 1273 @answer_order ); 1274 # and get the last answer 1275 $problems[$i]->last_answer( $answerString ); 1276 $pureProblem->last_answer( $answerString ); 1277 1278 # next, store the state in the database if that makes 1279 # sense 1280 if ( $submitAnswers && $will{recordAnswers} ) { 1281 $problems[$i]->status($pg_results[$i]->{state}->{recorded_score}); 1282 $problems[$i]->attempted(1); 1283 $problems[$i]->num_correct($pg_results[$i]->{state}->{num_of_correct_ans}); 1284 $problems[$i]->num_incorrect($pg_results[$i]->{state}->{num_of_incorrect_ans}); 1285 $pureProblem->status($pg_results[$i]->{state}->{recorded_score}); 1286 $pureProblem->attempted(1); 1287 $pureProblem->num_correct($pg_results[$i]->{state}->{num_of_correct_ans}); 1288 $pureProblem->num_incorrect($pg_results[$i]->{state}->{num_of_incorrect_ans}); 1289 1290 if ( $db->putProblemVersion( $pureProblem ) ) { 1291 $scoreRecordedMessage[$i] = "Your " . 1292 "score on this problem was " . 1293 "recorded."; 1294 } else { 1295 $scoreRecordedMessage[$i] = "Your " . 1296 "score was not recorded " . 1297 "because there was a failure " . 1298 "in storing the problem " . 1299 "record to the database."; 1300 } 1301 # write the transaction log 1302 writeLog( $self->{ce}, "transaction", 1303 $problems[$i]->problem_id . "\t" . 1304 $problems[$i]->set_id . "\t" . 1305 $problems[$i]->user_id . "\t" . 1306 $problems[$i]->source_file . "\t" . 1307 $problems[$i]->value . "\t" . 1308 $problems[$i]->max_attempts . "\t" . 1309 $problems[$i]->problem_seed . "\t" . 1310 $problems[$i]->status . "\t" . 1311 $problems[$i]->attempted . "\t" . 1312 $problems[$i]->last_answer . "\t" . 1313 $problems[$i]->num_correct . "\t" . 1314 $problems[$i]->num_incorrect 1315 ); 1316 } elsif ( $submitAnswers ) { 1317 # this is the case where we submitted answers 1318 # but can't save them; report an error 1319 # message 1320 1321 if ($self->{isClosed}) { 1322 $scoreRecordedMessage[$i] = "Your " . 1323 "score was not recorded " . 1324 "because this problem set " . 1325 "version is not open."; 1326 } elsif ( $problems[$i]->num_correct + 1327 $problems[$i]->num_incorrect >= 1328 $set->attempts_per_version ) { 1329 $scoreRecordedMessage[$i] = "Your " . 1330 "score was not recorded " . 1331 "because you have no " . 1332 "attempts remaining on this " . 1333 "set version."; 1334 } elsif ( ! $self->{versionIsOpen} ) { 1335 my $endTime = ( $set->version_last_attempt_time ) ? $set->version_last_attempt_time : $timeNow; 1336 if ($endTime > $set->due_date && 1337 $endTime < $set->due_date + $grace){ 1338 $endTime = $set->due_date; 1339 } 1340 my $elapsed = 1341 int(($endTime - $set->open_date)/0.6 + 0.5)/100; 1342 # we assume that allowed is an even 1343 # number of minutes 1344 my $allowed = ($set->due_date - $set->open_date)/60; 1345 $scoreRecordedMessage[$i] = "Your " . 1346 "score was not recorded " . 1347 "because you have exceeded " . 1348 "the time limit for this " . 1349 "test. (Time taken: $elapsed " . 1350 "min; allowed: $allowed min.)"; 1351 } else { 1352 $scoreRecordedMessage[$i] = "Your " . 1353 "score was not recorded."; 1354 } 1355 } else { 1356 # finally, we must be previewing or switching 1357 # pages. save only the last answer for the 1358 # problems 1359 $db->putProblemVersion( $pureProblem ); 1360 } 1361 } # end loop through problems 1362 1363 ## finally, log student answers if we're submitting, 1364 ## previewing, or changing pages, provided that we can 1365 ## record answers. note that this will log an overtime 1366 ## submission (or any case where someone submits the 1367 ## test, or spoofs a request to submit a test) 1368 1369 my $answer_log = 1370 $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 1371 1372 # this is carried over from Problem.pm 1373 if ( defined( $answer_log ) ) { 1374 foreach my $i ( 0 .. $#problems ) { 1375 my $answerString = ''; 1376 my $scores = ''; 1377 # note that we store these answers in the 1378 # order that they are presented, not the 1379 # actual problem order 1380 if ( ref( $pg_results[$probOrder[$i]] ) ) { 1381 my %answerHash = %{ $pg_results[$probOrder[$i]]->{answers} }; 1382 foreach ( sortByName(undef, keys %answerHash) ) { 1383 my $sAns = $answerHash{$_}->{original_student_ans} || ''; 1384 $answerString .= $sAns . "\t"; 1385 $scores .= $answerHash{$_}->{score}>=1 ? "1" : "0" if ( $submitAnswers ); 1386 } 1387 } else { 1388 my $prefix = sprintf('Q%04d_', ($probOrder[$i]+1)); 1389 my @fields = sort grep {/^$prefix/} (keys %{$self->{formFields}}); 1390 foreach ( @fields ) { 1391 $answerString .= $self->{formFields}->{$_} . "\t"; 1392 $scores .= $self->{formFields}->{"probstatus" . ($probOrder[$i]+1)} >= 1 ? "1" : "0" if ( $submitAnswers ); 1393 } 1394 } 1395 $answerString =~ s/\t+$/\t/; 1396 1397 my $answerPrefix; 1398 if ( $submitAnswers ) { 1399 $answerPrefix = "[submit] "; 1400 } elsif ( $previewAnswers ) { 1401 $answerPrefix = "[preview] "; 1402 } else { 1403 $answerPrefix = "[newPage] "; 1404 } 1405 1406 if ( ! $answerString || 1407 $answerString =~ /^\t$/ ) { 1408 $answerString = "$answerPrefix" . 1409 "No answer entered\t"; 1410 } else { 1411 $answerString = "$answerPrefix" . 1412 "$answerString"; 1413 } 1414 1415 writeCourseLog( $self->{ce}, "answer_log", 1416 join("", '|', 1417 $problems[$i]->user_id, 1418 '|', $setVName, 1419 '|', ($i+1), '|', $scores, 1420 "\t$timeNow\t", 1421 "$answerString"), 1422 ); 1423 } 1424 } 1425 } 1426 debug("end answer processing"); 1427 1428 # additional set-level database manipulation: we want to save the time 1429 # that a set was submitted, and for proctored tests we want to reset 1430 # the assignment type after a set is submitted for the last time so 1431 # that it's possible to look at it later without getting proctor 1432 # authorization 1433 if ( ( $submitAnswers && 1434 ( $will{recordAnswers} || 1435 ( ! $set->version_last_attempt_time() && 1436 $timeNow > $set->due_date + $grace ) ) ) || 1437 ( ! $can{recordAnswersNextTime} && 1438 $set->assignment_type() eq 'proctored_gateway' ) ) { 1439 1440 my $setName = $set->set_id(); 1441 1442 # save the submission time if we're recording the answer, or if the 1443 # first submission occurs after the due_date 1444 if ( $submitAnswers && 1445 ( $will{recordAnswers} || 1446 ( ! $set->version_last_attempt_time() && 1447 $timeNow > $set->due_date + $grace ) ) ) { 1448 $set->version_last_attempt_time( $timeNow ); 1449 } 1450 if ( ! $can{recordAnswersNextTime} && 1451 $set->assignment_type() eq 'proctored_gateway' ) { 1452 $set->assignment_type( 'gateway' ); 1453 } 1454 $db->putSetVersion( $set ); 1455 } 1456 1457 1458 #################################### 1459 # output 1460 #################################### 1461 1462 # some convenient output variables 1463 my $canShowProblemScores = $can{showScore} && 1464 ($set->hide_score eq 'N' || $set->hide_score_by_problem eq 'N' || 1465 $authz->hasPermissions($user, "view_hidden_work")); 1466 my $canShowWork = $authz->hasPermissions($user, "view_hidden_work") || ($set->hide_work eq 'N' || ($set->hide_work eq 'BeforeAnswerDate' && $timeNow>$tmplSet->answer_date)); 1467 1468 # for nicer answer checking on multi-page tests, we want to keep 1469 # track of any changes that someone made to a different page, 1470 # and what their score was. we use @probStatus to do this. we 1471 # initialize this to any known scores, and then update this when 1472 # calculating the score for checked or submitted tests 1473 my @probStatus = (); 1474 # we also figure out recorded score for the set, if any, and score 1475 # on this attempt 1476 my $recordedScore = 0; 1477 my $totPossible = 0; 1478 foreach ( @problems ) { 1479 $totPossible += $_->value(); 1480 $recordedScore += $_->status*$_->value() if (defined($_->status)); 1481 push( @probStatus, ($r->param("probstatus" . $_->problem_id) || 1482 $_->status || 0) ); 1483 } 1484 1485 # to get the attempt score, we have to figure out what the score on 1486 # each part of each problem is, and multiply the total for the 1487 # problem by the weight (value) of the problem. to make things 1488 # even more interesting, we are avoiding translating all of the 1489 # problems when checking answers 1490 my $attemptScore = 0; 1491 1492 if ( $submitAnswers || $checkAnswers ) { 1493 my $i=0; 1494 foreach my $pg ( @pg_results ) { 1495 my $pValue = $problems[$i]->value(); 1496 my $pScore = 0; 1497 my $numParts = 0; 1498 if ( ref( $pg ) ) { # then we have a pg object 1499 foreach (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}){ 1500 $pScore += $pg->{answers}->{$_}->{score}; 1501 $numParts++; 1502 } 1503 $probStatus[$i] = $pScore/($numParts>0 ? $numParts : 1); 1504 1505 } else { 1506 # if we don't have a pg object, use any known 1507 # problem status (this defaults to zero) 1508 $pScore = $probStatus[$i]; 1509 } 1510 $attemptScore += $pScore*$pValue/($numParts > 0 ? $numParts : 1); 1511 $i++; 1512 } 1513 } 1514 1515 # we want to print elapsed and allowed times; allowed is easy (we assume 1516 # this is an even number of minutes) 1517 my $allowed = ($set->due_date - $set->open_date)/60; 1518 # elapsed is a little harder; we're counting to the last submission 1519 # time, or to the current time if the test hasn't been submitted, 1520 # and if the submission fell in the grace period round it to the 1521 # due_date 1522 my $exceededAllowedTime = 0; 1523 my $endTime = ( $set->version_last_attempt_time ) ? 1524 $set->version_last_attempt_time : $timeNow; 1525 if ( $endTime > $set->due_date && $endTime < $set->due_date + $grace ) { 1526 $endTime = $set->due_date; 1527 } elsif ( $endTime > $set->due_date ) { 1528 $exceededAllowedTime = 1; 1529 } 1530 my $elapsedTime = int(($endTime - $set->open_date)/0.6 + 0.5)/100; 1531 1532 # also get number of remaining attempts (important for sets with 1533 # multiple attempts per version) 1534 my $numLeft = $set->attempts_per_version - $Problem->num_correct - 1535 $Problem->num_incorrect - 1536 ($submitAnswers && $will{recordAnswers} ? 1 : 0); 1537 my $attemptNumber = $Problem->num_correct + $Problem->num_incorrect; 1538 1539 # a handy noun for when referring to a test 1540 my $testNoun = ($set->attempts_per_version > 1) ? "submission" : "test"; 1541 my $testNounNum = ( $set->attempts_per_version > 1 ) ? 1542 "submission (test " : "test ("; 1543 1544 ##### start output of test headers: 1545 ##### display information about recorded and checked scores 1546 if ( $submitAnswers ) { 1547 # the distinction between $can{recordAnswers} and ! $can{} has 1548 # been dealt with above and recorded in @scoreRecordedMessage 1549 my $divClass = 'ResultsWithoutError'; 1550 my $recdMsg = ''; 1551 foreach ( @scoreRecordedMessage ) { 1552 if ($_ ne 'Your score on this problem was recorded.') { 1553 $recdMsg = $_; 1554 $divClass = 'ResultsWithError'; 1555 last; 1556 } 1557 } 1558 print CGI::start_div({class=>$divClass}); 1559 1560 if ( $recdMsg ) { 1561 # then there was an error when saving the results 1562 print CGI::strong("Your score on this $testNounNum ", 1563 "$versionNumber) was NOT recorded. ", 1564 $recdMsg), CGI::br(); 1565 } else { 1566 # no error; print recorded message 1567 print CGI::strong("Your score on this $testNounNum ", 1568 "$versionNumber) WAS recorded."), 1569 CGI::br(); 1570 1571 # and show the score if we're allowed to do that 1572 if ( $can{showScore} ) { 1573 print CGI::strong("Your score on this " . 1574 "$testNoun is ", 1575 "$attemptScore/$totPossible."); 1576 } else { 1577 my $when = 1578 ($set->hide_score eq 'BeforeAnswerDate') 1579 ? ' until ' . formatDateTime($set->answer_date) 1580 : ''; 1581 print CGI::br() . 1582 "(Your score on this $testNoun " . 1583 "is not available$when.)"; 1584 } 1585 } 1586 1587 # finally, if there is another, recorded message, print that 1588 # too so that we know what's going on 1589 print CGI::end_div(); 1590 if ( $set->attempts_per_version > 1 && $attemptNumber > 1 && 1591 $recordedScore != $attemptScore && $can{showScore} ) { 1592 print CGI::start_div({class=>'gwMessage'}); 1593 print "The recorded score for this test is ", 1594 "$recordedScore/$totPossible."; 1595 print CGI::end_div(); 1596 } 1597 1598 } elsif ( $checkAnswers ) { 1599 if ( $can{showScore} ) { 1600 print CGI::start_div({class=>'gwMessage'}); 1601 print CGI::strong("Your score on this (checked, not ", 1602 "recorded) submission is ", 1603 "$attemptScore/$totPossible."), 1604 CGI::br(); 1605 print "The recorded score for this test is " . 1606 "$recordedScore/$totPossible. "; 1607 print CGI::end_div(); 1608 } 1609 } 1610 1611 ##### remaining output of test headers: 1612 ##### display timer or information about elapsed time, "printme" link, 1613 ##### and information about any recorded score if not submitAnswers or 1614 ##### checkAnswers 1615 if ( $can{recordAnswersNextTime} ) { 1616 1617 # print timer 1618 # FIXME: in the long run, we want to allow a test to not be 1619 # timed. This does not allow for that possibility 1620 my $timeLeft = $set->due_date() - $timeNow; # this is in secs 1621 print CGI::div({-id=>"gwTimer"},"\n"); 1622 print CGI::startform({-name=>"gwTimeData", -method=>"POST", 1623 -action=>$r->uri}); 1624 print CGI::hidden({-name=>"serverTime", -value=>$timeNow}), 1625 "\n"; 1626 print CGI::hidden({-name=>"serverDueTime", 1627 -value=>$set->due_date()}), "\n"; 1628 print CGI::endform(); 1629 1630 if ( $timeLeft < 1 && $timeLeft > 0 ) { 1631 print CGI::span({-class=>"resultsWithError"}, 1632 CGI::b("You have less than 1 minute ", 1633 "to complete this test.\n")); 1634 } elsif ( $timeLeft <= 0 ) { 1635 print CGI::span({-class=>"resultsWithError"}, 1636 CGI::b("You are out of time. ", 1637 "Press grade now!\n")); 1638 } 1639 # if there are multiple attempts per version, indicate the 1640 # number remaining, and if we've submitted a multiple 1641 # attempt multi-page test, show the score on the previous 1642 # submission 1643 if ( $set->attempts_per_version > 1 ) { 1644 print CGI::em("You have $numLeft attempt(s) remaining ", 1645 "on this test."); 1646 if ( $numLeft < $set->attempts_per_version && 1647 $numPages > 1 && 1648 $can{showScore} ) { 1649 print CGI::start_div({-id=>"gwScoreSummary"}), 1650 CGI::strong({},"Score summary for " . 1651 "last submit:"); 1652 print CGI::start_table({"border"=>0, 1653 "cellpadding"=>0, 1654 "cellspacing"=>0}); 1655 print CGI::Tr({},CGI::th({-align=>"left"}, 1656 ["Prob","","Status","", 1657 "Result"])); 1658 for ( my $i=0; $i<@probStatus; $i++ ) { 1659 print CGI::Tr({}, 1660 CGI::td({},[($i+1),"",int(100*$probStatus[$probOrder[$i]]+0.5) . "%","", $probStatus[$probOrder[$i]] == 1 ? "Correct" : "Incorrect"])); 1661 } 1662 print CGI::end_table(), CGI::end_div(); 1663 } 1664 } 1665 } else { 1666 print CGI::start_div({class=>'gwMessage'}); 1667 1668 if ( ! $checkAnswers && ! $submitAnswers ) { 1669 1670 if ( $can{showScore} ) { 1671 my $scMsg = "Your recorded score on this " . 1672 "(test number $versionNumber) is " . 1673 "$recordedScore/$totPossible"; 1674 if ( $exceededAllowedTime && 1675 $recordedScore == 0 ) { 1676 $scMsg .= ", because you exceeded " . 1677 "the allowed time."; 1678 } else { 1679 $scMsg .= ". "; 1680 } 1681 print CGI::strong($scMsg), CGI::br(); 1682 } 1683 } 1684 1685 if ( $set->version_last_attempt_time ) { 1686 print "Time taken on test: $elapsedTime min " . 1687 "($allowed min allowed)."; 1688 } elsif ( $exceededAllowedTime && $recordedScore != 0 ) { 1689 print "(This test is overtime because it was not " . 1690 "submitted in the allowed time.)"; 1691 } 1692 print CGI::end_div(); 1693 1694 if ( $canShowWork ) { 1695 print "The test (which is number $versionNumber) may " . 1696 "no longer be submitted for a grade"; 1697 print "" . (($can{showScore}) ? ", but you may still " . 1698 "check your answers." : ".") ; 1699 1700 # print a "printme" link if we're allowed to see our 1701 # work 1702 my $link = $ce->{webworkURLs}->{root} . '/' . 1703 $ce->{courseName} . '/hardcopy/' . 1704 $set->set_id . ',v' . $set->version_id . '/?' . 1705 $self->url_authen_args; 1706 my $printmsg = CGI::div({-class=>'gwPrintMe'}, 1707 CGI::a({-href=>$link}, 1708 "Print Test")); 1709 print $printmsg; 1710 } 1711 } 1712 1713 # this is a hack to get a URL that won't require a proctor login if 1714 # we've submitted a proctored test for the last time. above we've 1715 # reset the assignment_type in this case, so we'll use that to 1716 # decide if we should give a path to an unproctored test. 1717 my $action = $r->uri(); 1718 $action =~ s/proctored_quiz_mode/quiz_mode/ 1719 if ( $set->assignment_type() eq 'gateway' ); 1720 # we also want to be sure that if we're in a set, the 'action' in the 1721 # form points us to the same set. 1722 my $setname = $set->set_id; 1723 my $setvnum = $set->version_id; 1724 $action =~ s/(quiz_mode\/$setname)\/?$/$1,v$setvnum\//; #" 1725 1726 # now, we print out the rest of the page if we're not hiding submitted 1727 # answers 1728 if ( ! $can{recordAnswersNextTime} && ! $canShowWork ) { 1729 my $when = ( $set->hide_work eq 'BeforeAnswerDate' ) 1730 ? ' until ' . formatDateTime($set->answer_date) 1731 : ''; 1732 print CGI::start_div({class=>"gwProblem"}); 1733 print CGI::strong("Completed results for this assignment are " . 1734 "not available$when."); 1735 print CGI::end_div(); 1736 1737 # else: we're not hiding answers 1738 } else { 1739 1740 print CGI::startform({-name=>"gwquiz", -method=>"POST", 1741 -action=>$action}), 1742 $self->hidden_authen_fields, 1743 $self->hidden_proctor_authen_fields; 1744 1745 # hacks to use a javascript link to trigger previews and jump to 1746 # subsequent pages of a multipage test 1747 print CGI::hidden({-name=>'previewHack', -value=>''}), 1748 CGI::br(); 1749 if ( $numProbPerPage && $numPages > 1 ) { 1750 print CGI::hidden({-name=>'newPage', -value=>''}); 1751 print CGI::hidden({-name=>'currentPage', 1752 -value=>$pageNumber}); 1753 } 1754 1755 # the link for a preview; for a multipage test, this also needs to 1756 # keep track of what page we're on 1757 my $jsprevlink = 'javascript:document.gwquiz.previewHack.value="1";'; 1758 $jsprevlink .= "document.gwquiz.newPage.value=\"$pageNumber\";" 1759 if ( $numProbPerPage && $numPages > 1 ); 1760 $jsprevlink .= 'document.gwquiz.submit();'; 1761 1762 # set up links between problems and, for multi-page tests, pages 1763 my $jumpLinks = ''; 1764 my $probRow = [ CGI::b("Problem") ]; 1765 for my $i ( 0 .. $#pg_results ) { 1766 1767 my $pn = $i + 1; 1768 if ( $i >= $startProb && $i <= $endProb ) { 1769 push(@$probRow, CGI::b(" [ ")) if ($i == $startProb); 1770 push( @$probRow, " " . 1771 CGI::a({-href=>".", 1772 -onclick=>"jumpTo($pn);return false;"}, 1773 "$pn") . " " ); 1774 push(@$probRow, CGI::b(" ] ")) if ($i == $endProb); 1775 } elsif ( ! ($i % $numProbPerPage) ) { 1776 push(@$probRow, " ", 1777 " ", " "); 1778 } 1779 } 1780 if ( $numProbPerPage && $numPages > 1 ) { 1781 my $pageRow = [ CGI::td([ CGI::b('Jump to: '), 1782 CGI::b('Page '), 1783 CGI::b(' [ ' ) ]) ]; 1784 for my $i ( 1 .. $numPages ) { 1785 my $pn = ( $i == $pageNumber ) ? $i : 1786 CGI::a({-href=>'javascript:' . 1787 "document.gwquiz.newPage.value=\"$i\";" . 1788 'document.gwquiz.submit();'}, 1789 " $i "); 1790 1791 my $colspan = 0; 1792 if ( $i == $pageNumber ) { 1793 $colspan = 1794 ($#pg_results - ($i-1)*$numProbPerPage > $numProbPerPage) ? 1795 $numProbPerPage : 1796 $#pg_results - ($i-1)*$numProbPerPage + 1; 1797 } else { 1798 $colspan = 1; 1799 } 1800 push( @$pageRow, CGI::td({-colspan=>$colspan, 1801 -align=>'center'}, 1802 $pn) ); 1803 push( @$pageRow, CGI::td( [CGI::b(' ] '), 1804 CGI::b(' [ ')] ) ) 1805 if ( $i != $numPages ); 1806 } 1807 push( @$pageRow, CGI::td(CGI::b(' ] ')) ); 1808 unshift( @$probRow, ' ' ); 1809 $jumpLinks = CGI::table( CGI::Tr(@$pageRow), 1810 CGI::Tr( CGI::td($probRow) ) ); 1811 } else { 1812 unshift( @$probRow, CGI::b('Jump to: ') ); 1813 $jumpLinks = CGI::table( CGI::Tr( CGI::td($probRow) ) ); 1814 } 1815 1816 print $jumpLinks,"\n"; 1817 1818 # print out problems and attempt results, as appropriate 1819 # note: args to attemptResults are (self,) $pg, $showAttemptAnswers, 1820 # $showCorrectAnswers, $showAttemptResults (and-ed with 1821 # $showAttemptAnswers), $showSummary, $showAttemptPreview (or-ed 1822 # with zero) 1823 my $problemNumber = 0; 1824 1825 foreach my $i ( 0 .. $#pg_results ) { 1826 my $pg = $pg_results[$probOrder[$i]]; 1827 $problemNumber++; 1828 1829 if ( $i >= $startProb && $i <= $endProb ) { 1830 1831 my $recordMessage = ''; 1832 my $resultsTable = ''; 1833 1834 if ($pg->{flags}->{showPartialCorrectAnswers}>=0 && $submitAnswers){ 1835 if ( $scoreRecordedMessage[$probOrder[$i]] ne 1836 "Your score on this problem was recorded." ) { 1837 $recordMessage = CGI::span({class=>"resultsWithError"}, 1838 "ANSWERS NOT RECORDED --", 1839 $scoreRecordedMessage[$probOrder[$i]]); 1840 1841 } 1842 $resultsTable = 1843 $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1844 $pg->{flags}->{showPartialCorrectAnswers} && $canShowProblemScores, 1845 $canShowProblemScores, 1); 1846 1847 } elsif ( $checkAnswers ) { 1848 $recordMessage = CGI::span({class=>"resultsWithError"}, 1849 "ANSWERS ONLY CHECKED -- ", 1850 "ANSWERS NOT RECORDED"); 1851 1852 $resultsTable = 1853 $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1854 $pg->{flags}->{showPartialCorrectAnswers} && $canShowProblemScores, 1855 $canShowProblemScores, 1); 1856 1857 } elsif ( $previewAnswers ) { 1858 $recordMessage = 1859 CGI::span({class=>"resultsWithError"}, 1860 "PREVIEW ONLY -- ANSWERS NOT RECORDED"); 1861 $resultsTable = $self->attemptResults($pg, 1, 0, 0, 0, 1); 1862 1863 } 1864 1865 print CGI::start_div({class=>"gwProblem"}); 1866 my $i1 = $i+1; 1867 my $points = ($problems[$probOrder[$i]]->value() > 1) ? 1868 " (" . $problems[$probOrder[$i]]->value() . " points)" : 1869 " (1 point)"; 1870 print CGI::a({-name=>"#$i1"},""); 1871 print CGI::strong("Problem $problemNumber."), 1872 "$points\n", $recordMessage; 1873 print CGI::p($pg->{body_text}), 1874 CGI::p($pg->{result}->{msg} ? 1875 CGI::b("Note: ") : "", 1876 CGI::i($pg->{result}->{msg})); 1877 print CGI::p({class=>"gwPreview"}, 1878 CGI::a({-href=>"$jsprevlink"}, 1879 "preview problems")); 1880 1881 print $resultsTable if $resultsTable; 1882 1883 print CGI::end_div(); 1884 # finally, store the problem status for 1885 # continued attempts recording 1886 my $pNum = $probOrder[$i] + 1; 1887 print CGI::hidden({-name=>"probstatus$pNum", 1888 -value=>$probStatus[$probOrder[$i]]}); 1889 1890 print "\n", CGI::hr(), "\n"; 1891 } else { 1892 my $i1 = $i+1; 1893 # keep the jump to anchors so that jumping to 1894 # problem number 6 still works, even if 1895 # we're viewing only problems 5-7, etc. 1896 print CGI::a({-name=>"#$i1"},""), "\n"; 1897 # and print out hidden fields with the current 1898 # last answers 1899 my $curr_prefix = 'Q' . sprintf("%04d", $probOrder[$i]+1) . '_'; 1900 my @curr_fields = grep /^$curr_prefix/, keys %{$self->{formFields}}; 1901 foreach my $curr_field ( @curr_fields ) { 1902 print CGI::hidden({-name=>$curr_field, 1903 -value=>$self->{formFields}->{$curr_field}}); 1904 } 1905 # finally, store the problem status for 1906 # continued attempts recording 1907 my $pNum = $probOrder[$i] + 1; 1908 print CGI::hidden({-name=>"probstatus$pNum", 1909 -value=>$probStatus[$probOrder[$i]]}); 1910 # my $probid = 'Q' . sprintf("%04d", $probOrder[$i]+1) . "_AnSwEr1"; 1911 # my $probval = $self->{formFields}->{$probid}; 1912 # print CGI::hidden({-name=>$probid, -value=>$probval}), "\n"; 1913 } 1914 } 1915 print CGI::p($jumpLinks, "\n"); 1916 print "\n",CGI::hr(), "\n"; 1917 1918 if ($can{showCorrectAnswers}) { 1919 print CGI::checkbox(-name =>"showCorrectAnswers", 1920 # -checked => $will{showCorrectAnswers}, 1921 -checked=>$want{showCorrectAnswers}, 1922 -label =>"Show correct answers", 1923 ); 1924 } 1925 # if ($can{showHints}) { 1926 # print CGI::div({style=>"color:red"}, 1927 # CGI::checkbox(-name => "showHints", 1928 # -checked => $will{showHints}, 1929 # -label => "Show Hints", 1930 # ) 1931 # ); 1932 # } 1933 if ($can{showSolutions}) { 1934 print CGI::checkbox(-name => "showSolutions", 1935 -checked => $will{showSolutions}, 1936 -label => "Show Solutions", 1937 ); 1938 } 1939 1940 if ($can{showCorrectAnswers} or $can{showHints} or 1941 $can{showSolutions}) { 1942 print CGI::br(); 1943 } 1944 1945 print CGI::p( CGI::submit( -name=>"previewAnswers", 1946 -label=>"Preview Test" ), 1947 ($can{recordAnswersNextTime} ? 1948 CGI::submit( -name=>"submitAnswers", 1949 -label=>"Grade Test" ) : " "), 1950 ($can{checkAnswersNextTime} && ! $can{recordAnswersNextTime} ? 1951 CGI::submit( -name=>"checkAnswers", 1952 -label=>"Check Test" ) : " "), 1953 ($numProbPerPage && $numPages > 1 && 1954 $can{recordAnswersNextTime} ? CGI::br() . 1955 CGI::em("Note: grading the test grades " . 1956 CGI::b("all") . " problems, not just those " . 1957 "on this page.") : " ") ); 1958 1959 print CGI::endform(); 1960 } 1961 1962 # finally, put in a show answers option if appropriate 1963 # print answer inspection button 1964 if ($authz->hasPermissions($user, "view_answers")) { 1965 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", courseID => $ce->{courseName}); 1966 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action 1967 print "\n", CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n", 1968 $self->hidden_authen_fields,"\n", 1969 CGI::hidden(-name => 'courseID', -value=>$ce->{courseName}), "\n", 1970 CGI::hidden(-name => 'problemID', -value=>($startProb+1)), "\n", 1971 CGI::hidden(-name => 'setID', -value=>$setVName), "\n", 1972 CGI::hidden(-name => 'studentUser', -value=>$effectiveUser), "\n", 1973 CGI::p( {-align=>"left"}, 1974 CGI::submit(-name => 'action', -value=>'Show Past Answers') 1975 ), "\n", 1976 CGI::endform(); 1977 } 1978 1979 # debugging verbiage 1980 # if ( $can{checkAnswersNextTime} ) { 1981 # print "Can check answers next time\n"; 1982 # } else { 1983 # print "Can NOT check answers next time\n"; 1984 # } 1985 # if ( $can{recordAnswersNextTime} ) { 1986 # print "Can record answers next time\n"; 1987 # } else { 1988 # print "Can NOT record answers next time\n"; 1989 # } 1990 1991 # we exclude the feedback form from gateway tests. they can use the feedback 1992 # button on the preceding or following pages 1993 # my $ce = $r->ce; 1994 # my $root = $ce->{webworkURLs}->{root}; 1995 # my $courseName = $ce->{courseName}; 1996 # my $feedbackURL = "$root/$courseName/feedback/"; 1997 # print CGI::startform("POST", $feedbackURL), 1998 # $self->hidden_authen_fields, 1999 # CGI::hidden("module", __PACKAGE__), 2000 # CGI::hidden("set", $self->{set}->set_id), 2001 # CGI::p({-align=>"right"}, 2002 # CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback") 2003 # ), 2004 # CGI::endform(); 2005 2006 return ""; 2007 2008 } 2009 2010 2011 ########################################################################### 2012 # Evaluation utilities 2013 ############################################################################ 2014 2015 sub getProblemHTML { 2016 my ( $self, $EffectiveUser, $setName, $setVersionNumber, $formFields, 2017 $mergedProblem, $pgFile ) = @_; 2018 # in: $EffectiveUser is the effective user we're working as, $setName 2019 # the set name, $setVersionNumber the version number, %$formFields 2020 # the form fields from the input form that we need to worry about 2021 # putting into the HTML we're generating, and $mergedProblem and 2022 # $pgFile are what we'd expect. 2023 # $pgFile is optional 2024 # out: the translated problem is returned 2025 2026 my $r = $self->r; 2027 my $ce = $r->ce; 2028 my $db = $r->db; 2029 my $key = $r->param('key'); 2030 2031 # this isn't good because it doesn't include the sticky answers that we 2032 # might want. so off with its head! 2033 ## my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 2034 2035 my $permissionLevel = $self->{permissionLevel}; 2036 my $set = $db->getMergedSetVersion( $EffectiveUser->user_id, 2037 $setName, $setVersionNumber ); 2038 2039 # should this ever happen? I think we should have die()ed way earlier than 2040 # this if the set doesn't exist, but it can't hurt to try and die() here 2041 # too 2042 die "set $setName,v$setVersionNumber for effectiveUser " . 2043 $EffectiveUser->user_id . " not found." unless $set; 2044 2045 my $psvn = $set->psvn(); 2046 2047 if ( defined($mergedProblem) && $mergedProblem->problem_id ) { 2048 # nothing needs to be done 2049 2050 } elsif ($pgFile) { 2051 $mergedProblem = 2052 WeBWorK::DB::Record::ProblemVersion->new( 2053 set_id => $set->set_id, 2054 version_id => $set->version_id, 2055 problem_id => 0, 2056 login_id => $EffectiveUser->user_id, 2057 source_file => $pgFile, 2058 # the rest of Problem's fields are not needed, i think 2059 ); 2060 } 2061 # figure out if we're allowed to get solutions and call PG->new accordingly. 2062 my $showCorrectAnswers = $self->{will}->{showCorrectAnswers}; 2063 my $showHints = $self->{will}->{showHints}; 2064 my $showSolutions = $self->{will}->{showSolutions}; 2065 my $processAnswers = $self->{will}->{checkAnswers}; 2066 2067 # FIXME I'm not sure that problem_id is what we want here FIXME 2068 my $problemNumber = $mergedProblem->problem_id; 2069 2070 my $pg = 2071 WeBWorK::PG->new( 2072 $ce, 2073 $EffectiveUser, 2074 $key, 2075 $set, 2076 $mergedProblem, 2077 $psvn, 2078 $formFields, 2079 { # translation options 2080 displayMode => $self->{displayMode}, 2081 showHints => $showHints, 2082 showSolutions => $showSolutions, 2083 refreshMath2img => $showHints || $showSolutions, 2084 processAnswers => 1, 2085 QUIZ_PREFIX => 'Q' . 2086 sprintf("%04d",$problemNumber) . '_', 2087 }, 2088 ); 2089 2090 # FIXME is problem_id the correct thing in the following two stanzas? 2091 # FIXME the original version had "problem number", which is what we want. 2092 # FIXME I think problem_id will work, too 2093 if ($pg->{warnings} ne "") { 2094 push @{$self->{warnings}}, { 2095 set => "$setName,v$setVersionNumber", 2096 problem => $mergedProblem->problem_id, 2097 message => $pg->{warnings}, 2098 }; 2099 } 2100 2101 if ($pg->{flags}->{error_flag}) { 2102 push @{$self->{errors}}, { 2103 set => "$setName,v$setVersionNumber", 2104 problem => $mergedProblem->problem_id, 2105 message => $pg->{errors}, 2106 context => $pg->{body_text}, 2107 }; 2108 # if there was an error, body_text contains 2109 # the error context, not TeX code 2110 $pg->{body_text} = undef; 2111 } 2112 2113 return $pg; 2114 } 2115 2116 ##### output utilities ##### 2117 sub problemListRow($$$) { 2118 my $self = shift; 2119 my $set = shift; 2120 my $Problem = shift; 2121 2122 my $name = $Problem->problem_id; 2123 my $interactiveURL = "$name/?" . $self->url_authen_args; 2124 my $interactive = CGI::a({-href=>$interactiveURL}, "Problem $name"); 2125 my $attempts = $Problem->num_correct + $Problem->num_incorrect; 2126 my $remaining = $Problem->max_attempts < 0 2127 ? "unlimited" 2128 : $Problem->max_attempts - $attempts; 2129 my $status = sprintf("%.0f%%", $Problem->status * 100); # round to whole number 2130 2131 return CGI::Tr(CGI::td({-nowrap=>1}, [ 2132 $interactive, 2133 $attempts, 2134 $remaining, 2135 $status, 2136 ])); 2137 } 2138 # sub nbsp { 2139 # my $str = shift; 2140 # ($str) ? $str : ' '; # returns non-breaking space for empty strings 2141 # } 2142 2143 ##### logging subroutine #### 2144 2145 2146 2147 2148 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |