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