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