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