Parent Directory
| 
Revision Log
fixed problem in Show solutions
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); 19 #use base qw(WeBWorK::ContentGenerator); 20 use base qw(WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil); # not needed? 21 22 =head1 NAME 23 24 WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. 25 26 =cut 27 28 use strict; 29 use warnings; 30 #use CGI qw(-nosticky ); 31 use WeBWorK::CGI; 32 use File::Path qw(rmtree); 33 use WeBWorK::Debug; 34 use WeBWorK::Form; 35 use WeBWorK::PG; 36 use WeBWorK::PG::ImageGenerator; 37 use WeBWorK::PG::IO; 38 use WeBWorK::Utils qw(readFile writeLog writeCourseLog encodeAnswers decodeAnswers 39 ref2string makeTempDirectory path_is_subdir sortByName before after between); 40 use WeBWorK::DB::Utils qw(global2user user2global); 41 use URI::Escape; 42 use WeBWorK::Localize; 43 use WeBWorK::Utils::Tasks qw(fake_set fake_problem); 44 45 ################################################################################ 46 # CGI param interface to this module (up-to-date as of v1.153) 47 ################################################################################ 48 49 # Standard params: 50 # 51 # user - user ID of real user 52 # key - session key 53 # effectiveUser - user ID of effective user 54 # 55 # Integration with PGProblemEditor: 56 # 57 # editMode - if set, indicates alternate problem source location. 58 # can be "temporaryFile" or "savedFile". 59 # 60 # sourceFilePath - path to file to be edited 61 # problemSeed - force problem seed to value 62 # success - success message to display 63 # failure - failure message to display 64 # 65 # Rendering options: 66 # 67 # displayMode - name of display mode to use 68 # 69 # showOldAnswers - request that last entered answer be shown (if allowed) 70 # showCorrectAnswers - request that correct answers be shown (if allowed) 71 # showHints - request that hints be shown (if allowed) 72 # showSolutions - request that solutions be shown (if allowed) 73 # 74 # Problem interaction: 75 # 76 # AnSwEr# - answer blanks in problem 77 # 78 # redisplay - name of the "Redisplay Problem" button 79 # submitAnswers - name of "Submit Answers" button 80 # checkAnswers - name of the "Check Answers" button 81 # previewAnswers - name of the "Preview Answers" button 82 83 ################################################################################ 84 # "can" methods 85 ################################################################################ 86 87 # Subroutines to determine if a user "can" perform an action. Each subroutine is 88 # called with the following arguments: 89 # 90 # ($self, $User, $EffectiveUser, $Set, $Problem) 91 92 # Note that significant parts of the "can" methods are lifted into the 93 # GatewayQuiz module. It isn't direct, however, because of the necessity 94 # of dealing with versioning there. 95 96 sub can_showOldAnswers { 97 #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 98 99 return 1; 100 } 101 102 sub can_showCorrectAnswers { 103 my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 104 my $authz = $self->r->authz; 105 106 return 107 after($Set->answer_date) 108 || 109 $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date") 110 ; 111 } 112 113 sub can_showHints { 114 #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 115 116 return 1; 117 } 118 119 sub can_showSolutions { 120 my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 121 my $authz = $self->r->authz; 122 123 return 124 after($Set->answer_date) 125 || 126 $authz->hasPermissions($User->user_id, "show_solutions_before_answer_date") 127 ; 128 } 129 130 sub can_recordAnswers { 131 my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; 132 my $authz = $self->r->authz; 133 my $thisAttempt = $submitAnswers ? 1 : 0; 134 if ($User->user_id ne $EffectiveUser->user_id) { 135 return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student"); 136 } 137 if (before($Set->open_date)) { 138 return $authz->hasPermissions($User->user_id, "record_answers_before_open_date"); 139 } elsif (between($Set->open_date, $Set->due_date)) { 140 my $max_attempts = $Problem->max_attempts; 141 my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; 142 if ($max_attempts == -1 or $attempts_used < $max_attempts) { 143 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts"); 144 } else { 145 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts"); 146 } 147 } elsif (between($Set->due_date, $Set->answer_date)) { 148 return $authz->hasPermissions($User->user_id, "record_answers_after_due_date"); 149 } elsif (after($Set->answer_date)) { 150 return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date"); 151 } 152 } 153 154 sub can_checkAnswers { 155 my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; 156 my $authz = $self->r->authz; 157 my $thisAttempt = $submitAnswers ? 1 : 0; 158 159 if (before($Set->open_date)) { 160 return $authz->hasPermissions($User->user_id, "check_answers_before_open_date"); 161 } elsif (between($Set->open_date, $Set->due_date)) { 162 my $max_attempts = $Problem->max_attempts; 163 my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; 164 if ($max_attempts == -1 or $attempts_used < $max_attempts) { 165 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts"); 166 } else { 167 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts"); 168 } 169 } elsif (between($Set->due_date, $Set->answer_date)) { 170 return $authz->hasPermissions($User->user_id, "check_answers_after_due_date"); 171 } elsif (after($Set->answer_date)) { 172 return $authz->hasPermissions($User->user_id, "check_answers_after_answer_date"); 173 } 174 } 175 176 # Reset the default in some cases 177 sub set_showOldAnswers_default { 178 my ($self, $ce, $userName, $authz, $set) = @_; 179 # these people always use the system/course default, so don't 180 # override the value of ...->{showOldAnswers} 181 return if $authz->hasPermissions($userName, "can_always_use_show_old_answers_default"); 182 # this person should always default to 0 183 $ce->{pg}->{options}->{showOldAnswers} = 0 184 unless ($authz->hasPermissions($userName, "can_show_old_answers_by_default")); 185 # we are after the due date, so default to not showing it 186 $ce->{pg}->{options}->{showOldAnswers} = 0 if $set->{due_date} && after($set->{due_date}); 187 } 188 189 ################################################################################ 190 # output utilities 191 ################################################################################ 192 193 # Note: the substance of attemptResults is lifted into GatewayQuiz.pm, 194 # with some changes to the output format 195 196 sub attemptResults { 197 my $self = shift; 198 my $r = $self->r; 199 my $pg = shift; 200 my $showAttemptAnswers = shift; 201 my $showCorrectAnswers = shift; 202 my $showAttemptResults = $showAttemptAnswers && shift; 203 my $showSummary = shift; 204 my $showAttemptPreview = shift || 0; 205 206 my $ce = $self->r->ce; 207 208 # for color coding the responses. 209 my @correct_ids = (); 210 my @incorrect_ids = (); 211 212 213 my $problemResult = $pg->{result}; # the overall result of the problem 214 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 215 216 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 217 218 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 219 220 # to make grabbing these options easier, we'll pull them out now... 221 my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}}; 222 223 my $imgGen = WeBWorK::PG::ImageGenerator->new( 224 tempDir => $ce->{webworkDirs}->{tmp}, 225 latex => $ce->{externalPrograms}->{latex}, 226 dvipng => $ce->{externalPrograms}->{dvipng}, 227 useCache => 1, 228 cacheDir => $ce->{webworkDirs}->{equationCache}, 229 cacheURL => $ce->{webworkURLs}->{equationCache}, 230 cacheDB => $ce->{webworkFiles}->{equationCacheDB}, 231 dvipng_align => $imagesModeOptions{dvipng_align}, 232 dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, 233 ); 234 235 my $showEvaluatedAnswers = $ce->{pg}->{options}->{showEvaluatedAnswers}; 236 237 my $header; 238 #$header .= CGI::th("Part"); 239 if ($showEvaluatedAnswers) { 240 $header .= $showAttemptAnswers ? CGI::th($r->maketext("Entered")) : ""; 241 } 242 $header .= $showAttemptPreview ? CGI::th($r->maketext("Answer Preview")) : ""; 243 $header .= $showCorrectAnswers ? CGI::th($r->maketext("Correct")) : ""; 244 $header .= $showAttemptResults ? CGI::th($r->maketext("Result")) : ""; 245 $header .= $showMessages ? CGI::th($r->maketext("Messages")) : ""; 246 my $fully = ''; 247 my @tableRows = ( $header ); 248 my $numCorrect = 0; 249 my $numBlanks =0; 250 my $tthPreambleCache; 251 foreach my $name (@answerNames) { 252 my $answerResult = $pg->{answers}->{$name}; 253 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 254 my $preview = ($showAttemptPreview 255 ? $self->previewAnswer($answerResult, $imgGen, \$tthPreambleCache) 256 : ""); 257 my $correctAnswerPreview = $self->previewCorrectAnswer($answerResult, $imgGen, \$tthPreambleCache); 258 my $correctAnswer = $answerResult->{correct_ans}; 259 my $answerScore = $answerResult->{score}; 260 my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; 261 $answerMessage =~ s/\n/<BR>/g; 262 $numCorrect += $answerScore >= 1; 263 $numBlanks++ unless $studentAnswer =~/\S/ || $answerScore >= 1; # unless student answer contains entry 264 my $resultString = $answerScore >= 1 ? CGI::span({class=>"ResultsWithoutError"}, $r->maketext("correct")) : 265 $answerScore > 0 ? $r->maketext("[_1]% correct", int($answerScore*100)) : 266 CGI::span({class=>"ResultsWithError"}, $r->maketext("incorrect")); 267 $fully = $r->maketext("completely") if $answerScore >0 and $answerScore < 1; 268 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) ? $r->maketext("visible") : $r->maketext("hidden"); 599 my $visiblityStateText = ($set->visible) ? $r->maketext("visible to students")."." : $r->maketext("hidden from students")."."; 600 $self->addmessage(CGI::span($r->maketext("This set is [_1]", 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 post_header_text { 756 my ($self) = @_; 757 return "" if ( $self->{invalidSet} ); 758 return $self->{pg}->{post_header_text} if $self->{pg}->{post_header_text}; 759 } 760 761 sub options { 762 my ($self) = @_; 763 #warn "doing options in Problem"; 764 765 # don't show options if we don't have anything to show 766 return "" if $self->{invalidSet} or $self->{invalidProblem}; 767 768 my $displayMode = $self->{displayMode}; 769 my %can = %{ $self->{can} }; 770 771 my @options_to_show = "displayMode"; 772 push @options_to_show, "showOldAnswers" if $can{showOldAnswers}; 773 push @options_to_show, "showHints" if $can{showHints}; 774 push @options_to_show, "showSolutions" if $can{showSolutions}; 775 776 return $self->optionsMacro( 777 options_to_show => \@options_to_show, 778 extra_params => ["editMode", "sourceFilePath"], 779 ); 780 } 781 782 sub siblings { 783 my ($self) = @_; 784 my $r = $self->r; 785 my $db = $r->db; 786 my $urlpath = $r->urlpath; 787 788 # can't show sibling problems if the set is invalid 789 return "" if $self->{invalidSet}; 790 791 my $courseID = $urlpath->arg("courseID"); 792 my $setID = $self->{set}->set_id; 793 my $eUserID = $r->param("effectiveUser"); 794 my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID); 795 796 print CGI::start_div({class=>"info-box", id=>"fisheye"}); 797 print CGI::h2($r->maketext("Problems")); 798 #print CGI::start_ul({class=>"LinksMenu"}); 799 #print CGI::start_li(); 800 #print CGI::span({style=>"font-size:larger"}, "Problems"); 801 print CGI::start_ul(); 802 803 foreach my $problemID (@problemIDs) { 804 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", $r, 805 courseID => $courseID, setID => $setID, problemID => $problemID); 806 print CGI::li(CGI::a( {href=>$self->systemLink($problemPage, 807 params=>{ displayMode => $self->{displayMode}, 808 showOldAnswers => $self->{will}->{showOldAnswers} 809 })}, $r->maketext("Problem [_1]",$problemID)) 810 ); 811 } 812 813 print CGI::end_ul(); 814 #print CGI::end_li(); 815 #print CGI::end_ul(); 816 print CGI::end_div(); 817 818 return ""; 819 } 820 821 sub nav { 822 my ($self, $args) = @_; 823 my $r = $self->r; 824 my $db = $r->db; 825 my $urlpath = $r->urlpath; 826 827 return "" if ( $self->{invalidSet} ); 828 829 my $courseID = $urlpath->arg("courseID"); 830 my $setID = $self->{set}->set_id if !($self->{invalidSet}); 831 my $problemID = $self->{problem}->problem_id if !($self->{invalidProblem}); 832 my $eUserID = $r->param("effectiveUser"); 833 834 my ($prevID, $nextID); 835 836 if (!$self->{invalidProblem}) { 837 my @problemIDs = $db->listUserProblems($eUserID, $setID); 838 foreach my $id (@problemIDs) { 839 $prevID = $id if $id < $problemID 840 and (not defined $prevID or $id > $prevID); 841 $nextID = $id if $id > $problemID 842 and (not defined $nextID or $id < $nextID); 843 } 844 } 845 846 my @links; 847 848 if ($prevID) { 849 my $prevPage = $urlpath->newFromModule(__PACKAGE__, $r, 850 courseID => $courseID, setID => $setID, problemID => $prevID); 851 push @links, $r->maketext("Previous Problem"), $r->location . $prevPage->path, $r->maketext("navPrev"); 852 } else { 853 push @links, $r->maketext("Previous Problem"), "", $r->maketext("navPrevGrey"); 854 } 855 856 if (defined($setID) && $setID ne 'Undefined_Set') { 857 push @links, $r->maketext("Problem List"), $r->location . $urlpath->parent->path, $r->maketext("navProbList"); 858 } else { 859 push @links, $r->maketext("Problem List"), "", $r->maketext("navProbListGrey"); 860 } 861 862 if ($nextID) { 863 my $nextPage = $urlpath->newFromModule(__PACKAGE__, $r, 864 courseID => $courseID, setID => $setID, problemID => $nextID); 865 push @links, $r->maketext("Next Problem"), $r->location . $nextPage->path, $r->maketext("navNext"); 866 } else { 867 push @links, $r->maketext("Next Problem"), "", $r->maketext("navNextGrey"); 868 } 869 870 my $tail = ""; 871 872 $tail .= "&displayMode=".$self->{displayMode} if defined $self->{displayMode}; 873 $tail .= "&showOldAnswers=".$self->{will}->{showOldAnswers} 874 if defined $self->{will}->{showOldAnswers}; 875 return $self->navMacro($args, $tail, @links); 876 } 877 878 sub title { 879 my ($self) = @_; 880 my $r = $self->r; 881 # using the url arguments won't break if the set/problem are invalid 882 my $setID = WeBWorK::ContentGenerator::underscore2nbsp($self->r->urlpath->arg("setID")); 883 my $problemID = $self->r->urlpath->arg("problemID"); 884 885 return $r->maketext("[_1]: Problem [_2]",$setID, $problemID); 886 } 887 888 889 # now altered to outsource most output operations to the template, main functions now are simply error checking and answer processing - ghe3 890 # sub body { 891 # my $self = shift; 892 # my $set = $self->{set}; 893 # my $problem = $self->{problem}; 894 # my $pg = $self->{pg}; 895 # print "this is data from the old body function"; 896 # my $valid = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::check_invalid($self); 897 # unless($valid eq "valid"){ 898 # return $valid; 899 # } 900 # 901 # # my $editorLink = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_editorLink($self); 902 # # if($editorLink eq "permission_error"){ 903 # # return ""; 904 # # } 905 # 906 # ##### answer processing ##### 907 # debug("begin answer processing"); 908 # # if answers were submitted: 909 # my $scoreRecordedMessage = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_and_log_answer($self); 910 # debug("end answer processing"); 911 # 912 # ##### javaScripts ############# 913 # # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_JS($self); 914 # 915 # ##### output ##### 916 # # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_summary($self); 917 # 918 # ########################### 919 # # print style sheet for correct and incorrect answers 920 # ########################### 921 # 922 # # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_CSS($self); 923 # 924 # ########################### 925 # # main form 926 # ########################### 927 # 928 # # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_main_form($self,$editorLink); 929 # 930 # # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_footer($self); 931 # print "end of old body function"; 932 # # debugging stuff 933 # if (0) { 934 # print 935 # CGI::hr(), 936 # CGI::h2("debugging information"), 937 # CGI::h3("form fields"), 938 # ref2string($self->{formFields}), 939 # CGI::h3("user object"), 940 # ref2string($self->{user}), 941 # CGI::h3("set object"), 942 # ref2string($set), 943 # CGI::h3("problem object"), 944 # ref2string($problem), 945 # CGI::h3("PG object"), 946 # ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 947 # } 948 # debug("leaving body of Problem.pm"); 949 # return ""; 950 # } 951 952 # output_form_start subroutine 953 954 # prints out the beginning of the main form, and the necessary hidden authentication fields 955 956 sub output_form_start{ 957 my $self = shift; 958 my $r = $self->r; 959 print CGI::start_form(-method=>"POST", -action=> $r->uri,-name=>"problemMainForm", onsubmit=>"submitAction()"); 960 print $self->hidden_authen_fields; 961 return ""; 962 } 963 964 965 # output_problem_body subroutine 966 967 # prints out the body of the current problem 968 969 sub output_problem_body{ 970 my $self = shift; 971 my $pg = $self->{pg}; 972 973 print "\n"; 974 print CGI::p($pg->{body_text}); 975 return ""; 976 } 977 978 # output_message subroutine 979 980 # prints out a message about the problem 981 982 sub output_message{ 983 my $self = shift; 984 my $pg = $self->{pg}; 985 my $r = $self->r; 986 987 print CGI::p(CGI::b($r->maketext("Note").": "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg}; 988 return ""; 989 } 990 991 # output_editorLink subroutine 992 993 # processes and prints out the correct link to the editor of the current problem 994 995 sub output_editorLink{ 996 997 my $self = shift; 998 999 my $set = $self->{set}; 1000 my $problem = $self->{problem}; 1001 my $pg = $self->{pg}; 1002 1003 my $r = $self->r; 1004 1005 my $authz = $r->authz; 1006 my $urlpath = $r->urlpath; 1007 my $user = $r->param('user'); 1008 1009 my $courseName = $urlpath->arg("courseID"); 1010 1011 # FIXME: move editor link to top, next to problem number. 1012 # format as "[edit]" like we're doing with course info file, etc. 1013 # add edit link for set as well. 1014 my $editorLink = ""; 1015 # if we are here without a real homework set, carry that through 1016 my $forced_field = []; 1017 $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if 1018 ($set->set_id eq 'Undefined_Set'); 1019 if ($authz->hasPermissions($user, "modify_problem_sets")) { 1020 my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, 1021 courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id); 1022 my $editorURL = $self->systemLink($editorPage, params=>$forced_field); 1023 $editorLink = CGI::p(CGI::a({href=>$editorURL,target =>'WW_Editor'}, $r->maketext("Edit this problem"))); 1024 } 1025 1026 ##### translation errors? ##### 1027 1028 if ($pg->{flags}->{error_flag}) { 1029 if ($authz->hasPermissions($user, "view_problem_debugging_info")) { 1030 print $self->errorOutput($pg->{errors}, $pg->{body_text}); 1031 } else { 1032 print $self->errorOutput($pg->{errors}, $r->maketext("You do not have permission to view the details of this error.")); 1033 } 1034 print ""; 1035 } 1036 else{ 1037 print $editorLink; 1038 } 1039 return ""; 1040 } 1041 1042 # output_checkboxes subroutine 1043 1044 # prints out the checkbox input elements that are available for the current problem 1045 1046 sub output_checkboxes{ 1047 my $self = shift; 1048 my $r = $self->r; 1049 my %can = %{ $self->{can} }; 1050 my %will = %{ $self->{will} }; 1051 1052 if ($can{showCorrectAnswers}) { 1053 print WeBWorK::CGI_labeled_input( 1054 -type => "checkbox", 1055 -id => "showCorrectAnswers_id", 1056 -label_text => $r->maketext("Show correct answers"), 1057 -input_attr => $will{showCorrectAnswers} ? 1058 { 1059 -name => "showCorrectAnswers", 1060 -checked => "checked", 1061 -value => 1, 1062 } 1063 : 1064 { 1065 -name => "showCorrectAnswers", 1066 -value => 1, 1067 } 1068 ); 1069 } 1070 if ($can{showHints}) { 1071 print CGI::div({style=>"color:red"}, 1072 WeBWorK::CGI_labeled_input( 1073 -type => "checkbox", 1074 -id => "showHints_id", 1075 -label_text => $r->maketext("Show Hints"), 1076 -input_attr => $will{showHints} ? 1077 { 1078 -name => "showHints", 1079 -checked => "checked", 1080 -value => 1, 1081 } 1082 : 1083 { 1084 -name => "showHints", 1085 -value => 1, 1086 } 1087 ) 1088 ); 1089 } 1090 if ($can{showSolutions}) { 1091 print WeBWorK::CGI_labeled_input( 1092 -type => "checkbox", 1093 -id => "showSolutions_id", 1094 -label_text => $r->maketext("Show Solutions"), 1095 -input_attr => $will{showSolutions} ? 1096 { 1097 -name => "showSolutions", 1098 -checked => "checked", 1099 -value => 1, 1100 } 1101 : 1102 { 1103 -name => "showSolutions", 1104 -value => 1, 1105 } 1106 ); 1107 } 1108 1109 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) { 1110 print CGI::br(); 1111 } 1112 1113 return ""; 1114 } 1115 1116 # output_submit_buttons 1117 1118 # prints out the submit button input elements that are available for the current problem 1119 1120 sub output_submit_buttons{ 1121 my $self = shift; 1122 my $r = $self->r; 1123 my %can = %{ $self->{can} }; 1124 1125 my $user = $r->param('user'); 1126 my $effectiveUser = $r->param('effectiveUser'); 1127 1128 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"previewAnswers_id", -input_attr=>{-name=>"previewAnswers", -value=>$r->maketext("Preview Answers")}); 1129 if ($can{checkAnswers}) { 1130 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"checkAnswers_id", -input_attr=>{-name=>"checkAnswers", -value=>$r->maketext("Check Answers")}); 1131 } 1132 if ($can{getSubmitButton}) { 1133 if ($user ne $effectiveUser) { 1134 # if acting as a student, make it clear that answer submissions will 1135 # apply to the student's records, not the professor's. 1136 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"submitAnswers_id", -input_attr=>{-name=>$r->maketext("submitAnswers"), -value=>$r->maketext("Submit Answers for [_1]", $effectiveUser)}); 1137 } else { 1138 #print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>"alert('submit button clicked')"); 1139 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"submitAnswers_id", -input_attr=>{-name=>"submitAnswers", -label=>$r->maketext("Submit answers"), -onclick=>""}); 1140 # FIXME for unknown reasons the -onclick label seems to have to be there in order to allow the forms onsubmit to trigger 1141 # WTF??? 1142 } 1143 } 1144 1145 return ""; 1146 } 1147 1148 # output_score_summary subroutine 1149 1150 # prints out a summary of the student's current progress and status on the current problem 1151 1152 sub output_score_summary{ 1153 my $self = shift; 1154 my $r = $self->r; 1155 my $problem = $self->{problem}; 1156 my $set = $self->{set}; 1157 my $pg = $self->{pg}; 1158 my $scoreRecordedMessage = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_and_log_answer($self) || ""; 1159 my $submitAnswers = $self->{submitAnswers}; 1160 1161 # score summary 1162 warn "num_correct =", $problem->num_correct,"num_incorrect=",$problem->num_incorrect 1163 unless defined($problem->num_correct) and defined($problem->num_incorrect) ; 1164 my $attempts = $problem->num_correct + $problem->num_incorrect; 1165 #my $attemptsNoun = $attempts != 1 ? $r->maketext("times") : $r->maketext("time"); 1166 my $problem_status = $problem->status || 0; 1167 my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number 1168 #my ($attemptsLeft, $attemptsLeftNoun); 1169 my $attemptsLeft = $problem->max_attempts - $attempts; 1170 # if ($problem->max_attempts == -1) { 1171 # # unlimited attempts 1172 # $attemptsLeft = $r->maketext("unlimited"); 1173 # $attemptsLeftNoun = $r->maketext("attempts"); 1174 # } else { 1175 # $attemptsLeft = $problem->max_attempts - $attempts; 1176 # $attemptsLeftNoun = $attemptsLeft == 1 ? $r->maketext("attempt") : $r->maketext("attempts"); 1177 # } 1178 1179 my $setClosed = 0; 1180 my $setClosedMessage; 1181 if (before($set->open_date) or after($set->due_date)) { 1182 $setClosed = 1; 1183 if (before($set->open_date)) { 1184 $setClosedMessage = $r->maketext("This homework set is not yet open."); 1185 } elsif (after($set->due_date)) { 1186 $setClosedMessage = $r->maketext("This homework set is closed."); 1187 } 1188 } 1189 #if (before($set->open_date) or after($set->due_date)) { 1190 # $setClosed = 1; 1191 # $setClosedMessage = "This homework set is closed."; 1192 # if ($authz->hasPermissions($user, "view_answers")) { 1193 # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; 1194 # } else { 1195 # $setClosedMessage .= " Additional attempts will not be recorded."; 1196 # } 1197 #} 1198 unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) { 1199 my $notCountedMessage = ($problem->value) ? "" : $r->maketext("(This problem will not count towards your grade.)"); 1200 print CGI::p(join("", 1201 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", 1202 $r->maketext("You have attempted this problem [quant,_1,time,times].",$attempts), CGI::br(), 1203 $submitAnswers ? $r->maketext("You received a score of [_1] for this attempt.",sprintf("%.0f%%", $pg->{result}->{score} * 100)) . CGI::br():'', 1204 $problem->attempted 1205 ? $r->maketext("Your overall recorded score is [_1]. [_2]",$lastScore,$notCountedMessage) . CGI::br() 1206 : "", 1207 $setClosed ? $setClosedMessage : $r->maketext("You have [negquant,_1,unlimited attempts,attempt,attempts] remaining.",$attemptsLeft) 1208 )); 1209 }else { 1210 print CGI::p($pg->{state}->{state_summary_msg}); 1211 } 1212 1213 return ""; 1214 } 1215 1216 # output_misc subroutine 1217 1218 # prints out other necessary elements 1219 1220 sub output_misc{ 1221 1222 my $self = shift; 1223 my $r = $self->r; 1224 my $ce = $r->ce; 1225 my $db = $r->db; 1226 my $pg = $self->{pg}; 1227 my %will = %{ $self->{will} }; 1228 my $user = $r->param('user'); 1229 1230 print CGI::start_div(); 1231 1232 my $pgdebug = join(CGI::br(), @{$pg->{pgcore}->{flags}->{DEBUG_messages}} ); 1233 my $pgwarning = join(CGI::br(), @{$pg->{pgcore}->{flags}->{WARNING_messages}} ); 1234 my $pginternalerrors = join(CGI::br(), @{$pg->{pgcore}->get_internal_debug_messages} ); 1235 my $pgerrordiv = $pgdebug||$pgwarning||$pginternalerrors; # is 1 if any of these are non-empty 1236 1237 print CGI::p({style=>"color:red;"}, $r->maketext("Checking additional error messages")) if $pgerrordiv ; 1238 print CGI::p("pg debug<br/> $pgdebug" ) if $pgdebug ; 1239 print CGI::p("pg warning<br/>$pgwarning" ) if $pgwarning ; 1240 print CGI::p("pg internal errors<br/> $pginternalerrors") if $pginternalerrors; 1241 print CGI::end_div() if $pgerrordiv ; 1242 1243 # save state for viewOptions 1244 print CGI::hidden( 1245 -name => "showOldAnswers", 1246 -value => $will{showOldAnswers} 1247 ), 1248 1249 CGI::hidden( 1250 -name => "displayMode", 1251 -value => $self->{displayMode} 1252 ); 1253 print( CGI::hidden( 1254 -name => 'editMode', 1255 -value => $self->{editMode}, 1256 ) 1257 ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile'; 1258 1259 # this is a security risk -- students can use this to find the source code for the problem 1260 1261 my $permissionLevel = $db->getPermissionLevel($user)->permission; 1262 my $professorPermissionLevel = $ce->{userRoles}->{professor}; 1263 print( CGI::hidden( 1264 -name => 'sourceFilePath', 1265 -value => $self->{problem}->{source_file} 1266 )) if defined($self->{problem}->{source_file}) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1267 1268 print( CGI::hidden( 1269 -name => 'problemSeed', 1270 -value => $r->param("problemSeed") 1271 )) if defined($r->param("problemSeed")) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1272 print CGI::end_div(); 1273 return ""; 1274 } 1275 1276 # output_summary subroutine 1277 1278 # prints out the summary of the questions that the student has answered for the current problem, along with available information about correctness 1279 1280 sub output_summary{ 1281 1282 my $self = shift; 1283 1284 my $editMode = $self->{editMode}; 1285 my $problem = $self->{problem}; 1286 my $pg = $self->{pg}; 1287 my $submitAnswers = $self->{submitAnswers}; 1288 my %will = %{ $self->{will} }; 1289 my $checkAnswers = $self->{checkAnswers}; 1290 my $previewAnswers = $self->{previewAnswers}; 1291 1292 my $r = $self->r; 1293 1294 my $authz = $r->authz; 1295 my $user = $r->param('user'); 1296 1297 # attempt summary 1298 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. 1299 # until after the due date 1300 # do I need to check $will{showCorrectAnswers} to make preflight work?? 1301 if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) { 1302 # print this if user submitted answers OR requested correct answers 1303 1304 print $self->attemptResults($pg, 1, 1305 $will{showCorrectAnswers}, 1306 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); 1307 } elsif ($checkAnswers) { 1308 # print this if user previewed answers 1309 print CGI::div({class=>'ResultsWithError'},$r->maketext("ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED")), CGI::br(); 1310 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); 1311 # show attempt answers 1312 # show correct answers if asked 1313 # show attempt results (correctness) 1314 # show attempt previews 1315 } elsif ($previewAnswers) { 1316 # print this if user previewed answers 1317 print CGI::div({class=>'ResultsWithError'},$r->maketext("PREVIEW ONLY -- ANSWERS NOT RECORDED")),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); 1318 # show attempt answers 1319 # don't show correct answers 1320 # don't show attempt results (correctness) 1321 # show attempt previews 1322 } 1323 1324 return ""; 1325 } 1326 1327 # output_custom_edit_message 1328 1329 # prints out a custom edit message 1330 1331 sub output_custom_edit_message{ 1332 my $self = shift; 1333 my $r = $self->r; 1334 my $authz = $r->authz; 1335 my $user = $r->param('user'); 1336 my $editMode = $self->{editMode}; 1337 my $problem = $self->{problem}; 1338 1339 # custom message for editor 1340 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) { 1341 if ($editMode eq "temporaryFile") { 1342 print CGI::p(CGI::div({class=>'temporaryFile'}, $r->maketext("Viewing temporary file: "), $problem->source_file)); 1343 } elsif ($editMode eq "savedFile") { 1344 # taken care of in the initialization phase 1345 } 1346 } 1347 1348 return ""; 1349 } 1350 1351 # output_JS subroutine 1352 1353 # prints out the wz_tooltip.js script for the current site. 1354 1355 sub output_wztooltip_JS{ 1356 1357 my $self = shift; 1358 my $r = $self->r; 1359 my $ce = $r->ce; 1360 1361 my $site_url = $ce->{webworkURLs}->{htdocs}; 1362 1363 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/wz_tooltip.js"}), CGI::end_script(); 1364 return ""; 1365 } 1366 1367 # output_CSS subroutine 1368 1369 # prints the CSS scripts to page. Does some PERL trickery to form the styles for the correct answers and the incorrect answers (which may be substituted with JS sometime in the future). 1370 1371 sub output_CSS{ 1372 1373 my $self = shift; 1374 my $r = $self->r; 1375 my $ce = $r->ce; 1376 my $pg = $self->{pg}; 1377 1378 # always show colors for checkAnswers 1379 # show colors for submit answer if 1380 if (($self->{checkAnswers}) or ($self->{submitAnswers} and $pg->{flags}->{showPartialCorrectAnswers}) ) { 1381 print CGI::start_style({type=>"text/css"}); 1382 print '#'.join(', #', @{ $self->{correct_ids} }), $ce->{pg}{options}{correct_answer} if ref( $self->{correct_ids} )=~/ARRAY/; #correct green 1383 print '#'.join(', #', @{ $self->{incorrect_ids} }), $ce->{pg}{options}{incorrect_answer} if ref( $self->{incorrect_ids})=~/ARRAY/; #incorrect reddish 1384 print CGI::end_style(); 1385 } 1386 1387 return ""; 1388 } 1389 1390 # output_past_answer_button 1391 1392 # prints out the "Show Past Answers" button 1393 1394 sub output_past_answer_button{ 1395 my $self = shift; 1396 my $r = $self->r; 1397 my $problem = $self->{problem}; 1398 1399 my $authz = $r->authz; 1400 my $urlpath = $r->urlpath; 1401 my $user = $r->param('user'); 1402 1403 my $courseName = $urlpath->arg("courseID"); 1404 1405 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", $r, 1406 courseID => $courseName); 1407 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action 1408 1409 # print answer inspection button 1410 if ($authz->hasPermissions($user, "view_answers")) { 1411 print "\n", 1412 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n", 1413 $self->hidden_authen_fields,"\n", 1414 CGI::hidden(-name => 'courseID', -value=>$courseName), "\n", 1415 CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n", 1416 CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n", 1417 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", 1418 CGI::p( {-align=>"left"}, 1419 CGI::submit(-name => 'action', -value=>$r->maketext("Show Past Answers")) 1420 ), "\n", 1421 CGI::endform(); 1422 } 1423 1424 return ""; 1425 } 1426 1427 # output_email_instructor subroutine 1428 1429 # prints out the "Email Instructor" button 1430 1431 sub output_email_instructor{ 1432 my $self = shift; 1433 my $problem = $self->{problem}; 1434 my %will = %{ $self->{will} }; 1435 my $pg = $self->{pg}; 1436 1437 print $self->feedbackMacro( 1438 module => __PACKAGE__, 1439 set => $self->{set}->set_id, 1440 problem => $problem->problem_id, 1441 displayMode => $self->{displayMode}, 1442 showOldAnswers => $will{showOldAnswers}, 1443 showCorrectAnswers => $will{showCorrectAnswers}, 1444 showHints => $will{showHints}, 1445 showSolutions => $will{showSolutions}, 1446 pg_object => $pg, 1447 ); 1448 1449 return ""; 1450 } 1451 1452 # output_hidden_info subroutine 1453 1454 # outputs the hidden fields required for the form 1455 1456 sub output_hidden_info{ 1457 my $self = shift; 1458 1459 if(defined $self->{correct_ids}){ 1460 my $correctRef = $self->{correct_ids}; 1461 my @correct = @$correctRef; 1462 foreach(@correct){ 1463 print CGI::hidden(-name=>"correct_ids", -value=>$_."_val"); 1464 } 1465 } 1466 if(defined $self->{incorrect_ids}){ 1467 my $incorrectRef = $self->{incorrect_ids}; 1468 my @incorrect = @$incorrectRef; 1469 foreach(@incorrect){ 1470 print CGI::hidden(-name=>"incorrect_ids", -value=>$_."_val"); 1471 } 1472 } 1473 1474 return ""; 1475 } 1476 1477 # output_JS subroutine 1478 1479 # outputs all of the Javascript needed for this page. 1480 1481 sub output_JS{ 1482 my $self = shift; 1483 my $r = $self->r; 1484 my $ce = $r->ce; 1485 1486 my $site_url = $ce->{webworkURLs}->{htdocs}; 1487 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/addOnLoadEvent.js"}), CGI::end_script(); 1488 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/color.js"}), CGI::end_script(); 1489 return ""; 1490 } 1491 1492 # Simply here to indicate to the template that this page has body part methods which can be called 1493 1494 sub can_body_parts{ 1495 return ""; 1496 } 1497 1498 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |