Parent Directory
| 
Revision Log
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); 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 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 $pg = shift; 199 my $showAttemptAnswers = shift; 200 my $showCorrectAnswers = shift; 201 my $showAttemptResults = $showAttemptAnswers && shift; 202 my $showSummary = shift; 203 my $showAttemptPreview = shift || 0; 204 205 my $ce = $self->r->ce; 206 207 # for color coding the responses. 208 my @correct_ids = (); 209 my @incorrect_ids = (); 210 211 212 my $problemResult = $pg->{result}; # the overall result of the problem 213 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 214 215 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 216 217 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 218 219 # to make grabbing these options easier, we'll pull them out now... 220 my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}}; 221 222 my $imgGen = WeBWorK::PG::ImageGenerator->new( 223 tempDir => $ce->{webworkDirs}->{tmp}, 224 latex => $ce->{externalPrograms}->{latex}, 225 dvipng => $ce->{externalPrograms}->{dvipng}, 226 useCache => 1, 227 cacheDir => $ce->{webworkDirs}->{equationCache}, 228 cacheURL => $ce->{webworkURLs}->{equationCache}, 229 cacheDB => $ce->{webworkFiles}->{equationCacheDB}, 230 dvipng_align => $imagesModeOptions{dvipng_align}, 231 dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, 232 ); 233 234 my $header; 235 #$header .= CGI::th("Part"); 236 #$header .= $showAttemptAnswers ? CGI::th("Entered") : ""; 237 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : ""; 238 $header .= $showCorrectAnswers ? CGI::th("Correct") : ""; 239 $header .= $showAttemptResults ? CGI::th("Result") : ""; 240 $header .= $showMessages ? CGI::th("Messages") : ""; 241 my $fully = ''; 242 my @tableRows = ( $header ); 243 my $numCorrect = 0; 244 my $numBlanks =0; 245 my $tthPreambleCache; 246 foreach my $name (@answerNames) { 247 my $answerResult = $pg->{answers}->{$name}; 248 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 249 my $preview = ($showAttemptPreview 250 ? $self->previewAnswer($answerResult, $imgGen, \$tthPreambleCache) 251 : ""); 252 my $correctAnswerPreview = $self->previewCorrectAnswer($answerResult, $imgGen, \$tthPreambleCache); 253 my $correctAnswer = $answerResult->{correct_ans}; 254 my $answerScore = $answerResult->{score}; 255 my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; 256 $answerMessage =~ s/\n/<BR>/g; 257 $numCorrect += $answerScore >= 1; 258 $numBlanks++ unless $studentAnswer =~/\S/ || $answerScore >= 1; # unless student answer contains entry 259 my $resultString = $answerScore >= 1 ? CGI::span({class=>"ResultsWithoutError"}, "correct") : 260 $answerScore > 0 ? int($answerScore*100)."% correct" : 261 CGI::span({class=>"ResultsWithError"}, "incorrect"); 262 $fully = 'completely ' if $answerScore >0 and $answerScore < 1; 263 264 push @correct_ids, $name if $answerScore == 1; 265 push @incorrect_ids, $name if $answerScore < 1; 266 267 # get rid of the goofy prefix on the answer names (supposedly, the format 268 # of the answer names is changeable. this only fixes it for "AnSwEr" 269 #$name =~ s/^AnSwEr//; 270 271 my $row; 272 #$row .= CGI::td($name); 273 #$row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : ""; 274 $row .= $showAttemptPreview ? CGI::td({onmouseover=>qq!Tip('$studentAnswer',SHADOW, true, 275 DELAY, 1000, FADEIN, 300, FADEOUT, 300, STICKY, 1, OFFSETX, -20, CLOSEBTN, true, CLICKCLOSE, false, 276 BGCOLOR, '#F4FF91', TITLE, 'Entered:',TITLEBGCOLOR, '#F4FF91', TITLEFONTCOLOR, '#000000')!}, 277 $self->nbsp($preview)) : ""; 278 $row .= $showCorrectAnswers ? CGI::td({onmouseover=> qq!Tip('$correctAnswer',SHADOW, true, 279 DELAY, 1000, FADEIN, 300, FADEOUT, 300, STICKY, 1, OFFSETX, -20, CLOSEBTN, true, CLICKCLOSE, false, 280 BGCOLOR, '#F4FF91', TITLE, 'Entered:',TITLEBGCOLOR, '#F4FF91', TITLEFONTCOLOR, '#000000')!}, 281 $self->nbsp($correctAnswerPreview)) : ""; 282 $row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : ""; 283 $row .= $showMessages ? CGI::td({-class=>"Message"},$self->nbsp($answerMessage)) : ""; 284 push @tableRows, $row; 285 } 286 287 # render equation images 288 $imgGen->render(refresh => 1); 289 290 # my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; 291 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); 292 # FIXME -- I left the old code in in case we have to back out. 293 # my $summary = "On this attempt, you answered $numCorrect out of " 294 # . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; 295 my $summary = ""; 296 unless (defined($problemResult->{summary}) and $problemResult->{summary} =~ /\S/) { 297 if (scalar @answerNames == 1) { #default messages 298 if ($numCorrect == scalar @answerNames) { 299 $summary .= CGI::div({class=>"ResultsWithoutError"},"The answer above is correct."); 300 } else { 301 $summary .= CGI::div({class=>"ResultsWithError"},"The answer above is NOT ${fully}correct."); 302 } 303 } else { 304 if ($numCorrect == scalar @answerNames) { 305 $summary .= CGI::div({class=>"ResultsWithoutError"},"All of the answers above are correct."); 306 } 307 unless ($numCorrect + $numBlanks == scalar( @answerNames)) { 308 $summary .= CGI::div({class=>"ResultsWithError"},"At least one of the answers above is NOT ${fully}correct."); 309 } 310 if ($numBlanks) { 311 my $s = ($numBlanks>1)?'':'s'; 312 $summary .= CGI::div({class=>"ResultsAlert"},"$numBlanks of the questions remain$s unanswered."); 313 } 314 } 315 } else { 316 $summary = $problemResult->{summary}; # summary has been defined by grader 317 } 318 319 $self->{correct_ids}=[@correct_ids] if @correct_ids; 320 $self->{incorrect_ids} = [@incorrect_ids] if @incorrect_ids; 321 322 return 323 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) 324 . ($showSummary ? CGI::p({class=>'attemptResultsSummary'},$summary) : ""); 325 } 326 327 328 # Note: previewAnswer is lifted into GatewayQuiz.pm 329 330 sub previewAnswer { 331 my ($self, $answerResult, $imgGen, $tthPreambleCache) = @_; 332 my $ce = $self->r->ce; 333 my $effectiveUser = $self->{effectiveUser}; 334 my $set = $self->{set}; 335 my $problem = $self->{problem}; 336 my $displayMode = $self->{displayMode}; 337 338 # note: right now, we have to do things completely differently when we are 339 # rendering math from INSIDE the translator and from OUTSIDE the translator. 340 # so we'll just deal with each case explicitly here. there's some code 341 # duplication that can be dealt with later by abstracting out tth/dvipng/etc. 342 343 my $tex = $answerResult->{preview_latex_string}; 344 345 return "" unless defined $tex and $tex ne ""; 346 347 if ($displayMode eq "plainText") { 348 return $tex; 349 } elsif ($displayMode eq "formattedText") { 350 351 # read the TTH preamble, or use the cached copy passed in from the caller 352 my $tthPreamble=''; 353 if (defined $$tthPreambleCache) { 354 $tthPreamble = $$tthPreambleCache; 355 } else { 356 my $tthPreambleFile = $ce->{courseDirs}->{templates} . "/tthPreamble.tex"; 357 if (-r $tthPreambleFile) { 358 $tthPreamble = readFile($tthPreambleFile); 359 # thanks to Jim Martino. each line in the definition file should end with 360 #a % to prevent adding supurious paragraphs to output: 361 $tthPreamble =~ s/(.)\n/$1%\n/g; 362 # solves the problem if the file doesn't end with a return: 363 $tthPreamble .="%\n"; 364 # store preamble in cache: 365 $$tthPreambleCache = $tthPreamble; 366 } else { 367 } 368 } 369 370 # construct TTH command line 371 my $tthCommand = $ce->{externalPrograms}->{tth} 372 . " -L -f5 -u -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" 373 . $tthPreamble . "\\[" . $tex . "\\]\n" 374 . "END_OF_INPUT\n"; 375 376 # call tth 377 my $result = `$tthCommand`; 378 if ($?) { 379 return "<b>[tth failed: $? $@]</b>"; 380 } else { 381 # avoid border problems in tables and remove unneeded initial <br> 382 $result =~ s/(<table [^>]*)>/$1 CLASS="ArrayLayout">/gi; 383 $result =~ s!\s*<br clear="all" />!!; 384 return $result; 385 } 386 387 } elsif ($displayMode eq "images") { 388 $imgGen->add($tex); 389 } elsif ($displayMode eq "MathJax") { 390 return '<span class="MathJax_Preview">[math]</span><script type="math/tex; mode=display">'.$tex.'</script>'; 391 } elsif ($displayMode eq "jsMath") { 392 $tex =~ s/&/&/g; $tex =~ s/</</g; $tex =~ s/>/>/g; 393 return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>'; 394 } 395 } 396 sub previewCorrectAnswer { 397 my ($self, $answerResult, $imgGen, $tthPreambleCache) = @_; 398 my $ce = $self->r->ce; 399 my $effectiveUser = $self->{effectiveUser}; 400 my $set = $self->{set}; 401 my $problem = $self->{problem}; 402 my $displayMode = $self->{displayMode}; 403 404 # note: right now, we have to do things completely differently when we are 405 # rendering math from INSIDE the translator and from OUTSIDE the translator. 406 # so we'll just deal with each case explicitly here. there's some code 407 # duplication that can be dealt with later by abstracting out tth/dvipng/etc. 408 409 my $tex = $answerResult->{correct_ans_latex_string}; 410 return $answerResult->{correct_ans} unless defined $tex and $tex=~/\S/; # some answers don't have latex strings defined 411 # return "" unless defined $tex and $tex ne ""; 412 413 if ($displayMode eq "plainText") { 414 return $tex; 415 } elsif ($displayMode eq "formattedText") { 416 417 # read the TTH preamble, or use the cached copy passed in from the caller 418 my $tthPreamble=''; 419 if (defined $$tthPreambleCache) { 420 $tthPreamble = $$tthPreambleCache; 421 } else { 422 my $tthPreambleFile = $ce->{courseDirs}->{templates} . "/tthPreamble.tex"; 423 if (-r $tthPreambleFile) { 424 $tthPreamble = readFile($tthPreambleFile); 425 # thanks to Jim Martino. each line in the definition file should end with 426 #a % to prevent adding supurious paragraphs to output: 427 $tthPreamble =~ s/(.)\n/$1%\n/g; 428 # solves the problem if the file doesn't end with a return: 429 $tthPreamble .="%\n"; 430 # store preamble in cache: 431 $$tthPreambleCache = $tthPreamble; 432 } else { 433 } 434 } 435 436 # construct TTH command line 437 my $tthCommand = $ce->{externalPrograms}->{tth} 438 . " -L -f5 -u -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" 439 . $tthPreamble . "\\[" . $tex . "\\]\n" 440 . "END_OF_INPUT\n"; 441 442 # call tth 443 my $result = `$tthCommand`; 444 if ($?) { 445 return "<b>[tth failed: $? $@]</b>"; 446 } else { 447 # avoid border problems in tables and remove unneeded initial <br> 448 $result =~ s/(<table [^>]*)>/$1 CLASS="ArrayLayout">/gi; 449 $result =~ s!\s*<br clear="all" />!!; 450 return $result; 451 } 452 453 } elsif ($displayMode eq "images") { 454 $imgGen->add($tex); 455 } elsif ($displayMode eq "MathJax") { 456 return '<span class="MathJax_Preview">[math]</span><script type="math/tex; mode=display">'.$tex.'</script>'; 457 } elsif ($displayMode eq "jsMath") { 458 $tex =~ s/&/&/g; $tex =~ s/</</g; $tex =~ s/>/>/g; 459 return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>'; 460 } 461 } 462 463 ################################################################################ 464 # Template escape implementations 465 ################################################################################ 466 467 sub pre_header_initialize { 468 my ($self) = @_; 469 my $r = $self->r; 470 my $ce = $r->ce; 471 my $db = $r->db; 472 my $authz = $r->authz; 473 my $urlpath = $r->urlpath; 474 475 my $setName = $urlpath->arg("setID"); 476 my $problemNumber = $r->urlpath->arg("problemID"); 477 my $userName = $r->param('user'); 478 my $effectiveUserName = $r->param('effectiveUser'); 479 my $key = $r->param('key'); 480 my $editMode = $r->param("editMode"); 481 482 my $user = $db->getUser($userName); # checked 483 die "record for user $userName (real user) does not exist." 484 unless defined $user; 485 486 my $effectiveUser = $db->getUser($effectiveUserName); # checked 487 die "record for user $effectiveUserName (effective user) does not exist." 488 unless defined $effectiveUser; 489 490 # obtain the merged set for $effectiveUser 491 my $set = $db->getMergedSet($effectiveUserName, $setName); # checked 492 493 $self->set_showOldAnswers_default($ce, $userName, $authz, $set); 494 495 # Database fix (in case of undefined visiblity state values) 496 # this is only necessary because some people keep holding to ww1.9 which did not have a visible field 497 # make sure visible is set to 0 or 1 498 if ( $set and $set->visible ne "0" and $set->visible ne "1") { 499 my $globalSet = $db->getGlobalSet($set->set_id); 500 $globalSet->visible("1"); # defaults to visible 501 $db->putGlobalSet($globalSet); 502 $set = $db->getMergedSet($effectiveUserName, $setName); 503 } else { 504 # don't do anything just yet, maybe we're a professor and we're 505 # fabricating a set or haven't assigned it to ourselves just yet 506 } 507 # When a set is created enable_reduced_scoring is null, so we have to set it 508 if ( $set and $set->enable_reduced_scoring ne "0" and $set->enable_reduced_scoring ne "1") { 509 my $globalSet = $db->getGlobalSet($set->set_id); 510 $globalSet->enable_reduced_scoring("0"); # defaults to disabled 511 $db->putGlobalSet($globalSet); 512 $set = $db->getMergedSet($effectiveUserName, $setName); 513 } 514 515 516 # obtain the merged problem for $effectiveUser 517 my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked 518 519 if ($authz->hasPermissions($userName, "modify_problem_sets")) { 520 # professors are allowed to fabricate sets and problems not 521 # assigned to them (or anyone). this allows them to use the 522 # editor to 523 524 # if a User Set does not exist for this user and this set 525 # then we check the Global Set 526 # if that does not exist we create a fake set 527 # if it does, we add fake user data 528 unless (defined $set) { 529 my $userSetClass = $db->{set_user}->{record}; 530 my $globalSet = $db->getGlobalSet($setName); # checked 531 532 if (not defined $globalSet) { 533 $set = fake_set($db); 534 } else { 535 $set = global2user($userSetClass, $globalSet); 536 $set->psvn(0); 537 } 538 } 539 540 # if that is not yet defined obtain the global problem, 541 # convert it to a user problem, and add fake user data 542 unless (defined $problem) { 543 my $userProblemClass = $db->{problem_user}->{record}; 544 my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked 545 # if the global problem doesn't exist either, bail! 546 if(not defined $globalProblem) { 547 my $sourceFilePath = $r->param("sourceFilePath"); 548 die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir 549 # These are problems from setmaker. If declared invalid, they won't come up 550 $self->{invalidProblem} = $self->{invalidSet} = 1 unless defined $sourceFilePath; 551 # die "Problem $problemNumber in set $setName does not exist" unless defined $sourceFilePath; 552 $problem = fake_problem($db); 553 $problem->problem_id(1); 554 $problem->source_file($sourceFilePath); 555 $problem->user_id($effectiveUserName); 556 } else { 557 $problem = global2user($userProblemClass, $globalProblem); 558 $problem->user_id($effectiveUserName); 559 $problem->problem_seed(0); 560 $problem->status(0); 561 $problem->attempted(0); 562 $problem->last_answer(""); 563 $problem->num_correct(0); 564 $problem->num_incorrect(0); 565 } 566 } 567 568 # now we're sure we have valid UserSet and UserProblem objects 569 # yay! 570 571 # now deal with possible editor overrides: 572 573 # if the caller is asking to override the source file, and 574 # editMode calls for a temporary file, do so 575 my $sourceFilePath = $r->param("sourceFilePath"); 576 if (defined $editMode and $editMode eq "temporaryFile" and defined $sourceFilePath) { 577 die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir 578 $problem->source_file($sourceFilePath); 579 } 580 581 # if the problem does not have a source file or no source file has been passed in 582 # then this is really an invalid problem (probably from a bad URL) 583 $self->{invalidProblem} = not (defined $sourceFilePath or $problem->source_file); 584 585 # if the caller is asking to override the problem seed, do so 586 my $problemSeed = $r->param("problemSeed"); 587 if (defined $problemSeed) { 588 $problem->problem_seed($problemSeed); 589 } 590 591 my $visiblityStateClass = ($set->visible) ? "visible" : "hidden"; 592 my $visiblityStateText = ($set->visible) ? "visible to students." : "hidden from students."; 593 $self->addmessage(CGI::span("This set is " . CGI::font({class=>$visiblityStateClass}, $visiblityStateText))); 594 595 # test for additional problem validity if it's not already invalid 596 } else { 597 $self->{invalidProblem} = !(defined $problem and ($set->visible || $authz->hasPermissions($userName, "view_hidden_sets"))); 598 599 $self->addbadmessage(CGI::p("This problem will not count towards your grade.")) if $problem and not $problem->value and not $self->{invalidProblem}; 600 } 601 602 $self->{userName} = $userName; 603 $self->{effectiveUserName} = $effectiveUserName; 604 $self->{user} = $user; 605 $self->{effectiveUser} = $effectiveUser; 606 $self->{set} = $set; 607 $self->{problem} = $problem; 608 $self->{editMode} = $editMode; 609 610 ##### form processing ##### 611 612 # set options from form fields (see comment at top of file for names) 613 my $displayMode = $r->param("displayMode") || $ce->{pg}->{options}->{displayMode}; 614 my $redisplay = $r->param("redisplay"); 615 my $submitAnswers = $r->param("submitAnswers"); 616 my $checkAnswers = $r->param("checkAnswers"); 617 my $previewAnswers = $r->param("previewAnswers"); 618 619 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 620 621 $self->{displayMode} = $displayMode; 622 $self->{redisplay} = $redisplay; 623 $self->{submitAnswers} = $submitAnswers; 624 $self->{checkAnswers} = $checkAnswers; 625 $self->{previewAnswers} = $previewAnswers; 626 $self->{formFields} = $formFields; 627 628 # get result and send to message 629 my $status_message = $r->param("status_message"); 630 $self->addmessage(CGI::p("$status_message")) if $status_message; 631 632 # now that we've set all the necessary variables quit out if the set or problem is invalid 633 return if $self->{invalidSet} || $self->{invalidProblem}; 634 635 ##### permissions ##### 636 637 # what does the user want to do? 638 #FIXME There is a problem with checkboxes -- if they are not checked they are invisible. Hence if the default mode in $ce is 1 639 # there is no way to override this. Probably this is ok for the last three options, but it was definitely not ok for showing 640 # saved answers which is normally on, but you want to be able to turn it off! This section should be moved to ContentGenerator 641 # so that you can set these options anywhere. We also need mechanisms for making them sticky. 642 # Note: ProblemSet and ProblemSets might set showOldAnswers to '', which 643 # needs to be treated as if it is not set. 644 my %want = ( 645 showOldAnswers => (defined($r->param("showOldAnswers")) and $r->param("showOldAnswers") ne '') ? $r->param("showOldAnswers") : $ce->{pg}->{options}->{showOldAnswers}, 646 showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers}, 647 showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints}, 648 showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions}, 649 recordAnswers => $submitAnswers, 650 checkAnswers => $checkAnswers, 651 getSubmitButton => 1, 652 ); 653 654 # are certain options enforced? 655 my %must = ( 656 showOldAnswers => 0, 657 showCorrectAnswers => 0, 658 showHints => 0, 659 showSolutions => 0, 660 recordAnswers => ! $authz->hasPermissions($userName, "avoid_recording_answers"), 661 checkAnswers => 0, 662 getSubmitButton => 0, 663 ); 664 665 # does the user have permission to use certain options? 666 my @args = ($user, $effectiveUser, $set, $problem); 667 my %can = ( 668 showOldAnswers => $self->can_showOldAnswers(@args), 669 showCorrectAnswers => $self->can_showCorrectAnswers(@args), 670 showHints => $self->can_showHints(@args), 671 showSolutions => $self->can_showSolutions(@args), 672 recordAnswers => $self->can_recordAnswers(@args, 0), 673 checkAnswers => $self->can_checkAnswers(@args, $submitAnswers), 674 getSubmitButton => $self->can_recordAnswers(@args, $submitAnswers), 675 ); 676 677 # final values for options 678 my %will; 679 foreach (keys %must) { 680 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 681 #warn "final values for options $_ is can $can{$_}, want $want{$_}, must $must{$_}, will $will{$_}"; 682 } 683 684 ##### sticky answers ##### 685 686 if (not ($submitAnswers or $previewAnswers or $checkAnswers) and $will{showOldAnswers}) { 687 # do this only if new answers are NOT being submitted 688 my %oldAnswers = decodeAnswers($problem->last_answer); 689 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; 690 } 691 692 ##### translation ##### 693 694 debug("begin pg processing"); 695 my $pg = WeBWorK::PG->new( 696 $ce, 697 $effectiveUser, 698 $key, 699 $set, 700 $problem, 701 $set->psvn, # FIXME: this field should be removed 702 $formFields, 703 { # translation options 704 displayMode => $displayMode, 705 showHints => $will{showHints}, 706 showSolutions => $will{showSolutions}, 707 refreshMath2img => $will{showHints} || $will{showSolutions}, 708 processAnswers => 1, 709 permissionLevel => $db->getPermissionLevel($userName)->permission, 710 effectivePermissionLevel => $db->getPermissionLevel($effectiveUserName)->permission, 711 }, 712 ); 713 714 debug("end pg processing"); 715 716 ##### fix hint/solution options ##### 717 718 $can{showHints} &&= $pg->{flags}->{hintExists} 719 &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; 720 $can{showSolutions} &&= $pg->{flags}->{solutionExists}; 721 722 ##### store fields ##### 723 724 $self->{want} = \%want; 725 $self->{must} = \%must; 726 $self->{can} = \%can; 727 $self->{will} = \%will; 728 $self->{pg} = $pg; 729 } 730 731 sub if_errors($$) { 732 my ($self, $arg) = @_; 733 734 if ($self->{isOpen}) { 735 return $self->{pg}->{flags}->{error_flag} ? $arg : !$arg; 736 } else { 737 return !$arg; 738 } 739 } 740 741 sub head { 742 my ($self) = @_; 743 744 return "" if ( $self->{invalidSet} ); 745 return $self->{pg}->{head_text} if $self->{pg}->{head_text}; 746 } 747 748 sub options { 749 my ($self) = @_; 750 #warn "doing options in Problem"; 751 752 # don't show options if we don't have anything to show 753 return "" if $self->{invalidSet} or $self->{invalidProblem}; 754 755 my $displayMode = $self->{displayMode}; 756 my %can = %{ $self->{can} }; 757 758 my @options_to_show = "displayMode"; 759 push @options_to_show, "showOldAnswers" if $can{showOldAnswers}; 760 push @options_to_show, "showHints" if $can{showHints}; 761 push @options_to_show, "showSolutions" if $can{showSolutions}; 762 763 return $self->optionsMacro( 764 options_to_show => \@options_to_show, 765 extra_params => ["editMode", "sourceFilePath"], 766 ); 767 } 768 769 sub siblings { 770 my ($self) = @_; 771 my $r = $self->r; 772 my $db = $r->db; 773 my $urlpath = $r->urlpath; 774 775 # can't show sibling problems if the set is invalid 776 return "" if $self->{invalidSet}; 777 778 my $courseID = $urlpath->arg("courseID"); 779 my $setID = $self->{set}->set_id; 780 my $eUserID = $r->param("effectiveUser"); 781 my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID); 782 783 print CGI::start_div({class=>"info-box", id=>"fisheye"}); 784 print CGI::h2("Problems"); 785 #print CGI::start_ul({class=>"LinksMenu"}); 786 #print CGI::start_li(); 787 #print CGI::span({style=>"font-size:larger"}, "Problems"); 788 print CGI::start_ul(); 789 790 foreach my $problemID (@problemIDs) { 791 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", 792 courseID => $courseID, setID => $setID, problemID => $problemID); 793 print CGI::li(CGI::a( {href=>$self->systemLink($problemPage, 794 params=>{ displayMode => $self->{displayMode}, 795 showOldAnswers => $self->{will}->{showOldAnswers} 796 })}, "Problem $problemID") 797 ); 798 } 799 800 print CGI::end_ul(); 801 #print CGI::end_li(); 802 #print CGI::end_ul(); 803 print CGI::end_div(); 804 805 return ""; 806 } 807 808 sub nav { 809 my ($self, $args) = @_; 810 my $r = $self->r; 811 my $db = $r->db; 812 my $urlpath = $r->urlpath; 813 814 return "" if ( $self->{invalidSet} ); 815 816 my $courseID = $urlpath->arg("courseID"); 817 my $setID = $self->{set}->set_id if !($self->{invalidSet}); 818 my $problemID = $self->{problem}->problem_id if !($self->{invalidProblem}); 819 my $eUserID = $r->param("effectiveUser"); 820 821 my ($prevID, $nextID); 822 823 if (!$self->{invalidProblem}) { 824 my @problemIDs = $db->listUserProblems($eUserID, $setID); 825 foreach my $id (@problemIDs) { 826 $prevID = $id if $id < $problemID 827 and (not defined $prevID or $id > $prevID); 828 $nextID = $id if $id > $problemID 829 and (not defined $nextID or $id < $nextID); 830 } 831 } 832 833 my @links; 834 835 if ($prevID) { 836 my $prevPage = $urlpath->newFromModule(__PACKAGE__, 837 courseID => $courseID, setID => $setID, problemID => $prevID); 838 push @links, "Previous Problem", $r->location . $prevPage->path, "navPrev"; 839 } else { 840 push @links, "Previous Problem", "", "navPrevGrey"; 841 } 842 843 if (defined($setID) && $setID ne 'Undefined_Set') { 844 push @links, "Problem List", $r->location . $urlpath->parent->path, "navProbList"; 845 } else { 846 push @links, "Problem List", "", "navProbListGrey"; 847 } 848 849 if ($nextID) { 850 my $nextPage = $urlpath->newFromModule(__PACKAGE__, 851 courseID => $courseID, setID => $setID, problemID => $nextID); 852 push @links, "Next Problem", $r->location . $nextPage->path, "navNext"; 853 } else { 854 push @links, "Next Problem", "", "navNextGrey"; 855 } 856 857 my $tail = ""; 858 859 $tail .= "&displayMode=".$self->{displayMode} if defined $self->{displayMode}; 860 $tail .= "&showOldAnswers=".$self->{will}->{showOldAnswers} 861 if defined $self->{will}->{showOldAnswers}; 862 return $self->navMacro($args, $tail, @links); 863 } 864 865 sub title { 866 my ($self) = @_; 867 868 # using the url arguments won't break if the set/problem are invalid 869 my $setID = WeBWorK::ContentGenerator::underscore2nbsp($self->r->urlpath->arg("setID")); 870 my $problemID = $self->r->urlpath->arg("problemID"); 871 872 return "$setID: Problem $problemID"; 873 } 874 875 876 # now altered to outsource most output operations to the template, main functions now are simply error checking and answer processing - ghe3 877 sub body { 878 my $self = shift; 879 my $set = $self->{set}; 880 my $problem = $self->{problem}; 881 my $pg = $self->{pg}; 882 883 my $valid = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::check_invalid($self); 884 unless($valid eq "valid"){ 885 return $valid; 886 } 887 888 # my $editorLink = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_editorLink($self); 889 # if($editorLink eq "permission_error"){ 890 # return ""; 891 # } 892 893 ##### answer processing ##### 894 debug("begin answer processing"); 895 # if answers were submitted: 896 my $scoreRecordedMessage = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_and_log_answer($self); 897 debug("end answer processing"); 898 899 ##### javaScripts ############# 900 # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_JS($self); 901 902 ##### output ##### 903 # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_summary($self); 904 905 ########################### 906 # print style sheet for correct and incorrect answers 907 ########################### 908 909 # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_CSS($self); 910 911 ########################### 912 # main form 913 ########################### 914 915 # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_main_form($self,$editorLink); 916 917 # WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_footer($self); 918 919 # debugging stuff 920 if (0) { 921 print 922 CGI::hr(), 923 CGI::h2("debugging information"), 924 CGI::h3("form fields"), 925 ref2string($self->{formFields}), 926 CGI::h3("user object"), 927 ref2string($self->{user}), 928 CGI::h3("set object"), 929 ref2string($set), 930 CGI::h3("problem object"), 931 ref2string($problem), 932 CGI::h3("PG object"), 933 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 934 } 935 debug("leaving body of Problem.pm"); 936 return ""; 937 } 938 939 # output_form_start subroutine 940 941 # prints out the beginning of the main form, and the necessary hidden authentication fields 942 943 sub output_form_start{ 944 my $self = shift; 945 my $r = $self->r; 946 print CGI::start_form(-method=>"POST", -action=> $r->uri,-name=>"problemMainForm", onsubmit=>"submitAction()"); 947 print $self->hidden_authen_fields; 948 return ""; 949 } 950 951 # output_problem_body subroutine 952 953 # prints out the body of the current problem 954 955 sub output_problem_body{ 956 my $self = shift; 957 my $pg = $self->{pg}; 958 959 print "\n"; 960 print CGI::p($pg->{body_text}); 961 return ""; 962 } 963 964 # output_message subroutine 965 966 # prints out a message about the problem 967 968 sub output_message{ 969 my $self = shift; 970 my $pg = $self->{pg}; 971 972 print CGI::p(CGI::b("Note: "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg}; 973 return ""; 974 } 975 976 # output_editorLink subroutine 977 978 # processes and prints out the correct link to the editor of the current problem 979 980 sub output_editorLink{ 981 982 my $self = shift; 983 984 my $set = $self->{set}; 985 my $problem = $self->{problem}; 986 my $pg = $self->{pg}; 987 988 my $r = $self->r; 989 990 my $authz = $r->authz; 991 my $urlpath = $r->urlpath; 992 my $user = $r->param('user'); 993 994 my $courseName = $urlpath->arg("courseID"); 995 996 # FIXME: move editor link to top, next to problem number. 997 # format as "[edit]" like we're doing with course info file, etc. 998 # add edit link for set as well. 999 my $editorLink = ""; 1000 # if we are here without a real homework set, carry that through 1001 my $forced_field = []; 1002 $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if 1003 ($set->set_id eq 'Undefined_Set'); 1004 if ($authz->hasPermissions($user, "modify_problem_sets")) { 1005 my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", 1006 courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id); 1007 my $editorURL = $self->systemLink($editorPage, params=>$forced_field); 1008 $editorLink = CGI::p(CGI::a({href=>$editorURL,target =>'WW_Editor'}, "Edit this problem")); 1009 } 1010 1011 ##### translation errors? ##### 1012 1013 if ($pg->{flags}->{error_flag}) { 1014 if ($authz->hasPermissions($user, "view_problem_debugging_info")) { 1015 print $self->errorOutput($pg->{errors}, $pg->{body_text}); 1016 } else { 1017 print $self->errorOutput($pg->{errors}, "You do not have permission to view the details of this error."); 1018 } 1019 print ""; 1020 } 1021 else{ 1022 print $editorLink; 1023 } 1024 return ""; 1025 } 1026 1027 # output_checkboxes subroutine 1028 1029 # prints out the checkbox input elements that are available for the current problem 1030 1031 sub output_checkboxes{ 1032 my $self = shift; 1033 my %can = %{ $self->{can} }; 1034 my %will = %{ $self->{will} }; 1035 1036 if ($can{showCorrectAnswers}) { 1037 print WeBWorK::CGI_labeled_input( 1038 -type => "checkbox", 1039 -id => "showCorrectAnswers_id", 1040 -label_text => "Show correct answers", 1041 -input_attr => $will{showCorrectAnswers} ? 1042 { 1043 -name => "showCorrectAnswers", 1044 -checked => "checked", 1045 -value => 1, 1046 } 1047 : 1048 { 1049 -name => "showCorrectAnswers", 1050 -value => 1, 1051 } 1052 ); 1053 } 1054 if ($can{showHints}) { 1055 print CGI::div({style=>"color:red"}, 1056 WeBWorK::CGI_labeled_input( 1057 -type => "checkbox", 1058 -id => "showHints_id", 1059 -label_text => "Show Hints", 1060 -input_attr => $will{showHints} ? 1061 { 1062 -name => "showHints", 1063 -checked => "checked", 1064 -value => 1, 1065 } 1066 : 1067 { 1068 -name => "showCorrectAnswers", 1069 -value => 1, 1070 } 1071 ) 1072 ); 1073 } 1074 if ($can{showSolutions}) { 1075 print WeBWorK::CGI_labeled_input( 1076 -type => "checkbox", 1077 -id => "showSolutions_id", 1078 -label_text => "Show Solutions", 1079 -input_attr => $will{showSolutions} ? 1080 { 1081 -name => "showSolutions", 1082 -checked => "checked", 1083 -value => 1, 1084 } 1085 : 1086 { 1087 -name => "showCorrectAnswers", 1088 -value => 1, 1089 } 1090 ); 1091 } 1092 1093 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) { 1094 print CGI::br(); 1095 } 1096 1097 return ""; 1098 } 1099 1100 # output_submit_buttons 1101 1102 # prints out the submit button input elements that are available for the current problem 1103 1104 sub output_submit_buttons{ 1105 my $self = shift; 1106 my $r = $self->r; 1107 my %can = %{ $self->{can} }; 1108 1109 my $user = $r->param('user'); 1110 my $effectiveUser = $r->param('effectiveUser'); 1111 1112 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"previewAnswers_id", -input_attr=>{-name=>"previewAnswers", -value=>"Preview Answers"}); 1113 if ($can{checkAnswers}) { 1114 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"checkAnswers_id", -input_attr=>{-name=>"checkAnswers", -value=>"Check Answers"}); 1115 } 1116 if ($can{getSubmitButton}) { 1117 if ($user ne $effectiveUser) { 1118 # if acting as a student, make it clear that answer submissions will 1119 # apply to the student's records, not the professor's. 1120 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"submitAnswers_id", -input_attr=>{-name=>"submitAnswers", -value=>"Submit Answers for $effectiveUser"}); 1121 } else { 1122 #print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>"alert('submit button clicked')"); 1123 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"submitAnswers_id", -input_attr=>{-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>""}); 1124 # FIXME for unknown reasons the -onclick label seems to have to be there in order to allow the forms onsubmit to trigger 1125 # WFT??? 1126 } 1127 } 1128 1129 return ""; 1130 } 1131 1132 # output_score_summary subroutine 1133 1134 # prints out a summary of the student's current progress and status on the current problem 1135 1136 sub output_score_summary{ 1137 my $self = shift; 1138 my $problem = $self->{problem}; 1139 my $set = $self->{set}; 1140 my $pg = $self->{pg}; 1141 my $scoreRecordedMessage = ""; 1142 unless(defined $self->{scoreRecordedMessage}){ 1143 $scoreRecordedMessage = $self->{scoreRecordedMessage}; 1144 } 1145 my $submitAnswers = $self->{submitAnswers}; 1146 1147 # score summary 1148 my $attempts = $problem->num_correct + $problem->num_incorrect; 1149 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 1150 my $problem_status = $problem->status || 0; 1151 my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number 1152 my ($attemptsLeft, $attemptsLeftNoun); 1153 if ($problem->max_attempts == -1) { 1154 # unlimited attempts 1155 $attemptsLeft = "unlimited"; 1156 $attemptsLeftNoun = "attempts"; 1157 } else { 1158 $attemptsLeft = $problem->max_attempts - $attempts; 1159 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 1160 } 1161 1162 my $setClosed = 0; 1163 my $setClosedMessage; 1164 if (before($set->open_date) or after($set->due_date)) { 1165 $setClosed = 1; 1166 if (before($set->open_date)) { 1167 $setClosedMessage = "This homework set is not yet open."; 1168 } elsif (after($set->due_date)) { 1169 $setClosedMessage = "This homework set is closed."; 1170 } 1171 } 1172 #if (before($set->open_date) or after($set->due_date)) { 1173 # $setClosed = 1; 1174 # $setClosedMessage = "This homework set is closed."; 1175 # if ($authz->hasPermissions($user, "view_answers")) { 1176 # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; 1177 # } else { 1178 # $setClosedMessage .= " Additional attempts will not be recorded."; 1179 # } 1180 #} 1181 unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) { 1182 my $notCountedMessage = ($problem->value) ? "" : "(This problem will not count towards your grade.)"; 1183 print CGI::p(join("", 1184 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", 1185 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), 1186 $submitAnswers ?"You received a score of ".sprintf("%.0f%%", $pg->{result}->{score} * 100)." for this attempt.".CGI::br():'', 1187 $problem->attempted 1188 ? "Your overall recorded score is $lastScore. $notCountedMessage" . CGI::br() 1189 : "", 1190 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." 1191 )); 1192 }else { 1193 print CGI::p($pg->{state}->{state_summary_msg}); 1194 } 1195 1196 return ""; 1197 } 1198 1199 # output_misc subroutine 1200 1201 # prints out other necessary elements 1202 1203 sub output_misc{ 1204 1205 my $self = shift; 1206 my $r = $self->r; 1207 my $ce = $r->ce; 1208 my $db = $r->db; 1209 my $pg = $self->{pg}; 1210 my %will = %{ $self->{will} }; 1211 my $user = $r->param('user'); 1212 1213 print CGI::start_div(); 1214 1215 my $pgdebug = join(CGI::br(), @{$pg->{pgcore}->{flags}->{DEBUG_messages}} ); 1216 my $pgwarning = join(CGI::br(), @{$pg->{pgcore}->{flags}->{WARNING_messages}} ); 1217 my $pginternalerrors = join(CGI::br(), @{$pg->{pgcore}->get_internal_debug_messages} ); 1218 my $pgerrordiv = $pgdebug||$pgwarning||$pginternalerrors; # is 1 if any of these are non-empty 1219 1220 print CGI::p({style=>"color:red;"}, "Checking additional error messages") if $pgerrordiv ; 1221 print CGI::p("pg debug<br/> $pgdebug" ) if $pgdebug ; 1222 print CGI::p("pg warning<br/>$pgwarning" ) if $pgwarning ; 1223 print CGI::p("pg internal errors<br/> $pginternalerrors") if $pginternalerrors; 1224 print CGI::end_div() if $pgerrordiv ; 1225 1226 # save state for viewOptions 1227 print CGI::hidden( 1228 -name => "showOldAnswers", 1229 -value => $will{showOldAnswers} 1230 ), 1231 1232 CGI::hidden( 1233 -name => "displayMode", 1234 -value => $self->{displayMode} 1235 ); 1236 print( CGI::hidden( 1237 -name => 'editMode', 1238 -value => $self->{editMode}, 1239 ) 1240 ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile'; 1241 1242 # this is a security risk -- students can use this to find the source code for the problem 1243 1244 my $permissionLevel = $db->getPermissionLevel($user)->permission; 1245 my $professorPermissionLevel = $ce->{userRoles}->{professor}; 1246 print( CGI::hidden( 1247 -name => 'sourceFilePath', 1248 -value => $self->{problem}->{source_file} 1249 )) if defined($self->{problem}->{source_file}) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1250 1251 print( CGI::hidden( 1252 -name => 'problemSeed', 1253 -value => $r->param("problemSeed") 1254 )) if defined($r->param("problemSeed")) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1255 1256 return ""; 1257 } 1258 1259 # output_summary subroutine 1260 1261 # prints out the summary of the questions that the student has answered for the current problem, along with available information about correctness 1262 1263 sub output_summary{ 1264 1265 my $self = shift; 1266 1267 my $editMode = $self->{editMode}; 1268 my $problem = $self->{problem}; 1269 my $pg = $self->{pg}; 1270 my $submitAnswers = $self->{submitAnswers}; 1271 my %will = %{ $self->{will} }; 1272 my $checkAnswers = $self->{checkAnswers}; 1273 my $previewAnswers = $self->{previewAnswers}; 1274 1275 my $r = $self->r; 1276 1277 my $authz = $r->authz; 1278 my $user = $r->param('user'); 1279 1280 # attempt summary 1281 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. 1282 # until after the due date 1283 # do I need to check $will{showCorrectAnswers} to make preflight work?? 1284 if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) { 1285 # print this if user submitted answers OR requested correct answers 1286 1287 print $self->attemptResults($pg, 1, 1288 $will{showCorrectAnswers}, 1289 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); 1290 } elsif ($checkAnswers) { 1291 # print this if user previewed answers 1292 print CGI::div({class=>'ResultsWithError'},"ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED"), CGI::br(); 1293 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); 1294 # show attempt answers 1295 # show correct answers if asked 1296 # show attempt results (correctness) 1297 # show attempt previews 1298 } elsif ($previewAnswers) { 1299 # print this if user previewed answers 1300 print CGI::div({class=>'ResultsWithError'},"PREVIEW ONLY -- ANSWERS NOT RECORDED"),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); 1301 # show attempt answers 1302 # don't show correct answers 1303 # don't show attempt results (correctness) 1304 # show attempt previews 1305 } 1306 1307 return ""; 1308 } 1309 1310 # output_custom_edit_message 1311 1312 # prints out a custom edit message 1313 1314 sub output_custom_edit_message{ 1315 my $self = shift; 1316 my $r = $self->r; 1317 my $authz = $r->authz; 1318 my $user = $r->param('user'); 1319 my $editMode = $self->{editMode}; 1320 my $problem = $self->{problem}; 1321 1322 # custom message for editor 1323 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) { 1324 if ($editMode eq "temporaryFile") { 1325 print CGI::p(CGI::div({class=>'temporaryFile'}, "Viewing temporary file: ", $problem->source_file)); 1326 } elsif ($editMode eq "savedFile") { 1327 # taken care of in the initialization phase 1328 } 1329 } 1330 1331 return ""; 1332 } 1333 1334 # output_JS subroutine 1335 1336 # prints out the wz_tooltip.js script for the current site. 1337 1338 sub output_wztooltip_JS{ 1339 1340 my $self = shift; 1341 my $r = $self->r; 1342 my $ce = $r->ce; 1343 1344 my $site_url = $ce->{webworkURLs}->{htdocs}; 1345 1346 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/wz_tooltip.js"}), CGI::end_script(); 1347 return ""; 1348 } 1349 1350 # output_CSS subroutine 1351 1352 # 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). 1353 1354 sub output_CSS{ 1355 1356 my $self = shift; 1357 my $r = $self->r; 1358 my $ce = $r->ce; 1359 my $pg = $self->{pg}; 1360 1361 # always show colors for checkAnswers 1362 # show colors for submit answer if 1363 if (($self->{checkAnswers}) or ($self->{submitAnswers} and $pg->{flags}->{showPartialCorrectAnswers}) ) { 1364 print CGI::start_style({type=>"text/css"}); 1365 print '#'.join(', #', @{ $self->{correct_ids} }), $ce->{pg}{options}{correct_answer} if ref( $self->{correct_ids} )=~/ARRAY/; #correct green 1366 print '#'.join(', #', @{ $self->{incorrect_ids} }), $ce->{pg}{options}{incorrect_answer} if ref( $self->{incorrect_ids})=~/ARRAY/; #incorrect reddish 1367 print CGI::end_style(); 1368 } 1369 1370 return ""; 1371 } 1372 1373 # output_past_answer_button 1374 1375 # prints out the "Show Past Answers" button 1376 1377 sub output_past_answer_button{ 1378 my $self = shift; 1379 my $r = $self->r; 1380 my $problem = $self->{problem}; 1381 1382 my $authz = $r->authz; 1383 my $urlpath = $r->urlpath; 1384 my $user = $r->param('user'); 1385 1386 my $courseName = $urlpath->arg("courseID"); 1387 1388 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", 1389 courseID => $courseName); 1390 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action 1391 1392 # print answer inspection button 1393 if ($authz->hasPermissions($user, "view_answers")) { 1394 print "\n", 1395 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n", 1396 $self->hidden_authen_fields,"\n", 1397 CGI::hidden(-name => 'courseID', -value=>$courseName), "\n", 1398 CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n", 1399 CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n", 1400 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", 1401 CGI::p( {-align=>"left"}, 1402 CGI::submit(-name => 'action', -value=>'Show Past Answers') 1403 ), "\n", 1404 CGI::endform(); 1405 } 1406 1407 return ""; 1408 } 1409 1410 # output_email_instructor subroutine 1411 1412 # prints out the "Email Instructor" button 1413 1414 sub output_email_instructor{ 1415 my $self = shift; 1416 my $problem = $self->{problem}; 1417 my %will = %{ $self->{will} }; 1418 my $pg = $self->{pg}; 1419 1420 print $self->feedbackMacro( 1421 module => __PACKAGE__, 1422 set => $self->{set}->set_id, 1423 problem => $problem->problem_id, 1424 displayMode => $self->{displayMode}, 1425 showOldAnswers => $will{showOldAnswers}, 1426 showCorrectAnswers => $will{showCorrectAnswers}, 1427 showHints => $will{showHints}, 1428 showSolutions => $will{showSolutions}, 1429 pg_object => $pg, 1430 ); 1431 1432 return ""; 1433 } 1434 1435 # output_hidden_info subroutine 1436 1437 # outputs the hidden fields required for the form 1438 1439 sub output_hidden_info{ 1440 my $self = shift; 1441 1442 if(defined $self->{correct_ids}){ 1443 my $correctRef = $self->{correct_ids}; 1444 my @correct = @$correctRef; 1445 foreach(@correct){ 1446 print CGI::hidden(-name=>"correct_ids", -value=>$_."_val"); 1447 } 1448 } 1449 if(defined $self->{incorrect_ids}){ 1450 my $incorrectRef = $self->{incorrect_ids}; 1451 my @incorrect = @$incorrectRef; 1452 foreach(@incorrect){ 1453 print CGI::hidden(-name=>"incorrect_ids", -value=>$_."_val"); 1454 } 1455 } 1456 1457 return ""; 1458 } 1459 1460 # output_JS subroutine 1461 1462 # outputs all of the Javascript needed for this page. 1463 1464 sub output_JS{ 1465 my $self = shift; 1466 my $r = $self->r; 1467 my $ce = $r->ce; 1468 1469 my $site_url = $ce->{webworkURLs}->{htdocs}; 1470 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/color.js"}), CGI::end_script(); 1471 return ""; 1472 } 1473 1474 # Simply here to indicate to the template that this page has body part methods which can be called 1475 1476 sub can_body_parts{ 1477 return ""; 1478 } 1479 1480 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |