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