Parent Directory
| 
Revision Log
merging with localization files in trunk
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.225 2010/05/28 21:29:48 gage 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::Problem; 18 use base qw(WeBWorK::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. 23 24 =cut 25 26 use strict; 27 use warnings; 28 #use CGI qw(-nosticky ); 29 use WeBWorK::CGI; 30 use File::Path qw(rmtree); 31 use WeBWorK::Debug; 32 use WeBWorK::Form; 33 use WeBWorK::PG; 34 use WeBWorK::PG::ImageGenerator; 35 use WeBWorK::PG::IO; 36 use WeBWorK::Utils qw(readFile writeLog writeCourseLog encodeAnswers decodeAnswers 37 ref2string makeTempDirectory path_is_subdir sortByName before after between); 38 use WeBWorK::DB::Utils qw(global2user user2global); 39 use URI::Escape; 40 use WeBWorK::Localize; 41 use WeBWorK::Utils::Tasks qw(fake_set fake_problem); 42 43 ################################################################################ 44 # CGI param interface to this module (up-to-date as of v1.153) 45 ################################################################################ 46 47 # Standard params: 48 # 49 # user - user ID of real user 50 # key - session key 51 # effectiveUser - user ID of effective user 52 # 53 # Integration with PGProblemEditor: 54 # 55 # editMode - if set, indicates alternate problem source location. 56 # can be "temporaryFile" or "savedFile". 57 # 58 # sourceFilePath - path to file to be edited 59 # problemSeed - force problem seed to value 60 # success - success message to display 61 # failure - failure message to display 62 # 63 # Rendering options: 64 # 65 # displayMode - name of display mode to use 66 # 67 # showOldAnswers - request that last entered answer be shown (if allowed) 68 # showCorrectAnswers - request that correct answers be shown (if allowed) 69 # showHints - request that hints be shown (if allowed) 70 # showSolutions - request that solutions be shown (if allowed) 71 # 72 # Problem interaction: 73 # 74 # AnSwEr# - answer blanks in problem 75 # 76 # redisplay - name of the "Redisplay Problem" button 77 # submitAnswers - name of "Submit Answers" button 78 # checkAnswers - name of the "Check Answers" button 79 # previewAnswers - name of the "Preview Answers" button 80 81 ################################################################################ 82 # "can" methods 83 ################################################################################ 84 85 # Subroutines to determine if a user "can" perform an action. Each subroutine is 86 # called with the following arguments: 87 # 88 # ($self, $User, $EffectiveUser, $Set, $Problem) 89 90 # Note that significant parts of the "can" methods are lifted into the 91 # GatewayQuiz module. It isn't direct, however, because of the necessity 92 # of dealing with versioning there. 93 94 sub can_showOldAnswers { 95 #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 96 97 return 1; 98 } 99 100 sub can_showCorrectAnswers { 101 my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 102 my $authz = $self->r->authz; 103 104 return 105 after($Set->answer_date) 106 || 107 $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date") 108 ; 109 } 110 111 sub can_showHints { 112 #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 113 114 return 1; 115 } 116 117 sub can_showSolutions { 118 my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 119 my $authz = $self->r->authz; 120 121 return 122 after($Set->answer_date) 123 || 124 $authz->hasPermissions($User->user_id, "show_solutions_before_answer_date") 125 ; 126 } 127 128 sub can_recordAnswers { 129 my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; 130 my $authz = $self->r->authz; 131 my $thisAttempt = $submitAnswers ? 1 : 0; 132 if ($User->user_id ne $EffectiveUser->user_id) { 133 return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student"); 134 } 135 if (before($Set->open_date)) { 136 return $authz->hasPermissions($User->user_id, "record_answers_before_open_date"); 137 } elsif (between($Set->open_date, $Set->due_date)) { 138 my $max_attempts = $Problem->max_attempts; 139 my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; 140 if ($max_attempts == -1 or $attempts_used < $max_attempts) { 141 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts"); 142 } else { 143 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts"); 144 } 145 } elsif (between($Set->due_date, $Set->answer_date)) { 146 return $authz->hasPermissions($User->user_id, "record_answers_after_due_date"); 147 } elsif (after($Set->answer_date)) { 148 return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date"); 149 } 150 } 151 152 sub can_checkAnswers { 153 my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; 154 my $authz = $self->r->authz; 155 my $thisAttempt = $submitAnswers ? 1 : 0; 156 157 if (before($Set->open_date)) { 158 return $authz->hasPermissions($User->user_id, "check_answers_before_open_date"); 159 } elsif (between($Set->open_date, $Set->due_date)) { 160 my $max_attempts = $Problem->max_attempts; 161 my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; 162 if ($max_attempts == -1 or $attempts_used < $max_attempts) { 163 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts"); 164 } else { 165 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts"); 166 } 167 } elsif (between($Set->due_date, $Set->answer_date)) { 168 return $authz->hasPermissions($User->user_id, "check_answers_after_due_date"); 169 } elsif (after($Set->answer_date)) { 170 return $authz->hasPermissions($User->user_id, "check_answers_after_answer_date"); 171 } 172 } 173 174 # Reset the default in some cases 175 sub set_showOldAnswers_default { 176 my ($self, $ce, $userName, $authz, $set) = @_; 177 # these people always use the system/course default, so don't 178 # override the value of ...->{showOldAnswers} 179 return if $authz->hasPermissions($userName, "can_always_use_show_old_answers_default"); 180 # this person should always default to 0 181 $ce->{pg}->{options}->{showOldAnswers} = 0 182 unless ($authz->hasPermissions($userName, "can_show_old_answers_by_default")); 183 # we are after the due date, so default to not showing it 184 $ce->{pg}->{options}->{showOldAnswers} = 0 if $set->{due_date} && after($set->{due_date}); 185 } 186 187 ################################################################################ 188 # output utilities 189 ################################################################################ 190 191 # Note: the substance of attemptResults is lifted into GatewayQuiz.pm, 192 # with some changes to the output format 193 194 sub attemptResults { 195 my $self = shift; 196 my $r = $self->r; 197 my $pg = shift; 198 my $showAttemptAnswers = shift; 199 my $showCorrectAnswers = shift; 200 my $showAttemptResults = $showAttemptAnswers && shift; 201 my $showSummary = shift; 202 my $showAttemptPreview = shift || 0; 203 204 my $ce = $self->r->ce; 205 206 # for color coding the responses. 207 my @correct_ids = (); 208 my @incorrect_ids = (); 209 210 211 my $problemResult = $pg->{result}; # the overall result of the problem 212 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 213 214 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 215 216 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 217 218 # to make grabbing these options easier, we'll pull them out now... 219 my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}}; 220 221 my $imgGen = WeBWorK::PG::ImageGenerator->new( 222 tempDir => $ce->{webworkDirs}->{tmp}, 223 latex => $ce->{externalPrograms}->{latex}, 224 dvipng => $ce->{externalPrograms}->{dvipng}, 225 useCache => 1, 226 cacheDir => $ce->{webworkDirs}->{equationCache}, 227 cacheURL => $ce->{webworkURLs}->{equationCache}, 228 cacheDB => $ce->{webworkFiles}->{equationCacheDB}, 229 dvipng_align => $imagesModeOptions{dvipng_align}, 230 dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, 231 ); 232 233 my $showEvaluatedAnswers = $ce->{pg}->{options}->{showEvaluatedAnswers}; 234 235 my $header; 236 #$header .= CGI::th("Part"); 237 if ($showEvaluatedAnswers) { 238 $header .= $showAttemptAnswers ? CGI::th($r->maketext("Entered")) : ""; 239 } 240 $header .= $showAttemptPreview ? CGI::th($r->maketext("Answer Preview")) : ""; 241 $header .= $showCorrectAnswers ? CGI::th($r->maketext("Correct")) : ""; 242 $header .= $showAttemptResults ? CGI::th($r->maketext("Result")) : ""; 243 $header .= $showMessages ? CGI::th($r->maketext("Messages")) : ""; 244 my $fully = ''; 245 my @tableRows = ( $header ); 246 my $numCorrect = 0; 247 my $numBlanks =0; 248 my $tthPreambleCache; 249 foreach my $name (@answerNames) { 250 my $answerResult = $pg->{answers}->{$name}; 251 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 252 my $preview = ($showAttemptPreview 253 ? $self->previewAnswer($answerResult, $imgGen, \$tthPreambleCache) 254 : ""); 255 my $correctAnswerPreview = $self->previewCorrectAnswer($answerResult, $imgGen, \$tthPreambleCache); 256 my $correctAnswer = $answerResult->{correct_ans}; 257 my $answerScore = $answerResult->{score}; 258 my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; 259 $answerMessage =~ s/\n/<BR>/g; 260 $numCorrect += $answerScore >= 1; 261 $numBlanks++ unless $studentAnswer =~/\S/ || $answerScore >= 1; # unless student answer contains entry 262 my $resultString = $answerScore >= 1 ? CGI::span({class=>"ResultsWithoutError"}, $r->maketext("correct")) : 263 $answerScore > 0 ? $r->maketext("[_1]% correct", int($answerScore*100)): 264 CGI::span({class=>"ResultsWithError"}, $r->maketext("incorrect")); 265 $fully = $r->maketext("completely ") if $answerScore >0 and $answerScore < 1; 266 267 268 #warn "answer $name score $answerScore"; 269 push @correct_ids, $name if $answerScore == 1; 270 push @incorrect_ids, $name if $answerScore < 1; 271 272 # need to capture auxiliary answers as well and identify their ids. 273 274 275 my $row; 276 #$row .= CGI::td($name); 277 if ($showEvaluatedAnswers) { 278 $row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : ""; 279 } 280 $row .= $showAttemptPreview ? CGI::td({onmouseover=>qq!Tip('$studentAnswer',SHADOW, true, 281 DELAY, 1000, FADEIN, 300, FADEOUT, 300, STICKY, 1, OFFSETX, -20, CLOSEBTN, true, CLICKCLOSE, false, 282 BGCOLOR, '#F4FF91', TITLE, 'Entered:',TITLEBGCOLOR, '#F4FF91', TITLEFONTCOLOR, '#000000')!}, 283 $self->nbsp($preview)) : ""; 284 $row .= $showCorrectAnswers ? CGI::td({onmouseover=> qq!Tip('$correctAnswer',SHADOW, true, 285 DELAY, 1000, FADEIN, 300, FADEOUT, 300, STICKY, 1, OFFSETX, -20, CLOSEBTN, true, CLICKCLOSE, false, 286 BGCOLOR, '#F4FF91', TITLE, 'Entered:',TITLEBGCOLOR, '#F4FF91', TITLEFONTCOLOR, '#000000')!}, 287 $self->nbsp($correctAnswerPreview)) : ""; 288 $row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : ""; 289 $row .= $showMessages ? CGI::td({-class=>"Message"},$self->nbsp($answerMessage)) : ""; 290 push @tableRows, $row; 291 } 292 293 # render equation images 294 $imgGen->render(refresh => 1); 295 296 # my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; 297 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); 298 # FIXME -- I left the old code in in case we have to back out. 299 # my $summary = "On this attempt, you answered $numCorrect out of " 300 # . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; 301 my $summary = ""; 302 unless (defined($problemResult->{summary}) and $problemResult->{summary} =~ /\S/) { 303 if (scalar @answerNames == 1) { #default messages 304 if ($numCorrect == scalar @answerNames) { 305 $summary .= CGI::div({class=>"ResultsWithoutError"},$r->maketext("The answer above is correct.")); 306 } else { 307 $summary .= CGI::div({class=>"ResultsWithError"},$r->maketext("The answer above is NOT [_1]correct.", $fully)); 308 } 309 } else { 310 if ($numCorrect == scalar @answerNames) { 311 $summary .= CGI::div({class=>"ResultsWithoutError"},$r->maketext("All of the answers above are correct.")); 312 } 313 #unless ($numCorrect + $numBlanks == scalar( @answerNames)) { # this allowed you to figure out if you got one answer right. 314 elsif ($numBlanks != scalar( @answerNames)) { 315 $summary .= CGI::div({class=>"ResultsWithError"},$r->maketext("At least one of the answers above is NOT [_1]correct.", $fully)); 316 } 317 if ($numBlanks) { 318 my $s = ($numBlanks>1)?'':'s'; 319 $summary .= CGI::div({class=>"ResultsAlert"},$r->maketext("[quant,_1,of the questions remains,of the questions remain] unanswered.", $numBlanks)); 320 } 321 } 322 } else { 323 $summary = $problemResult->{summary}; # summary has been defined by grader 324 } 325 326 $self->{correct_ids}=[@correct_ids] if @correct_ids; 327 $self->{incorrect_ids} = [@incorrect_ids] if @incorrect_ids; 328 329 return 330 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) 331 . ($showSummary ? CGI::p({class=>'attemptResultsSummary'},$summary) : ""); 332 } 333 334 335 # Note: previewAnswer is lifted into GatewayQuiz.pm 336 337 sub previewAnswer { 338 my ($self, $answerResult, $imgGen, $tthPreambleCache) = @_; 339 my $ce = $self->r->ce; 340 my $effectiveUser = $self->{effectiveUser}; 341 my $set = $self->{set}; 342 my $problem = $self->{problem}; 343 my $displayMode = $self->{displayMode}; 344 345 # note: right now, we have to do things completely differently when we are 346 # rendering math from INSIDE the translator and from OUTSIDE the translator. 347 # so we'll just deal with each case explicitly here. there's some code 348 # duplication that can be dealt with later by abstracting out tth/dvipng/etc. 349 350 my $tex = $answerResult->{preview_latex_string}; 351 352 return "" unless defined $tex and $tex ne ""; 353 354 if ($displayMode eq "plainText") { 355 return $tex; 356 } elsif ($displayMode eq "formattedText") { 357 358 # read the TTH preamble, or use the cached copy passed in from the caller 359 my $tthPreamble=''; 360 if (defined $$tthPreambleCache) { 361 $tthPreamble = $$tthPreambleCache; 362 } else { 363 my $tthPreambleFile = $ce->{courseDirs}->{templates} . "/tthPreamble.tex"; 364 if (-r $tthPreambleFile) { 365 $tthPreamble = readFile($tthPreambleFile); 366 # thanks to Jim Martino. each line in the definition file should end with 367 #a % to prevent adding supurious paragraphs to output: 368 $tthPreamble =~ s/(.)\n/$1%\n/g; 369 # solves the problem if the file doesn't end with a return: 370 $tthPreamble .="%\n"; 371 # store preamble in cache: 372 $$tthPreambleCache = $tthPreamble; 373 } else { 374 } 375 } 376 377 # construct TTH command line 378 my $tthCommand = $ce->{externalPrograms}->{tth} 379 . " -L -f5 -u -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" 380 . $tthPreamble . "\\[" . $tex . "\\]\n" 381 . "END_OF_INPUT\n"; 382 383 # call tth 384 my $result = `$tthCommand`; 385 if ($?) { 386 return "<b>[tth failed: $? $@]</b>"; 387 } else { 388 # avoid border problems in tables and remove unneeded initial <br> 389 $result =~ s/(<table [^>]*)>/$1 CLASS="ArrayLayout">/gi; 390 $result =~ s!\s*<br clear="all" />!!; 391 return $result; 392 } 393 394 } elsif ($displayMode eq "images") { 395 $imgGen->add($tex); 396 } elsif ($displayMode eq "MathJax") { 397 return '<span class="MathJax_Preview">[math]</span><script type="math/tex; mode=display">'.$tex.'</script>'; 398 } elsif ($displayMode eq "jsMath") { 399 $tex =~ s/&/&/g; $tex =~ s/</</g; $tex =~ s/>/>/g; 400 return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>'; 401 } 402 } 403 sub previewCorrectAnswer { 404 my ($self, $answerResult, $imgGen, $tthPreambleCache) = @_; 405 my $ce = $self->r->ce; 406 my $effectiveUser = $self->{effectiveUser}; 407 my $set = $self->{set}; 408 my $problem = $self->{problem}; 409 my $displayMode = $self->{displayMode}; 410 411 # note: right now, we have to do things completely differently when we are 412 # rendering math from INSIDE the translator and from OUTSIDE the translator. 413 # so we'll just deal with each case explicitly here. there's some code 414 # duplication that can be dealt with later by abstracting out tth/dvipng/etc. 415 416 my $tex = $answerResult->{correct_ans_latex_string}; 417 return $answerResult->{correct_ans} unless defined $tex and $tex=~/\S/; # some answers don't have latex strings defined 418 # return "" unless defined $tex and $tex ne ""; 419 420 if ($displayMode eq "plainText") { 421 return $tex; 422 } elsif ($displayMode eq "formattedText") { 423 424 # read the TTH preamble, or use the cached copy passed in from the caller 425 my $tthPreamble=''; 426 if (defined $$tthPreambleCache) { 427 $tthPreamble = $$tthPreambleCache; 428 } else { 429 my $tthPreambleFile = $ce->{courseDirs}->{templates} . "/tthPreamble.tex"; 430 if (-r $tthPreambleFile) { 431 $tthPreamble = readFile($tthPreambleFile); 432 # thanks to Jim Martino. each line in the definition file should end with 433 #a % to prevent adding supurious paragraphs to output: 434 $tthPreamble =~ s/(.)\n/$1%\n/g; 435 # solves the problem if the file doesn't end with a return: 436 $tthPreamble .="%\n"; 437 # store preamble in cache: 438 $$tthPreambleCache = $tthPreamble; 439 } else { 440 } 441 } 442 443 # construct TTH command line 444 my $tthCommand = $ce->{externalPrograms}->{tth} 445 . " -L -f5 -u -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" 446 . $tthPreamble . "\\[" . $tex . "\\]\n" 447 . "END_OF_INPUT\n"; 448 449 # call tth 450 my $result = `$tthCommand`; 451 if ($?) { 452 return "<b>[tth failed: $? $@]</b>"; 453 } else { 454 # avoid border problems in tables and remove unneeded initial <br> 455 $result =~ s/(<table [^>]*)>/$1 CLASS="ArrayLayout">/gi; 456 $result =~ s!\s*<br clear="all" />!!; 457 return $result; 458 } 459 460 } elsif ($displayMode eq "images") { 461 $imgGen->add($tex); 462 } elsif ($displayMode eq "MathJax") { 463 return '<span class="MathJax_Preview">[math]</span><script type="math/tex; mode=display">'.$tex.'</script>'; 464 } elsif ($displayMode eq "jsMath") { 465 $tex =~ s/&/&/g; $tex =~ s/</</g; $tex =~ s/>/>/g; 466 return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>'; 467 } 468 } 469 470 ################################################################################ 471 # Template escape implementations 472 ################################################################################ 473 474 sub pre_header_initialize { 475 my ($self) = @_; 476 my $r = $self->r; 477 my $ce = $r->ce; 478 my $db = $r->db; 479 my $authz = $r->authz; 480 my $urlpath = $r->urlpath; 481 482 my $setName = $urlpath->arg("setID"); 483 my $problemNumber = $r->urlpath->arg("problemID"); 484 my $userName = $r->param('user'); 485 my $effectiveUserName = $r->param('effectiveUser'); 486 my $key = $r->param('key'); 487 my $editMode = $r->param("editMode"); 488 489 my $user = $db->getUser($userName); # checked 490 die "record for user $userName (real user) does not exist." 491 unless defined $user; 492 493 my $effectiveUser = $db->getUser($effectiveUserName); # checked 494 die "record for user $effectiveUserName (effective user) does not exist." 495 unless defined $effectiveUser; 496 497 # obtain the merged set for $effectiveUser 498 my $set = $db->getMergedSet($effectiveUserName, $setName); # checked 499 500 $self->set_showOldAnswers_default($ce, $userName, $authz, $set); 501 502 # Database fix (in case of undefined visiblity state values) 503 # this is only necessary because some people keep holding to ww1.9 which did not have a visible field 504 # make sure visible is set to 0 or 1 505 if ( $set and $set->visible ne "0" and $set->visible ne "1") { 506 my $globalSet = $db->getGlobalSet($set->set_id); 507 $globalSet->visible("1"); # defaults to visible 508 $db->putGlobalSet($globalSet); 509 $set = $db->getMergedSet($effectiveUserName, $setName); 510 } else { 511 # don't do anything just yet, maybe we're a professor and we're 512 # fabricating a set or haven't assigned it to ourselves just yet 513 } 514 # When a set is created enable_reduced_scoring is null, so we have to set it 515 if ( $set and $set->enable_reduced_scoring ne "0" and $set->enable_reduced_scoring ne "1") { 516 my $globalSet = $db->getGlobalSet($set->set_id); 517 $globalSet->enable_reduced_scoring("0"); # defaults to disabled 518 $db->putGlobalSet($globalSet); 519 $set = $db->getMergedSet($effectiveUserName, $setName); 520 } 521 522 523 # obtain the merged problem for $effectiveUser 524 my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked 525 526 if ($authz->hasPermissions($userName, "modify_problem_sets")) { 527 # professors are allowed to fabricate sets and problems not 528 # assigned to them (or anyone). this allows them to use the 529 # editor to 530 531 # if a User Set does not exist for this user and this set 532 # then we check the Global Set 533 # if that does not exist we create a fake set 534 # if it does, we add fake user data 535 unless (defined $set) { 536 my $userSetClass = $db->{set_user}->{record}; 537 my $globalSet = $db->getGlobalSet($setName); # checked 538 539 if (not defined $globalSet) { 540 $set = fake_set($db); 541 } else { 542 $set = global2user($userSetClass, $globalSet); 543 $set->psvn(0); 544 } 545 } 546 547 # if that is not yet defined obtain the global problem, 548 # convert it to a user problem, and add fake user data 549 unless (defined $problem) { 550 my $userProblemClass = $db->{problem_user}->{record}; 551 my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked 552 # if the global problem doesn't exist either, bail! 553 if(not defined $globalProblem) { 554 my $sourceFilePath = $r->param("sourceFilePath"); 555 die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir 556 # These are problems from setmaker. If declared invalid, they won't come up 557 $self->{invalidProblem} = $self->{invalidSet} = 1 unless defined $sourceFilePath; 558 # die "Problem $problemNumber in set $setName does not exist" unless defined $sourceFilePath; 559 $problem = fake_problem($db); 560 $problem->problem_id(1); 561 $problem->source_file($sourceFilePath); 562 $problem->user_id($effectiveUserName); 563 } else { 564 $problem = global2user($userProblemClass, $globalProblem); 565 $problem->user_id($effectiveUserName); 566 $problem->problem_seed(0); 567 $problem->status(0); 568 $problem->attempted(0); 569 $problem->last_answer(""); 570 $problem->num_correct(0); 571 $problem->num_incorrect(0); 572 } 573 } 574 575 # now we're sure we have valid UserSet and UserProblem objects 576 # yay! 577 578 # now deal with possible editor overrides: 579 580 # if the caller is asking to override the source file, and 581 # editMode calls for a temporary file, do so 582 my $sourceFilePath = $r->param("sourceFilePath"); 583 if (defined $editMode and $editMode eq "temporaryFile" and defined $sourceFilePath) { 584 die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir 585 $problem->source_file($sourceFilePath); 586 } 587 588 # if the problem does not have a source file or no source file has been passed in 589 # then this is really an invalid problem (probably from a bad URL) 590 $self->{invalidProblem} = not (defined $sourceFilePath or $problem->source_file); 591 592 # if the caller is asking to override the problem seed, do so 593 my $problemSeed = $r->param("problemSeed"); 594 if (defined $problemSeed) { 595 $problem->problem_seed($problemSeed); 596 } 597 598 my $visiblityStateClass = ($set->visible) ? "visible" : "hidden"; 599 my $visiblityStateText = ($set->visible) ? "visible to students." : "hidden from students."; 600 $self->addmessage(CGI::span("This set is " . CGI::font({class=>$visiblityStateClass}, $visiblityStateText))); 601 602 # test for additional problem validity if it's not already invalid 603 } else { 604 $self->{invalidProblem} = !(defined $problem and ($set->visible || $authz->hasPermissions($userName, "view_hidden_sets"))); 605 606 $self->addbadmessage(CGI::p($r->maketext("This problem will not count towards your grade."))) if $problem and not $problem->value and not $self->{invalidProblem}; 607 } 608 609 $self->{userName} = $userName; 610 $self->{effectiveUserName} = $effectiveUserName; 611 $self->{user} = $user; 612 $self->{effectiveUser} = $effectiveUser; 613 $self->{set} = $set; 614 $self->{problem} = $problem; 615 $self->{editMode} = $editMode; 616 617 ##### form processing ##### 618 619 # set options from form fields (see comment at top of file for names) 620 my $displayMode = $r->param("displayMode") || $ce->{pg}->{options}->{displayMode}; 621 my $redisplay = $r->param("redisplay"); 622 my $submitAnswers = $r->param("submitAnswers"); 623 my $checkAnswers = $r->param("checkAnswers"); 624 my $previewAnswers = $r->param("previewAnswers"); 625 626 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 627 628 $self->{displayMode} = $displayMode; 629 $self->{redisplay} = $redisplay; 630 $self->{submitAnswers} = $submitAnswers; 631 $self->{checkAnswers} = $checkAnswers; 632 $self->{previewAnswers} = $previewAnswers; 633 $self->{formFields} = $formFields; 634 635 # get result and send to message 636 my $status_message = $r->param("status_message"); 637 $self->addmessage(CGI::p("$status_message")) if $status_message; 638 639 # now that we've set all the necessary variables quit out if the set or problem is invalid 640 return if $self->{invalidSet} || $self->{invalidProblem}; 641 642 ##### permissions ##### 643 644 # what does the user want to do? 645 #FIXME There is a problem with checkboxes -- if they are not checked they are invisible. Hence if the default mode in $ce is 1 646 # there is no way to override this. Probably this is ok for the last three options, but it was definitely not ok for showing 647 # saved answers which is normally on, but you want to be able to turn it off! This section should be moved to ContentGenerator 648 # so that you can set these options anywhere. We also need mechanisms for making them sticky. 649 # Note: ProblemSet and ProblemSets might set showOldAnswers to '', which 650 # needs to be treated as if it is not set. 651 my %want = ( 652 showOldAnswers => (defined($r->param("showOldAnswers")) and $r->param("showOldAnswers") ne '') ? $r->param("showOldAnswers") : $ce->{pg}->{options}->{showOldAnswers}, 653 showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers}, 654 showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints}, 655 showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions}, 656 recordAnswers => $submitAnswers, 657 checkAnswers => $checkAnswers, 658 getSubmitButton => 1, 659 ); 660 661 # are certain options enforced? 662 my %must = ( 663 showOldAnswers => 0, 664 showCorrectAnswers => 0, 665 showHints => 0, 666 showSolutions => 0, 667 recordAnswers => ! $authz->hasPermissions($userName, "avoid_recording_answers"), 668 checkAnswers => 0, 669 getSubmitButton => 0, 670 ); 671 672 # does the user have permission to use certain options? 673 my @args = ($user, $effectiveUser, $set, $problem); 674 my %can = ( 675 showOldAnswers => $self->can_showOldAnswers(@args), 676 showCorrectAnswers => $self->can_showCorrectAnswers(@args), 677 showHints => $self->can_showHints(@args), 678 showSolutions => $self->can_showSolutions(@args), 679 recordAnswers => $self->can_recordAnswers(@args, 0), 680 checkAnswers => $self->can_checkAnswers(@args, $submitAnswers), 681 getSubmitButton => $self->can_recordAnswers(@args, $submitAnswers), 682 ); 683 684 # final values for options 685 my %will; 686 foreach (keys %must) { 687 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 688 #warn "final values for options $_ is can $can{$_}, want $want{$_}, must $must{$_}, will $will{$_}"; 689 } 690 691 ##### sticky answers ##### 692 693 if (not ($submitAnswers or $previewAnswers or $checkAnswers) and $will{showOldAnswers}) { 694 # do this only if new answers are NOT being submitted 695 my %oldAnswers = decodeAnswers($problem->last_answer); 696 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; 697 } 698 699 ##### translation ##### 700 701 debug("begin pg processing"); 702 my $pg = WeBWorK::PG->new( 703 $ce, 704 $effectiveUser, 705 $key, 706 $set, 707 $problem, 708 $set->psvn, # FIXME: this field should be removed 709 $formFields, 710 { # translation options 711 displayMode => $displayMode, 712 showHints => $will{showHints}, 713 showSolutions => $will{showSolutions}, 714 refreshMath2img => $will{showHints} || $will{showSolutions}, 715 processAnswers => 1, 716 permissionLevel => $db->getPermissionLevel($userName)->permission, 717 effectivePermissionLevel => $db->getPermissionLevel($effectiveUserName)->permission, 718 }, 719 ); 720 721 debug("end pg processing"); 722 723 ##### fix hint/solution options ##### 724 725 $can{showHints} &&= $pg->{flags}->{hintExists} 726 &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; 727 $can{showSolutions} &&= $pg->{flags}->{solutionExists}; 728 729 ##### store fields ##### 730 731 $self->{want} = \%want; 732 $self->{must} = \%must; 733 $self->{can} = \%can; 734 $self->{will} = \%will; 735 $self->{pg} = $pg; 736 } 737 738 sub if_errors($$) { 739 my ($self, $arg) = @_; 740 741 if ($self->{isOpen}) { 742 return $self->{pg}->{flags}->{error_flag} ? $arg : !$arg; 743 } else { 744 return !$arg; 745 } 746 } 747 748 sub head { 749 my ($self) = @_; 750 751 return "" if ( $self->{invalidSet} ); 752 return $self->{pg}->{head_text} if $self->{pg}->{head_text}; 753 } 754 755 sub options { 756 my ($self) = @_; 757 #warn "doing options in Problem"; 758 759 # don't show options if we don't have anything to show 760 return "" if $self->{invalidSet} or $self->{invalidProblem}; 761 762 my $displayMode = $self->{displayMode}; 763 my %can = %{ $self->{can} }; 764 765 my @options_to_show = "displayMode"; 766 push @options_to_show, "showOldAnswers" if $can{showOldAnswers}; 767 push @options_to_show, "showHints" if $can{showHints}; 768 push @options_to_show, "showSolutions" if $can{showSolutions}; 769 770 return $self->optionsMacro( 771 options_to_show => \@options_to_show, 772 extra_params => ["editMode", "sourceFilePath"], 773 ); 774 } 775 776 sub siblings { 777 my ($self) = @_; 778 my $r = $self->r; 779 my $db = $r->db; 780 my $urlpath = $r->urlpath; 781 782 # can't show sibling problems if the set is invalid 783 return "" if $self->{invalidSet}; 784 785 my $courseID = $urlpath->arg("courseID"); 786 my $setID = $self->{set}->set_id; 787 my $eUserID = $r->param("effectiveUser"); 788 my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID); 789 790 print CGI::start_div({class=>"info-box", id=>"fisheye"}); 791 print CGI::h2($r->maketext("Problems")); 792 #print CGI::start_ul({class=>"LinksMenu"}); 793 #print CGI::start_li(); 794 #print CGI::span({style=>"font-size:larger"}, "Problems"); 795 print CGI::start_ul(); 796 797 foreach my $problemID (@problemIDs) { 798 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", $r, 799 courseID => $courseID, setID => $setID, problemID => $problemID); 800 print CGI::li(CGI::a( {href=>$self->systemLink($problemPage, 801 params=>{ displayMode => $self->{displayMode}, 802 showOldAnswers => $self->{will}->{showOldAnswers} 803 })}, $r->maketext("Problem [_1]",$problemID)) 804 ); 805 } 806 807 print CGI::end_ul(); 808 #print CGI::end_li(); 809 #print CGI::end_ul(); 810 print CGI::end_div(); 811 812 return ""; 813 } 814 815 sub nav { 816 my ($self, $args) = @_; 817 my $r = $self->r; 818 my $db = $r->db; 819 my $urlpath = $r->urlpath; 820 821 return "" if ( $self->{invalidSet} ); 822 823 my $courseID = $urlpath->arg("courseID"); 824 my $setID = $self->{set}->set_id if !($self->{invalidSet}); 825 my $problemID = $self->{problem}->problem_id if !($self->{invalidProblem}); 826 my $eUserID = $r->param("effectiveUser"); 827 828 my ($prevID, $nextID); 829 830 if (!$self->{invalidProblem}) { 831 my @problemIDs = $db->listUserProblems($eUserID, $setID); 832 foreach my $id (@problemIDs) { 833 $prevID = $id if $id < $problemID 834 and (not defined $prevID or $id > $prevID); 835 $nextID = $id if $id > $problemID 836 and (not defined $nextID or $id < $nextID); 837 } 838 } 839 840 my @links; 841 842 if ($prevID) { 843 my $prevPage = $urlpath->newFromModule(__PACKAGE__, $r, 844 courseID => $courseID, setID => $setID, problemID => $prevID); 845 push @links, $r->maketext("Previous Problem"), $r->location . $prevPage->path, $r->maketext("navPrev"); 846 } else { 847 push @links, $r->maketext("Previous Problem"), "", $r->maketext("navPrevGrey"); 848 } 849 850 if (defined($setID) && $setID ne 'Undefined_Set') { 851 push @links, $r->maketext("Problem List"), $r->location . $urlpath->parent->path, $r->maketext("navProbList"); 852 } else { 853 push @links, $r->maketext("Problem List"), "", $r->maketext("navProbListGrey"); 854 } 855 856 if ($nextID) { 857 my $nextPage = $urlpath->newFromModule(__PACKAGE__, $r, 858 courseID => $courseID, setID => $setID, problemID => $nextID); 859 push @links, $r->maketext("Next Problem"), $r->location . $nextPage->path, $r->maketext("navNext"); 860 } else { 861 push @links, $r->maketext("Next Problem"), "", $r->maketext("navNextGrey"); 862 } 863 864 my $tail = ""; 865 866 $tail .= "&displayMode=".$self->{displayMode} if defined $self->{displayMode}; 867 $tail .= "&showOldAnswers=".$self->{will}->{showOldAnswers} 868 if defined $self->{will}->{showOldAnswers}; 869 return $self->navMacro($args, $tail, @links); 870 } 871 872 sub title { 873 my ($self) = @_; 874 my $r = $self->r; 875 # using the url arguments won't break if the set/problem are invalid 876 my $setID = WeBWorK::ContentGenerator::underscore2nbsp($self->r->urlpath->arg("setID")); 877 my $problemID = $self->r->urlpath->arg("problemID"); 878 879 return $r->maketext("[_1]: Problem [_2]",$setID, $problemID); 880 } 881 882 sub body { 883 my $self = shift; 884 my $r = $self->r; 885 my $ce = $r->ce; 886 my $db = $r->db; 887 my $authz = $r->authz; 888 my $urlpath = $r->urlpath; 889 my $user = $r->param('user'); 890 my $effectiveUser = $r->param('effectiveUser'); 891 892 if ( $self->{invalidSet} ) { 893 return CGI::div({class=>"ResultsWithError"}, 894 CGI::p($r->maketext("The selected problem set ([_1]) is not a valid set for [_2]:", $urlpath->arg("setID"), $effectiveUser)), CGI::p($self->{invalidSet})); 895 } 896 897 if ($self->{invalidProblem}) { 898 return CGI::div({class=>"ResultsWithError"}, 899 CGI::p($r->maketext("The selected problem([_1]) is not a valid problem for set [_2].", $urlpath->arg("problemID"), $self->{set}->set_id ))); 900 } 901 902 # unpack some useful variables 903 my $set = $self->{set}; 904 my $problem = $self->{problem}; 905 my $editMode = $self->{editMode}; 906 my $submitAnswers = $self->{submitAnswers}; 907 my $checkAnswers = $self->{checkAnswers}; 908 my $previewAnswers = $self->{previewAnswers}; 909 my %want = %{ $self->{want} }; 910 my %can = %{ $self->{can} }; 911 my %must = %{ $self->{must} }; 912 my %will = %{ $self->{will} }; 913 my $pg = $self->{pg}; 914 915 my $courseName = $urlpath->arg("courseID"); 916 917 # FIXME: move editor link to top, next to problem number. 918 # format as "[edit]" like we're doing with course info file, etc. 919 # add edit link for set as well. 920 my $editorLink = ""; 921 # if we are here without a real homework set, carry that through 922 my $forced_field = []; 923 $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if 924 ($set->set_id eq 'Undefined_Set'); 925 if ($authz->hasPermissions($user, "modify_problem_sets")) { 926 my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, 927 courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id); 928 my $editorURL = $self->systemLink($editorPage, params=>$forced_field); 929 $editorLink = CGI::p(CGI::a({href=>$editorURL,target =>'WW_Editor'}, "Edit this problem")); 930 } 931 932 ##### translation errors? ##### 933 934 if ($pg->{flags}->{error_flag}) { 935 if ($authz->hasPermissions($user, "view_problem_debugging_info")) { 936 print $self->errorOutput($pg->{errors}, $pg->{body_text}); 937 } else { 938 print $self->errorOutput($pg->{errors}, $r->maketext("You do not have permission to view the details of this error.")); 939 } 940 print $editorLink; 941 return ""; 942 } 943 944 ##### answer processing ##### 945 debug("begin answer processing"); 946 # if answers were submitted: 947 my $scoreRecordedMessage; 948 my $pureProblem; 949 if ($submitAnswers) { 950 # get a "pure" (unmerged) UserProblem to modify 951 # this will be undefined if the problem has not been assigned to this user 952 $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); # checked 953 if (defined $pureProblem) { 954 # store answers in DB for sticky answers 955 my %answersToStore; 956 my %answerHash = %{ $pg->{answers} }; 957 $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!! 958 foreach (keys %answerHash); 959 960 # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating 961 # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs 962 # however we need to store them. Fortunately they are still in the input form. 963 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}}; 964 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names); 965 966 # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order 967 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names); 968 my $answerString = encodeAnswers(%answersToStore, 969 @answer_order); 970 971 # store last answer to database 972 $problem->last_answer($answerString); 973 $pureProblem->last_answer($answerString); 974 $db->putUserProblem($pureProblem); 975 976 # store state in DB if it makes sense 977 if ($will{recordAnswers}) { 978 $problem->status($pg->{state}->{recorded_score}); 979 $problem->sub_status($pg->{state}->{sub_recorded_score}); 980 $problem->attempted(1); 981 $problem->num_correct($pg->{state}->{num_of_correct_ans}); 982 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 983 $pureProblem->status($pg->{state}->{recorded_score}); 984 $pureProblem->sub_status($pg->{state}->{sub_recorded_score}); 985 $pureProblem->attempted(1); 986 $pureProblem->num_correct($pg->{state}->{num_of_correct_ans}); 987 $pureProblem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 988 if ($db->putUserProblem($pureProblem)) { 989 $scoreRecordedMessage = $r->maketext("Your score was recorded."); 990 } else { 991 $scoreRecordedMessage = $r->maketext("Your score was not recorded because there was a failure in storing the problem record to the database."); 992 } 993 # write to the transaction log, just to make sure 994 writeLog($self->{ce}, "transaction", 995 $problem->problem_id."\t". 996 $problem->set_id."\t". 997 $problem->user_id."\t". 998 $problem->source_file."\t". 999 $problem->value."\t". 1000 $problem->max_attempts."\t". 1001 $problem->problem_seed."\t". 1002 $pureProblem->status."\t". 1003 $pureProblem->attempted."\t". 1004 $pureProblem->last_answer."\t". 1005 $pureProblem->num_correct."\t". 1006 $pureProblem->num_incorrect 1007 ); 1008 } else { 1009 if (before($set->open_date) or after($set->due_date)) { 1010 $scoreRecordedMessage = $r->maketext("Your score was not recorded because this homework set is closed."); 1011 } else { 1012 $scoreRecordedMessage = $r->maketext("Your score was not recorded."); 1013 } 1014 } 1015 } else { 1016 $scoreRecordedMessage = $r->maketext("Your score was not recorded because this problem has not been assigned to you."); 1017 } 1018 } 1019 1020 # logging student answers 1021 1022 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 1023 if ( defined($answer_log ) and defined($pureProblem)) { 1024 if ($submitAnswers && !$authz->hasPermissions($effectiveUser, "dont_log_past_answers")) { 1025 my $answerString = ""; my $scores = ""; 1026 my %answerHash = %{ $pg->{answers} }; 1027 # FIXME this is the line 552 error. make sure original student ans is defined. 1028 # The fact that it is not defined is probably due to an error in some answer evaluator. 1029 # But I think it is useful to suppress this error message in the log. 1030 foreach (sortByName(undef, keys %answerHash)) { 1031 my $orig_ans = $answerHash{$_}->{original_student_ans}; 1032 my $student_ans = defined $orig_ans ? $orig_ans : ''; 1033 $answerString .= $student_ans."\t"; 1034 $scores .= $answerHash{$_}->{score} >= 1 ? "1" : "0"; 1035 } 1036 $answerString = '' unless defined($answerString); # insure string is defined. 1037 writeCourseLog($self->{ce}, "answer_log", 1038 join("", 1039 '|', $problem->user_id, 1040 '|', $problem->set_id, 1041 '|', $problem->problem_id, 1042 '|', $scores, "\t", 1043 time(),"\t", 1044 $answerString, 1045 ), 1046 ); 1047 1048 } 1049 } 1050 1051 debug("end answer processing"); 1052 ##### javaScripts ############# 1053 my $site_url = $ce->{webworkURLs}->{htdocs}; 1054 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/wz_tooltip.js"}), CGI::end_script(); 1055 1056 ##### output ##### 1057 # custom message for editor 1058 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) { 1059 if ($editMode eq "temporaryFile") { 1060 print CGI::p(CGI::div({class=>'temporaryFile'}, $r->maketext("Viewing temporary file: "), $problem->source_file)); 1061 } elsif ($editMode eq "savedFile") { 1062 # taken care of in the initialization phase 1063 } 1064 } 1065 print CGI::start_div({class=>"problemHeader"}); 1066 1067 1068 1069 # attempt summary 1070 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. 1071 # until after the due date 1072 # do I need to check $will{showCorrectAnswers} to make preflight work?? 1073 if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) { 1074 # print this if user submitted answers OR requested correct answers 1075 1076 print $self->attemptResults($pg, 1, 1077 $will{showCorrectAnswers}, 1078 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); 1079 } elsif ($checkAnswers) { 1080 # print this if user previewed answers 1081 print CGI::div({class=>'ResultsWithError'},$r->maketext("ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED")), CGI::br(); 1082 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); 1083 # show attempt answers 1084 # show correct answers if asked 1085 # show attempt results (correctness) 1086 # show attempt previews 1087 } elsif ($previewAnswers) { 1088 # print this if user previewed answers 1089 print CGI::div({class=>'ResultsWithError'},$r->maketext("PREVIEW ONLY -- ANSWERS NOT RECORDED")),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); 1090 # show attempt answers 1091 # don't show correct answers 1092 # don't show attempt results (correctness) 1093 # show attempt previews 1094 } 1095 1096 print CGI::end_div(); 1097 1098 1099 ########################### 1100 # print style sheet for correct and incorrect answers 1101 ########################### 1102 # always show colors for checkAnswers 1103 # show colors for submit answer if 1104 if (($self->{checkAnswers}) or ($self->{submitAnswers} and $pg->{flags}->{showPartialCorrectAnswers}) ) { 1105 print CGI::start_style({type=>"text/css"}); 1106 #FIXME -- this hack is no longer needed? 1107 # my $string =""; 1108 # foreach my $ans_name (@{ $self->{correct_ids} }) { 1109 # $string .= '#'. ( $ans_name ). $ce->{pg}{options}{correct_answer}."\n"; 1110 # } 1111 # print $string; 1112 # $string =""; 1113 # foreach my $ans_name (@{ $self->{incorrect_ids} }) { 1114 # $string .= '#'. ($ ans_name). $ce->{pg}{options}{incorrect_answer}."\n"; 1115 # } 1116 # print $string; 1117 # the above method keeps one bad array ID from ruining all of the assignments. 1118 print '#'.join(', #', @{ $self->{correct_ids} }), $ce->{pg}{options}{correct_answer},"\n" if ref( $self->{correct_ids} )=~/ARRAY/; #correct green 1119 print '#'.join(', #', @{ $self->{incorrect_ids} }), $ce->{pg}{options}{incorrect_answer},"\n" if ref( $self->{incorrect_ids})=~/ARRAY/; #incorrect reddish 1120 print CGI::end_style(); 1121 } 1122 ########################### 1123 # post_header material 1124 ########################### 1125 print CGI::p($pg->{post_header_text}); 1126 ########################### 1127 # main form 1128 ########################### 1129 print "\n"; 1130 1131 print CGI::start_form(-method=>"POST", -action=> $r->uri,-name=>"problemMainForm", onsubmit=>"submitAction()"); 1132 print $self->hidden_authen_fields; 1133 print "\n"; 1134 print CGI::start_div({class=>"problem"}); 1135 print CGI::p($pg->{body_text}); 1136 print CGI::p(CGI::b("Note: "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg}; 1137 print $editorLink; # this is empty unless it is appropriate to have an editor link. 1138 print CGI::end_div(); 1139 1140 print CGI::start_p(); 1141 1142 if ($can{showCorrectAnswers}) { 1143 print CGI::checkbox( 1144 -name => "showCorrectAnswers", 1145 -checked => $will{showCorrectAnswers}, 1146 -label => $r->maketext("Show correct answers"), 1147 -value => 1, 1148 ); 1149 } 1150 if ($can{showHints}) { 1151 print CGI::div({style=>"color:red"}, 1152 CGI::checkbox( 1153 -name => "showHints", 1154 -checked => $will{showHints}, 1155 -label => $r->maketext("Show Hints"), 1156 -value =>1, 1157 ) 1158 ); 1159 } 1160 if ($can{showSolutions}) { 1161 print CGI::checkbox( 1162 -name => "showSolutions", 1163 -checked => $will{showSolutions}, 1164 -label => $r->maketext("Show Solutions"), 1165 -value => 1, 1166 ); 1167 } 1168 1169 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) { 1170 print CGI::br(); 1171 } 1172 1173 print CGI::submit(-name=>"previewAnswers", -label=>$r->maketext("Preview Answers")); 1174 if ($can{checkAnswers}) { 1175 print CGI::submit(-name=>"checkAnswers", -label=>$r->maketext("Check Answers")); 1176 } 1177 if ($can{getSubmitButton}) { 1178 if ($user ne $effectiveUser) { 1179 # if acting as a student, make it clear that answer submissions will 1180 # apply to the student's records, not the professor's. 1181 print CGI::submit(-name=>"submitAnswers", -label=>$r->maketext("Submit answers for [_1]",$effectiveUser)); 1182 } else { 1183 #print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>"alert('submit button clicked')"); 1184 print CGI::submit(-name=>"submitAnswers", -label=>$r->maketext("Submit answers"), -onclick=>""); 1185 # FIXME for unknown reasons the -onclick label seems to have to be there in order to allow the forms onsubmit to trigger 1186 # WTF??? 1187 } 1188 } 1189 1190 print CGI::end_p(); 1191 1192 print CGI::start_div({class=>"scoreSummary"}); 1193 1194 # score summary 1195 my $attempts = $problem->num_correct + $problem->num_incorrect; 1196 #my $attemptsNoun = $attempts != 1 ? $r->maketext("times") : $r->maketext("time"); 1197 my $problem_status = $problem->status || 0; 1198 my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number 1199 #my ($attemptsLeft, $attemptsLeftNoun); 1200 my $attemptsLeft = $problem->max_attempts - $attempts; 1201 # if ($problem->max_attempts == -1) { 1202 # # unlimited attempts 1203 # $attemptsLeft = $r->maketext("unlimited"); 1204 # $attemptsLeftNoun = $r->maketext("attempts"); 1205 # } else { 1206 # $attemptsLeft = $problem->max_attempts - $attempts; 1207 # $attemptsLeftNoun = $attemptsLeft == 1 ? $r->maketext("attempt") : $r->maketext("attempts"); 1208 # } 1209 1210 my $setClosed = 0; 1211 my $setClosedMessage; 1212 if (before($set->open_date) or after($set->due_date)) { 1213 $setClosed = 1; 1214 if (before($set->open_date)) { 1215 $setClosedMessage = $r->maketext("This homework set is not yet open."); 1216 } elsif (after($set->due_date)) { 1217 $setClosedMessage = $r->maketext("This homework set is closed."); 1218 } 1219 } 1220 #if (before($set->open_date) or after($set->due_date)) { 1221 # $setClosed = 1; 1222 # $setClosedMessage = "This homework set is closed."; 1223 # if ($authz->hasPermissions($user, "view_answers")) { 1224 # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; 1225 # } else { 1226 # $setClosedMessage .= " Additional attempts will not be recorded."; 1227 # } 1228 #} 1229 unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) { 1230 my $notCountedMessage = ($problem->value) ? "" : $r->maketext("(This problem will not count towards your grade.)"); 1231 print CGI::p(join("", 1232 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", 1233 $r->maketext("You have attempted this problem [quant,_1,time,times].",$attempts), CGI::br(), 1234 $submitAnswers ? $r->maketext("You received a score of [_1] for this attempt.",sprintf("%.0f%%", $pg->{result}->{score} * 100)) . CGI::br():'', 1235 $problem->attempted 1236 ? $r->maketext("Your overall recorded score is [_1]. [_2]",$lastScore,$notCountedMessage) . CGI::br() 1237 : "", 1238 # $setClosed ? $setClosedMessage : $r->maketext("You have [_1] [_2] remaining.",$attemptsLeft,$attemptsLeftNoun) 1239 $setClosed ? $setClosedMessage : $r->maketext("You have [negquant,_1,unlimited attempts,attempt,attempts] remaining.",$attemptsLeft) 1240 )); 1241 }else { 1242 print CGI::p($pg->{state}->{state_summary_msg}); 1243 } 1244 1245 print CGI::end_div(); 1246 print CGI::start_div(); 1247 1248 my $pgdebug = join(CGI::br(), @{$pg->{pgcore}->{flags}->{DEBUG_messages}} ); 1249 my $pgwarning = join(CGI::br(), @{$pg->{pgcore}->{flags}->{WARNING_messages}} ); 1250 my $pginternalerrors = join(CGI::br(), @{$pg->{pgcore}->get_internal_debug_messages} ); 1251 my $pgerrordiv = $pgdebug||$pgwarning||$pginternalerrors; # is 1 if any of these are non-empty 1252 1253 print CGI::p({style=>"color:red;"}, "Checking additional error messages") if $pgerrordiv ; 1254 print CGI::p("pg debug<br/> $pgdebug" ) if $pgdebug ; 1255 print CGI::p("pg warning<br/>$pgwarning" ) if $pgwarning ; 1256 print CGI::p("pg internal errors<br/> $pginternalerrors") if $pginternalerrors; 1257 print CGI::end_div() if $pgerrordiv ; 1258 1259 # save state for viewOptions 1260 print CGI::hidden( 1261 -name => "showOldAnswers", 1262 -value => $will{showOldAnswers} 1263 ), 1264 1265 CGI::hidden( 1266 -name => "displayMode", 1267 -value => $self->{displayMode} 1268 ); 1269 print( CGI::hidden( 1270 -name => 'editMode', 1271 -value => $self->{editMode}, 1272 ) 1273 ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile'; 1274 1275 # this is a security risk -- students can use this to find the source code for the problem 1276 1277 my $permissionLevel = $db->getPermissionLevel($user)->permission; 1278 my $professorPermissionLevel = $ce->{userRoles}->{professor}; 1279 print( CGI::hidden( 1280 -name => 'sourceFilePath', 1281 -value => $self->{problem}->{source_file} 1282 )) if defined($self->{problem}->{source_file}) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1283 1284 print( CGI::hidden( 1285 -name => 'problemSeed', 1286 -value => $r->param("problemSeed") 1287 )) if defined($r->param("problemSeed")) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1288 1289 1290 # end of main form 1291 print CGI::endform(); 1292 1293 print CGI::start_div({class=>"problemFooter"}); 1294 1295 1296 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", $r, 1297 courseID => $courseName); 1298 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action 1299 1300 # print answer inspection button 1301 if ($authz->hasPermissions($user, "view_answers")) { 1302 print "\n", 1303 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n", 1304 $self->hidden_authen_fields,"\n", 1305 CGI::hidden(-name => 'courseID', -value=>$courseName), "\n", 1306 CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n", 1307 CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n", 1308 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", 1309 CGI::p( {-align=>"left"}, 1310 CGI::submit(-name => 'action', -value=>$r->maketext("Show Past Answers")) 1311 ), "\n", 1312 CGI::endform(); 1313 } 1314 1315 1316 print $self->feedbackMacro( 1317 module => __PACKAGE__, 1318 set => $self->{set}->set_id, 1319 problem => $problem->problem_id, 1320 displayMode => $self->{displayMode}, 1321 showOldAnswers => $will{showOldAnswers}, 1322 showCorrectAnswers => $will{showCorrectAnswers}, 1323 showHints => $will{showHints}, 1324 showSolutions => $will{showSolutions}, 1325 pg_object => $pg, 1326 ); 1327 1328 print CGI::end_div(); 1329 1330 # debugging stuff 1331 if (0) { 1332 print 1333 CGI::hr(), 1334 CGI::h2("debugging information"), 1335 CGI::h3("form fields"), 1336 ref2string($self->{formFields}), 1337 CGI::h3("user object"), 1338 ref2string($self->{user}), 1339 CGI::h3("set object"), 1340 ref2string($set), 1341 CGI::h3("problem object"), 1342 ref2string($problem), 1343 CGI::h3("PG object"), 1344 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 1345 } 1346 debug("leaving body of Problem.pm"); 1347 return ""; 1348 } 1349 1350 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |