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); # 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 # A very hacky and temporary solution to the max_attempts problem 527 # if($problem->max_attempts == ""){ 528 # $problem->max_attempts = -1; 529 # } 530 531 if ($authz->hasPermissions($userName, "modify_problem_sets")) { 532 # professors are allowed to fabricate sets and problems not 533 # assigned to them (or anyone). this allows them to use the 534 # editor to 535 536 # if a User Set does not exist for this user and this set 537 # then we check the Global Set 538 # if that does not exist we create a fake set 539 # if it does, we add fake user data 540 unless (defined $set) { 541 my $userSetClass = $db->{set_user}->{record}; 542 my $globalSet = $db->getGlobalSet($setName); # checked 543 544 if (not defined $globalSet) { 545 $set = fake_set($db); 546 } else { 547 $set = global2user($userSetClass, $globalSet); 548 $set->psvn(0); 549 } 550 } 551 552 # if that is not yet defined obtain the global problem, 553 # convert it to a user problem, and add fake user data 554 unless (defined $problem) { 555 my $userProblemClass = $db->{problem_user}->{record}; 556 my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked 557 # if the global problem doesn't exist either, bail! 558 if(not defined $globalProblem) { 559 my $sourceFilePath = $r->param("sourceFilePath"); 560 die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir 561 # These are problems from setmaker. If declared invalid, they won't come up 562 $self->{invalidProblem} = $self->{invalidSet} = 1 unless defined $sourceFilePath; 563 # die "Problem $problemNumber in set $setName does not exist" unless defined $sourceFilePath; 564 $problem = fake_problem($db); 565 $problem->problem_id(1); 566 $problem->source_file($sourceFilePath); 567 $problem->user_id($effectiveUserName); 568 } else { 569 $problem = global2user($userProblemClass, $globalProblem); 570 $problem->user_id($effectiveUserName); 571 $problem->problem_seed(0); 572 $problem->status(0); 573 $problem->attempted(0); 574 $problem->last_answer(""); 575 $problem->num_correct(0); 576 $problem->num_incorrect(0); 577 } 578 } 579 580 # now we're sure we have valid UserSet and UserProblem objects 581 # yay! 582 583 # now deal with possible editor overrides: 584 585 # if the caller is asking to override the source file, and 586 # editMode calls for a temporary file, do so 587 my $sourceFilePath = $r->param("sourceFilePath"); 588 if (defined $editMode and $editMode eq "temporaryFile" and defined $sourceFilePath) { 589 die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir 590 $problem->source_file($sourceFilePath); 591 } 592 593 # if the problem does not have a source file or no source file has been passed in 594 # then this is really an invalid problem (probably from a bad URL) 595 $self->{invalidProblem} = not (defined $sourceFilePath or $problem->source_file); 596 597 # if the caller is asking to override the problem seed, do so 598 my $problemSeed = $r->param("problemSeed"); 599 if (defined $problemSeed) { 600 $problem->problem_seed($problemSeed); 601 } 602 603 my $visiblityStateClass = ($set->visible) ? $r->maketext("visible") : $r->maketext("hidden"); 604 my $visiblityStateText = ($set->visible) ? $r->maketext("visible to students")."." : $r->maketext("hidden from students")."."; 605 $self->addmessage(CGI::span($r->maketext("This set is [_1]", CGI::font({class=>$visiblityStateClass}, $visiblityStateText)))); 606 607 # test for additional problem validity if it's not already invalid 608 } else { 609 $self->{invalidProblem} = !(defined $problem and ($set->visible || $authz->hasPermissions($userName, "view_hidden_sets"))); 610 611 $self->addbadmessage(CGI::p($r->maketext("This problem will not count towards your grade."))) if $problem and not $problem->value and not $self->{invalidProblem}; 612 } 613 614 $self->{userName} = $userName; 615 $self->{effectiveUserName} = $effectiveUserName; 616 $self->{user} = $user; 617 $self->{effectiveUser} = $effectiveUser; 618 $self->{set} = $set; 619 $self->{problem} = $problem; 620 $self->{editMode} = $editMode; 621 622 ##### form processing ##### 623 624 # set options from form fields (see comment at top of file for names) 625 my $displayMode = $r->param("displayMode") || $ce->{pg}->{options}->{displayMode}; 626 my $redisplay = $r->param("redisplay"); 627 my $submitAnswers = $r->param("submitAnswers"); 628 my $checkAnswers = $r->param("checkAnswers"); 629 my $previewAnswers = $r->param("previewAnswers"); 630 631 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 632 633 $self->{displayMode} = $displayMode; 634 $self->{redisplay} = $redisplay; 635 $self->{submitAnswers} = $submitAnswers; 636 $self->{checkAnswers} = $checkAnswers; 637 $self->{previewAnswers} = $previewAnswers; 638 $self->{formFields} = $formFields; 639 640 # get result and send to message 641 my $status_message = $r->param("status_message"); 642 $self->addmessage(CGI::p("$status_message")) if $status_message; 643 644 # now that we've set all the necessary variables quit out if the set or problem is invalid 645 return if $self->{invalidSet} || $self->{invalidProblem}; 646 647 ##### permissions ##### 648 649 # what does the user want to do? 650 #FIXME There is a problem with checkboxes -- if they are not checked they are invisible. Hence if the default mode in $ce is 1 651 # there is no way to override this. Probably this is ok for the last three options, but it was definitely not ok for showing 652 # saved answers which is normally on, but you want to be able to turn it off! This section should be moved to ContentGenerator 653 # so that you can set these options anywhere. We also need mechanisms for making them sticky. 654 # Note: ProblemSet and ProblemSets might set showOldAnswers to '', which 655 # needs to be treated as if it is not set. 656 my %want = ( 657 showOldAnswers => (defined($r->param("showOldAnswers")) and $r->param("showOldAnswers") ne '') ? $r->param("showOldAnswers") : $ce->{pg}->{options}->{showOldAnswers}, 658 showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers}, 659 showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints}, 660 showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions}, 661 recordAnswers => $submitAnswers, 662 checkAnswers => $checkAnswers, 663 getSubmitButton => 1, 664 ); 665 666 # are certain options enforced? 667 my %must = ( 668 showOldAnswers => 0, 669 showCorrectAnswers => 0, 670 showHints => 0, 671 showSolutions => 0, 672 recordAnswers => ! $authz->hasPermissions($userName, "avoid_recording_answers"), 673 checkAnswers => 0, 674 getSubmitButton => 0, 675 ); 676 677 # does the user have permission to use certain options? 678 my @args = ($user, $effectiveUser, $set, $problem); 679 my %can = ( 680 showOldAnswers => $self->can_showOldAnswers(@args), 681 showCorrectAnswers => $self->can_showCorrectAnswers(@args), 682 showHints => $self->can_showHints(@args), 683 showSolutions => $self->can_showSolutions(@args), 684 recordAnswers => $self->can_recordAnswers(@args, 0), 685 checkAnswers => $self->can_checkAnswers(@args, $submitAnswers), 686 getSubmitButton => $self->can_recordAnswers(@args, $submitAnswers), 687 ); 688 689 # final values for options 690 my %will; 691 foreach (keys %must) { 692 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 693 #warn "final values for options $_ is can $can{$_}, want $want{$_}, must $must{$_}, will $will{$_}"; 694 } 695 696 ##### sticky answers ##### 697 698 if (not ($submitAnswers or $previewAnswers or $checkAnswers) and $will{showOldAnswers}) { 699 # do this only if new answers are NOT being submitted 700 my %oldAnswers = decodeAnswers($problem->last_answer); 701 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; 702 } 703 704 ##### translation ##### 705 706 debug("begin pg processing"); 707 my $pg = WeBWorK::PG->new( 708 $ce, 709 $effectiveUser, 710 $key, 711 $set, 712 $problem, 713 $set->psvn, # FIXME: this field should be removed 714 $formFields, 715 { # translation options 716 displayMode => $displayMode, 717 showHints => $will{showHints}, 718 showSolutions => $will{showSolutions}, 719 refreshMath2img => $will{showHints} || $will{showSolutions}, 720 processAnswers => 1, 721 permissionLevel => $db->getPermissionLevel($userName)->permission, 722 effectivePermissionLevel => $db->getPermissionLevel($effectiveUserName)->permission, 723 }, 724 ); 725 726 debug("end pg processing"); 727 728 ##### fix hint/solution options ##### 729 730 $can{showHints} &&= $pg->{flags}->{hintExists} 731 &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; 732 $can{showSolutions} &&= $pg->{flags}->{solutionExists}; 733 734 ##### store fields ##### 735 736 $self->{want} = \%want; 737 $self->{must} = \%must; 738 $self->{can} = \%can; 739 $self->{will} = \%will; 740 $self->{pg} = $pg; 741 } 742 743 sub if_errors($$) { 744 my ($self, $arg) = @_; 745 746 if ($self->{isOpen}) { 747 return $self->{pg}->{flags}->{error_flag} ? $arg : !$arg; 748 } else { 749 return !$arg; 750 } 751 } 752 753 sub head { 754 my ($self) = @_; 755 756 return "" if ( $self->{invalidSet} ); 757 return $self->{pg}->{head_text} if $self->{pg}->{head_text}; 758 } 759 760 sub options { 761 my ($self) = @_; 762 #warn "doing options in Problem"; 763 764 # don't show options if we don't have anything to show 765 return "" if $self->{invalidSet} or $self->{invalidProblem}; 766 767 my $displayMode = $self->{displayMode}; 768 my %can = %{ $self->{can} }; 769 770 my @options_to_show = "displayMode"; 771 push @options_to_show, "showOldAnswers" if $can{showOldAnswers}; 772 push @options_to_show, "showHints" if $can{showHints}; 773 push @options_to_show, "showSolutions" if $can{showSolutions}; 774 775 return $self->optionsMacro( 776 options_to_show => \@options_to_show, 777 extra_params => ["editMode", "sourceFilePath"], 778 ); 779 } 780 781 sub siblings { 782 my ($self) = @_; 783 my $r = $self->r; 784 my $db = $r->db; 785 my $urlpath = $r->urlpath; 786 787 # can't show sibling problems if the set is invalid 788 return "" if $self->{invalidSet}; 789 790 my $courseID = $urlpath->arg("courseID"); 791 my $setID = $self->{set}->set_id; 792 my $eUserID = $r->param("effectiveUser"); 793 my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID); 794 795 print CGI::start_div({class=>"info-box", id=>"fisheye"}); 796 print CGI::h2($r->maketext("Problems")); 797 #print CGI::start_ul({class=>"LinksMenu"}); 798 #print CGI::start_li(); 799 #print CGI::span({style=>"font-size:larger"}, "Problems"); 800 print CGI::start_ul(); 801 802 foreach my $problemID (@problemIDs) { 803 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", $r, 804 courseID => $courseID, setID => $setID, problemID => $problemID); 805 print CGI::li(CGI::a( {href=>$self->systemLink($problemPage, 806 params=>{ displayMode => $self->{displayMode}, 807 showOldAnswers => $self->{will}->{showOldAnswers} 808 })}, $r->maketext("Problem [_1]",$problemID)) 809 ); 810 } 811 812 print CGI::end_ul(); 813 #print CGI::end_li(); 814 #print CGI::end_ul(); 815 print CGI::end_div(); 816 817 return ""; 818 } 819 820 sub nav { 821 my ($self, $args) = @_; 822 my $r = $self->r; 823 my $db = $r->db; 824 my $urlpath = $r->urlpath; 825 826 return "" if ( $self->{invalidSet} ); 827 828 my $courseID = $urlpath->arg("courseID"); 829 my $setID = $self->{set}->set_id if !($self->{invalidSet}); 830 my $problemID = $self->{problem}->problem_id if !($self->{invalidProblem}); 831 my $eUserID = $r->param("effectiveUser"); 832 833 my ($prevID, $nextID); 834 835 if (!$self->{invalidProblem}) { 836 my @problemIDs = $db->listUserProblems($eUserID, $setID); 837 foreach my $id (@problemIDs) { 838 $prevID = $id if $id < $problemID 839 and (not defined $prevID or $id > $prevID); 840 $nextID = $id if $id > $problemID 841 and (not defined $nextID or $id < $nextID); 842 } 843 } 844 845 my @links; 846 847 if ($prevID) { 848 my $prevPage = $urlpath->newFromModule(__PACKAGE__, $r, 849 courseID => $courseID, setID => $setID, problemID => $prevID); 850 push @links, $r->maketext("Previous Problem"), $r->location . $prevPage->path, $r->maketext("navPrev"); 851 } else { 852 push @links, $r->maketext("Previous Problem"), "", $r->maketext("navPrevGrey"); 853 } 854 855 if (defined($setID) && $setID ne 'Undefined_Set') { 856 push @links, $r->maketext("Problem List"), $r->location . $urlpath->parent->path, $r->maketext("navProbList"); 857 } else { 858 push @links, $r->maketext("Problem List"), "", $r->maketext("navProbListGrey"); 859 } 860 861 if ($nextID) { 862 my $nextPage = $urlpath->newFromModule(__PACKAGE__, $r, 863 courseID => $courseID, setID => $setID, problemID => $nextID); 864 push @links, $r->maketext("Next Problem"), $r->location . $nextPage->path, $r->maketext("navNext"); 865 } else { 866 push @links, $r->maketext("Next Problem"), "", $r->maketext("navNextGrey"); 867 } 868 869 my $tail = ""; 870 871 $tail .= "&displayMode=".$self->{displayMode} if defined $self->{displayMode}; 872 $tail .= "&showOldAnswers=".$self->{will}->{showOldAnswers} 873 if defined $self->{will}->{showOldAnswers}; 874 return $self->navMacro($args, $tail, @links); 875 } 876 877 sub title { 878 my ($self) = @_; 879 my $r = $self->r; 880 # using the url arguments won't break if the set/problem are invalid 881 my $setID = WeBWorK::ContentGenerator::underscore2nbsp($self->r->urlpath->arg("setID")); 882 my $problemID = $self->r->urlpath->arg("problemID"); 883 884 return $r->maketext("[_1]: Problem [_2]",$setID, $problemID); 885 } 886 887 888 # now altered to outsource most output operations to the template, main functions now are simply error checking and answer processing - ghe3 889 sub body { 890 my $self = shift; 891 my $set = $self->{set}; 892 my $problem = $self->{problem}; 893 my $pg = $self->{pg}; 894 895 my $valid = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::check_invalid($self); 896 unless($valid eq "valid"){ 897 return $valid; 898 } 899 900 ##### answer processing ##### 901 debug("begin answer processing"); 902 # if answers were submitted: 903 my $scoreRecordedMessage = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_and_log_answer($self); 904 debug("end answer processing"); 905 906 # debugging stuff 907 if (0) { 908 print 909 CGI::hr(), 910 CGI::h2("debugging information"), 911 CGI::h3("form fields"), 912 ref2string($self->{formFields}), 913 CGI::h3("user object"), 914 ref2string($self->{user}), 915 CGI::h3("set object"), 916 ref2string($set), 917 CGI::h3("problem object"), 918 ref2string($problem), 919 CGI::h3("PG object"), 920 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 921 } 922 debug("leaving body of Problem.pm"); 923 return ""; 924 } 925 926 # output_form_start subroutine 927 928 # prints out the beginning of the main form, and the necessary hidden authentication fields 929 930 sub output_form_start{ 931 my $self = shift; 932 my $r = $self->r; 933 print CGI::start_form(-method=>"POST", -action=> $r->uri,-name=>"problemMainForm", onsubmit=>"submitAction()"); 934 print $self->hidden_authen_fields; 935 return ""; 936 } 937 938 # output_problem_body subroutine 939 940 # prints out the body of the current problem 941 942 sub output_problem_body{ 943 my $self = shift; 944 my $pg = $self->{pg}; 945 946 print "\n"; 947 print CGI::p($pg->{body_text}); 948 return ""; 949 } 950 951 # output_message subroutine 952 953 # prints out a message about the problem 954 955 sub output_message{ 956 my $self = shift; 957 my $pg = $self->{pg}; 958 my $r = $self->r; 959 960 print CGI::p(CGI::b($r->maketext("Note").": "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg}; 961 return ""; 962 } 963 964 # output_editorLink subroutine 965 966 # processes and prints out the correct link to the editor of the current problem 967 968 sub output_editorLink{ 969 970 my $self = shift; 971 972 my $set = $self->{set}; 973 my $problem = $self->{problem}; 974 my $pg = $self->{pg}; 975 976 my $r = $self->r; 977 978 my $authz = $r->authz; 979 my $urlpath = $r->urlpath; 980 my $user = $r->param('user'); 981 982 my $courseName = $urlpath->arg("courseID"); 983 984 # FIXME: move editor link to top, next to problem number. 985 # format as "[edit]" like we're doing with course info file, etc. 986 # add edit link for set as well. 987 my $editorLink = ""; 988 # if we are here without a real homework set, carry that through 989 my $forced_field = []; 990 $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if 991 ($set->set_id eq 'Undefined_Set'); 992 if ($authz->hasPermissions($user, "modify_problem_sets")) { 993 my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, 994 courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id); 995 my $editorURL = $self->systemLink($editorPage, params=>$forced_field); 996 $editorLink = CGI::p(CGI::a({href=>$editorURL,target =>'WW_Editor'}, $r->maketext("Edit this problem"))); 997 } 998 999 ##### translation errors? ##### 1000 1001 if ($pg->{flags}->{error_flag}) { 1002 if ($authz->hasPermissions($user, "view_problem_debugging_info")) { 1003 print $self->errorOutput($pg->{errors}, $pg->{body_text}); 1004 } else { 1005 print $self->errorOutput($pg->{errors}, $r->maketext($r->maketext("You do not have permission to view the details of this error."))); 1006 } 1007 print ""; 1008 } 1009 else{ 1010 print $editorLink; 1011 } 1012 return ""; 1013 } 1014 1015 # output_checkboxes subroutine 1016 1017 # prints out the checkbox input elements that are available for the current problem 1018 1019 sub output_checkboxes{ 1020 my $self = shift; 1021 my $r = $self->r; 1022 my %can = %{ $self->{can} }; 1023 my %will = %{ $self->{will} }; 1024 1025 if ($can{showCorrectAnswers}) { 1026 print WeBWorK::CGI_labeled_input( 1027 -type => "checkbox", 1028 -id => "showCorrectAnswers_id", 1029 -label_text => $r->maketext("Show correct answers"), 1030 -input_attr => $will{showCorrectAnswers} ? 1031 { 1032 -name => "showCorrectAnswers", 1033 -checked => "checked", 1034 -value => 1, 1035 } 1036 : 1037 { 1038 -name => "showCorrectAnswers", 1039 -value => 1, 1040 } 1041 ); 1042 } 1043 if ($can{showHints}) { 1044 print CGI::div({style=>"color:red"}, 1045 WeBWorK::CGI_labeled_input( 1046 -type => "checkbox", 1047 -id => "showHints_id", 1048 -label_text => $r->maketext("Show Hints"), 1049 -input_attr => $will{showHints} ? 1050 { 1051 -name => "showHints", 1052 -checked => "checked", 1053 -value => 1, 1054 } 1055 : 1056 { 1057 -name => "showCorrectAnswers", 1058 -value => 1, 1059 } 1060 ) 1061 ); 1062 } 1063 if ($can{showSolutions}) { 1064 print WeBWorK::CGI_labeled_input( 1065 -type => "checkbox", 1066 -id => "showSolutions_id", 1067 -label_text => $r->maketext("Show Solutions"), 1068 -input_attr => $will{showSolutions} ? 1069 { 1070 -name => "showSolutions", 1071 -checked => "checked", 1072 -value => 1, 1073 } 1074 : 1075 { 1076 -name => "showCorrectAnswers", 1077 -value => 1, 1078 } 1079 ); 1080 } 1081 1082 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) { 1083 print CGI::br(); 1084 } 1085 1086 return ""; 1087 } 1088 1089 # output_submit_buttons 1090 1091 # prints out the submit button input elements that are available for the current problem 1092 1093 sub output_submit_buttons{ 1094 my $self = shift; 1095 my $r = $self->r; 1096 my %can = %{ $self->{can} }; 1097 1098 my $user = $r->param('user'); 1099 my $effectiveUser = $r->param('effectiveUser'); 1100 1101 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"previewAnswers_id", -input_attr=>{-name=>"previewAnswers", -value=>$r->maketext("Preview Answers")}); 1102 if ($can{checkAnswers}) { 1103 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"checkAnswers_id", -input_attr=>{-name=>"checkAnswers", -value=>$r->maketext("Check Answers")}); 1104 } 1105 if ($can{getSubmitButton}) { 1106 if ($user ne $effectiveUser) { 1107 # if acting as a student, make it clear that answer submissions will 1108 # apply to the student's records, not the professor's. 1109 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"submitAnswers_id", -input_attr=>{-name=>$r->maketext("submitAnswers"), -value=>$r->maketext("Submit Answers for [_1]", $effectiveUser)}); 1110 } else { 1111 #print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>"alert('submit button clicked')"); 1112 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"submitAnswers_id", -input_attr=>{-name=>"submitAnswers", -label=>$r->maketext("Submit Answers"), -onclick=>""}); 1113 # FIXME for unknown reasons the -onclick label seems to have to be there in order to allow the forms onsubmit to trigger 1114 # WTF??? 1115 } 1116 } 1117 1118 return ""; 1119 } 1120 1121 # output_score_summary subroutine 1122 1123 # prints out a summary of the student's current progress and status on the current problem 1124 1125 sub output_score_summary{ 1126 my $self = shift; 1127 my $r = $self->r; 1128 my $problem = $self->{problem}; 1129 my $set = $self->{set}; 1130 my $pg = $self->{pg}; 1131 my $scoreRecordedMessage = ""; 1132 unless(defined $self->{scoreRecordedMessage}){ 1133 $scoreRecordedMessage = $self->{scoreRecordedMessage}; 1134 } 1135 my $submitAnswers = $self->{submitAnswers}; 1136 1137 # score summary 1138 my $attempts = $problem->num_correct + $problem->num_incorrect; 1139 #my $attemptsNoun = $attempts != 1 ? $r->maketext("times") : $r->maketext("time"); 1140 my $problem_status = $problem->status || 0; 1141 my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number 1142 #my ($attemptsLeft, $attemptsLeftNoun); 1143 my $attemptsLeft = $problem->max_attempts - $attempts; 1144 # if ($problem->max_attempts == -1) { 1145 # # unlimited attempts 1146 # $attemptsLeft = $r->maketext("unlimited"); 1147 # $attemptsLeftNoun = $r->maketext("attempts"); 1148 # } else { 1149 # $attemptsLeft = $problem->max_attempts - $attempts; 1150 # $attemptsLeftNoun = $attemptsLeft == 1 ? $r->maketext("attempt") : $r->maketext("attempts"); 1151 # } 1152 1153 my $setClosed = 0; 1154 my $setClosedMessage; 1155 if (before($set->open_date) or after($set->due_date)) { 1156 $setClosed = 1; 1157 if (before($set->open_date)) { 1158 $setClosedMessage = $r->maketext("This homework set is not yet open."); 1159 } elsif (after($set->due_date)) { 1160 $setClosedMessage = $r->maketext("This homework set is closed."); 1161 } 1162 } 1163 #if (before($set->open_date) or after($set->due_date)) { 1164 # $setClosed = 1; 1165 # $setClosedMessage = "This homework set is closed."; 1166 # if ($authz->hasPermissions($user, "view_answers")) { 1167 # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; 1168 # } else { 1169 # $setClosedMessage .= " Additional attempts will not be recorded."; 1170 # } 1171 #} 1172 unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) { 1173 my $notCountedMessage = ($problem->value) ? "" : $r->maketext("(This problem will not count towards your grade.)"); 1174 print CGI::p(join("", 1175 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", 1176 $r->maketext("You have attempted this problem [quant,_1,time,times].",$attempts), CGI::br(), 1177 $submitAnswers ? $r->maketext("You received a score of [_1] for this attempt.",sprintf("%.0f%%", $pg->{result}->{score} * 100)) . CGI::br():'', 1178 $problem->attempted 1179 ? $r->maketext("Your overall recorded score is [_1]. [_2]",$lastScore,$notCountedMessage) . CGI::br() 1180 : "", 1181 # $setClosed ? $setClosedMessage : $r->maketext("You have [_1] [_2] remaining.",$attemptsLeft,$attemptsLeftNoun) 1182 $setClosed ? $setClosedMessage : $r->maketext("You have [negquant,_1,unlimited attempts,attempt,attempts] remaining.",$attemptsLeft) 1183 )); 1184 }else { 1185 print CGI::p($pg->{state}->{state_summary_msg}); 1186 } 1187 1188 return ""; 1189 } 1190 1191 # output_misc subroutine 1192 1193 # prints out other necessary elements 1194 1195 sub output_misc{ 1196 1197 my $self = shift; 1198 my $r = $self->r; 1199 my $ce = $r->ce; 1200 my $db = $r->db; 1201 my $pg = $self->{pg}; 1202 my %will = %{ $self->{will} }; 1203 my $user = $r->param('user'); 1204 1205 print CGI::start_div(); 1206 1207 my $pgdebug = join(CGI::br(), @{$pg->{pgcore}->{flags}->{DEBUG_messages}} ); 1208 my $pgwarning = join(CGI::br(), @{$pg->{pgcore}->{flags}->{WARNING_messages}} ); 1209 my $pginternalerrors = join(CGI::br(), @{$pg->{pgcore}->get_internal_debug_messages} ); 1210 my $pgerrordiv = $pgdebug||$pgwarning||$pginternalerrors; # is 1 if any of these are non-empty 1211 1212 print CGI::p({style=>"color:red;"}, $r->maketext("Checking additional error messages")) if $pgerrordiv ; 1213 print CGI::p("pg debug<br/> $pgdebug" ) if $pgdebug ; 1214 print CGI::p("pg warning<br/>$pgwarning" ) if $pgwarning ; 1215 print CGI::p("pg internal errors<br/> $pginternalerrors") if $pginternalerrors; 1216 print CGI::end_div() if $pgerrordiv ; 1217 1218 # save state for viewOptions 1219 print CGI::hidden( 1220 -name => "showOldAnswers", 1221 -value => $will{showOldAnswers} 1222 ), 1223 1224 CGI::hidden( 1225 -name => "displayMode", 1226 -value => $self->{displayMode} 1227 ); 1228 print( CGI::hidden( 1229 -name => 'editMode', 1230 -value => $self->{editMode}, 1231 ) 1232 ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile'; 1233 1234 # this is a security risk -- students can use this to find the source code for the problem 1235 1236 my $permissionLevel = $db->getPermissionLevel($user)->permission; 1237 my $professorPermissionLevel = $ce->{userRoles}->{professor}; 1238 print( CGI::hidden( 1239 -name => 'sourceFilePath', 1240 -value => $self->{problem}->{source_file} 1241 )) if defined($self->{problem}->{source_file}) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1242 1243 print( CGI::hidden( 1244 -name => 'problemSeed', 1245 -value => $r->param("problemSeed") 1246 )) if defined($r->param("problemSeed")) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1247 1248 return ""; 1249 } 1250 1251 # output_summary subroutine 1252 1253 # prints out the summary of the questions that the student has answered for the current problem, along with available information about correctness 1254 1255 sub output_summary{ 1256 1257 my $self = shift; 1258 1259 my $editMode = $self->{editMode}; 1260 my $problem = $self->{problem}; 1261 my $pg = $self->{pg}; 1262 my $submitAnswers = $self->{submitAnswers}; 1263 my %will = %{ $self->{will} }; 1264 my $checkAnswers = $self->{checkAnswers}; 1265 my $previewAnswers = $self->{previewAnswers}; 1266 1267 my $r = $self->r; 1268 1269 my $authz = $r->authz; 1270 my $user = $r->param('user'); 1271 1272 # attempt summary 1273 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. 1274 # until after the due date 1275 # do I need to check $will{showCorrectAnswers} to make preflight work?? 1276 if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) { 1277 # print this if user submitted answers OR requested correct answers 1278 1279 print $self->attemptResults($pg, 1, 1280 $will{showCorrectAnswers}, 1281 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); 1282 } elsif ($checkAnswers) { 1283 # print this if user previewed answers 1284 print CGI::div({class=>'ResultsWithError'},$r->maketext("ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED")), CGI::br(); 1285 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); 1286 # show attempt answers 1287 # show correct answers if asked 1288 # show attempt results (correctness) 1289 # show attempt previews 1290 } elsif ($previewAnswers) { 1291 # print this if user previewed answers 1292 print CGI::div({class=>'ResultsWithError'},$r->maketext("PREVIEW ONLY -- ANSWERS NOT RECORDED")),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); 1293 # show attempt answers 1294 # don't show correct answers 1295 # don't show attempt results (correctness) 1296 # show attempt previews 1297 } 1298 1299 return ""; 1300 } 1301 1302 # output_custom_edit_message 1303 1304 # prints out a custom edit message 1305 1306 sub output_custom_edit_message{ 1307 my $self = shift; 1308 my $r = $self->r; 1309 my $authz = $r->authz; 1310 my $user = $r->param('user'); 1311 my $editMode = $self->{editMode}; 1312 my $problem = $self->{problem}; 1313 1314 # custom message for editor 1315 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) { 1316 if ($editMode eq "temporaryFile") { 1317 print CGI::p(CGI::div({class=>'temporaryFile'}, $r->maketext("Viewing temporary file: "), $problem->source_file)); 1318 } elsif ($editMode eq "savedFile") { 1319 # taken care of in the initialization phase 1320 } 1321 } 1322 1323 return ""; 1324 } 1325 1326 # output_JS subroutine 1327 1328 # prints out the wz_tooltip.js script for the current site. 1329 1330 sub output_wztooltip_JS{ 1331 1332 my $self = shift; 1333 my $r = $self->r; 1334 my $ce = $r->ce; 1335 1336 my $site_url = $ce->{webworkURLs}->{htdocs}; 1337 1338 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/wz_tooltip.js"}), CGI::end_script(); 1339 return ""; 1340 } 1341 1342 # output_past_answer_button 1343 1344 # prints out the "Show Past Answers" button 1345 1346 sub output_past_answer_button{ 1347 my $self = shift; 1348 my $r = $self->r; 1349 my $problem = $self->{problem}; 1350 1351 my $authz = $r->authz; 1352 my $urlpath = $r->urlpath; 1353 my $user = $r->param('user'); 1354 1355 my $courseName = $urlpath->arg("courseID"); 1356 1357 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", $r, 1358 courseID => $courseName); 1359 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action 1360 1361 # print answer inspection button 1362 if ($authz->hasPermissions($user, "view_answers")) { 1363 print "\n", 1364 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n", 1365 $self->hidden_authen_fields,"\n", 1366 CGI::hidden(-name => 'courseID', -value=>$courseName), "\n", 1367 CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n", 1368 CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n", 1369 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", 1370 CGI::p( {-align=>"left"}, 1371 CGI::submit(-name => 'action', -value=>$r->maketext("Show Past Answers")) 1372 ), "\n", 1373 CGI::endform(); 1374 } 1375 1376 return ""; 1377 } 1378 1379 # output_email_instructor subroutine 1380 1381 # prints out the "Email Instructor" button 1382 1383 sub output_email_instructor{ 1384 my $self = shift; 1385 my $problem = $self->{problem}; 1386 my %will = %{ $self->{will} }; 1387 my $pg = $self->{pg}; 1388 1389 print $self->feedbackMacro( 1390 module => __PACKAGE__, 1391 set => $self->{set}->set_id, 1392 problem => $problem->problem_id, 1393 displayMode => $self->{displayMode}, 1394 showOldAnswers => $will{showOldAnswers}, 1395 showCorrectAnswers => $will{showCorrectAnswers}, 1396 showHints => $will{showHints}, 1397 showSolutions => $will{showSolutions}, 1398 pg_object => $pg, 1399 ); 1400 1401 return ""; 1402 } 1403 1404 # output_hidden_info subroutine 1405 1406 # outputs the hidden fields required for the form 1407 1408 sub output_hidden_info{ 1409 my $self = shift; 1410 my $previewAnswers = $self->{previewAnswers}; 1411 1412 if($previewAnswers){ 1413 return ""; 1414 } 1415 else{ 1416 if(defined $self->{correct_ids}){ 1417 my $correctRef = $self->{correct_ids}; 1418 my @correct = @$correctRef; 1419 foreach(@correct){ 1420 print CGI::hidden(-name=>"correct_ids", -value=>$_."_val"); 1421 } 1422 } 1423 if(defined $self->{incorrect_ids}){ 1424 my $incorrectRef = $self->{incorrect_ids}; 1425 my @incorrect = @$incorrectRef; 1426 foreach(@incorrect){ 1427 print CGI::hidden(-name=>"incorrect_ids", -value=>$_."_val"); 1428 } 1429 } 1430 return ""; 1431 } 1432 } 1433 1434 # output_JS subroutine 1435 1436 # outputs all of the Javascript needed for this page. The main javascript needed here is color.js, which colors input fields based on whether or not they are correct when answers are submitted. When a problem attempts results, it prints out hidden fields containing identification information for the fields that were correct and the fields that were incorrect. color.js collects of the correct and incorrect fields into two arrays using the information gathered from the hidden fields, and then loops through and changes the styles so that the colors will show up correctly. 1437 1438 sub output_JS{ 1439 my $self = shift; 1440 my $r = $self->r; 1441 my $ce = $r->ce; 1442 1443 my $site_url = $ce->{webworkURLs}->{htdocs}; 1444 1445 # This file declares a function called addOnLoadEvent which allows multiple different scripts to add to a single onLoadEvent handler on a page. 1446 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/addOnLoadEvent.js"}), CGI::end_script(); 1447 1448 # This is a file which initializes the proper JAVA applets should they be needed for the current problem. 1449 print CGI::start_script({type=>"tesxt/javascript", src=>"$site_url/js/java_init.js"}), CGI::end_script(); 1450 1451 # The color.js file, which uses javascript to color the input fields based on whether they are correct or incorrect. 1452 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/color.js"}), CGI::end_script(); 1453 return ""; 1454 } 1455 1456 # Simply here to indicate to the template that this page has body part methods which can be called 1457 1458 sub can_body_parts{ 1459 return ""; 1460 } 1461 1462 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |