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