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