Parent Directory
| 
Revision Log
changed "label" to "value" in defining the name of the submit button so that this works in firefox and some other browsers. Seems to have been a typo since "value" was used in defining the preview and check answer buttons.
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 post_header_text { 761 my ($self) = @_; 762 return "" if ( $self->{invalidSet} ); 763 return $self->{pg}->{post_header_text} if $self->{pg}->{post_header_text}; 764 } 765 766 sub options { 767 my ($self) = @_; 768 #warn "doing options in Problem"; 769 770 # don't show options if we don't have anything to show 771 return "" if $self->{invalidSet} or $self->{invalidProblem}; 772 773 my $displayMode = $self->{displayMode}; 774 my %can = %{ $self->{can} }; 775 776 my @options_to_show = "displayMode"; 777 push @options_to_show, "showOldAnswers" if $can{showOldAnswers}; 778 push @options_to_show, "showHints" if $can{showHints}; 779 push @options_to_show, "showSolutions" if $can{showSolutions}; 780 781 return $self->optionsMacro( 782 options_to_show => \@options_to_show, 783 extra_params => ["editMode", "sourceFilePath"], 784 ); 785 } 786 787 sub siblings { 788 my ($self) = @_; 789 my $r = $self->r; 790 my $db = $r->db; 791 my $urlpath = $r->urlpath; 792 793 # can't show sibling problems if the set is invalid 794 return "" if $self->{invalidSet}; 795 796 my $courseID = $urlpath->arg("courseID"); 797 my $setID = $self->{set}->set_id; 798 my $eUserID = $r->param("effectiveUser"); 799 my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID); 800 801 print CGI::start_div({class=>"info-box", id=>"fisheye"}); 802 print CGI::h2($r->maketext("Problems")); 803 #print CGI::start_ul({class=>"LinksMenu"}); 804 #print CGI::start_li(); 805 #print CGI::span({style=>"font-size:larger"}, "Problems"); 806 print CGI::start_ul(); 807 808 foreach my $problemID (@problemIDs) { 809 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", $r, 810 courseID => $courseID, setID => $setID, problemID => $problemID); 811 print CGI::li(CGI::a( {href=>$self->systemLink($problemPage, 812 params=>{ displayMode => $self->{displayMode}, 813 showOldAnswers => $self->{will}->{showOldAnswers} 814 })}, $r->maketext("Problem [_1]",$problemID)) 815 ); 816 } 817 818 print CGI::end_ul(); 819 #print CGI::end_li(); 820 #print CGI::end_ul(); 821 print CGI::end_div(); 822 823 return ""; 824 } 825 826 sub nav { 827 my ($self, $args) = @_; 828 my $r = $self->r; 829 my $db = $r->db; 830 my $urlpath = $r->urlpath; 831 832 return "" if ( $self->{invalidSet} ); 833 834 my $courseID = $urlpath->arg("courseID"); 835 my $setID = $self->{set}->set_id if !($self->{invalidSet}); 836 my $problemID = $self->{problem}->problem_id if !($self->{invalidProblem}); 837 my $eUserID = $r->param("effectiveUser"); 838 839 my ($prevID, $nextID); 840 841 if (!$self->{invalidProblem}) { 842 my @problemIDs = $db->listUserProblems($eUserID, $setID); 843 foreach my $id (@problemIDs) { 844 $prevID = $id if $id < $problemID 845 and (not defined $prevID or $id > $prevID); 846 $nextID = $id if $id > $problemID 847 and (not defined $nextID or $id < $nextID); 848 } 849 } 850 851 my @links; 852 853 if ($prevID) { 854 my $prevPage = $urlpath->newFromModule(__PACKAGE__, $r, 855 courseID => $courseID, setID => $setID, problemID => $prevID); 856 push @links, $r->maketext("Previous Problem"), $r->location . $prevPage->path, $r->maketext("navPrev"); 857 } else { 858 push @links, $r->maketext("Previous Problem"), "", $r->maketext("navPrevGrey"); 859 } 860 861 if (defined($setID) && $setID ne 'Undefined_Set') { 862 push @links, $r->maketext("Problem List"), $r->location . $urlpath->parent->path, $r->maketext("navProbList"); 863 } else { 864 push @links, $r->maketext("Problem List"), "", $r->maketext("navProbListGrey"); 865 } 866 867 if ($nextID) { 868 my $nextPage = $urlpath->newFromModule(__PACKAGE__, $r, 869 courseID => $courseID, setID => $setID, problemID => $nextID); 870 push @links, $r->maketext("Next Problem"), $r->location . $nextPage->path, $r->maketext("navNext"); 871 } else { 872 push @links, $r->maketext("Next Problem"), "", $r->maketext("navNextGrey"); 873 } 874 875 my $tail = ""; 876 877 $tail .= "&displayMode=".$self->{displayMode} if defined $self->{displayMode}; 878 $tail .= "&showOldAnswers=".$self->{will}->{showOldAnswers} 879 if defined $self->{will}->{showOldAnswers}; 880 return $self->navMacro($args, $tail, @links); 881 } 882 883 sub title { 884 my ($self) = @_; 885 my $r = $self->r; 886 # using the url arguments won't break if the set/problem are invalid 887 my $setID = WeBWorK::ContentGenerator::underscore2nbsp($self->r->urlpath->arg("setID")); 888 my $problemID = $self->r->urlpath->arg("problemID"); 889 890 return $r->maketext("[_1]: Problem [_2]",$setID, $problemID); 891 } 892 893 894 # now altered to outsource most output operations to the template, main functions now are simply error checking and answer processing - ghe3 895 sub body { 896 my $self = shift; 897 my $set = $self->{set}; 898 my $problem = $self->{problem}; 899 my $pg = $self->{pg}; 900 901 my $valid = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::check_invalid($self); 902 unless($valid eq "valid"){ 903 return $valid; 904 } 905 906 907 908 ##### answer processing ##### 909 debug("begin answer processing"); 910 # if answers were submitted: 911 #my $scoreRecordedMessage = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_and_log_answer($self); 912 debug("end answer processing"); 913 # output for templates that only use body instead of calling the body parts individually 914 $self ->output_JS; 915 $self ->output_custom_edit_message; 916 $self ->output_summary; 917 $self ->output_hidden_info; 918 $self ->output_form_start(); 919 $self ->output_problem_body; 920 $self ->output_message; 921 $self ->output_editorLink; 922 $self ->output_checkboxes; 923 $self ->output_submit_buttons; 924 $self ->output_score_summary; 925 $self ->output_misc; 926 print "</form>"; 927 # debugging stuff 928 if (0) { 929 print 930 CGI::hr(), 931 CGI::h2("debugging information"), 932 CGI::h3("form fields"), 933 ref2string($self->{formFields}), 934 CGI::h3("user object"), 935 ref2string($self->{user}), 936 CGI::h3("set object"), 937 ref2string($set), 938 CGI::h3("problem object"), 939 ref2string($problem), 940 CGI::h3("PG object"), 941 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 942 } 943 debug("leaving body of Problem.pm"); 944 return ""; 945 } 946 947 # output_form_start subroutine 948 949 # prints out the beginning of the main form, and the necessary hidden authentication fields 950 951 sub output_form_start{ 952 my $self = shift; 953 my $r = $self->r; 954 print CGI::start_form(-method=>"POST", -action=> $r->uri,-name=>"problemMainForm", onsubmit=>"submitAction()"); 955 print $self->hidden_authen_fields; 956 return ""; 957 } 958 959 # output_problem_body subroutine 960 961 # prints out the body of the current problem 962 963 sub output_problem_body{ 964 my $self = shift; 965 my $pg = $self->{pg}; 966 967 print "\n"; 968 print CGI::p($pg->{body_text}); 969 return ""; 970 } 971 972 # output_message subroutine 973 974 # prints out a message about the problem 975 976 sub output_message{ 977 my $self = shift; 978 my $pg = $self->{pg}; 979 my $r = $self->r; 980 981 print CGI::p(CGI::b($r->maketext("Note").": "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg}; 982 return ""; 983 } 984 985 # output_editorLink subroutine 986 987 # processes and prints out the correct link to the editor of the current problem 988 989 sub output_editorLink{ 990 991 my $self = shift; 992 993 my $set = $self->{set}; 994 my $problem = $self->{problem}; 995 my $pg = $self->{pg}; 996 997 my $r = $self->r; 998 999 my $authz = $r->authz; 1000 my $urlpath = $r->urlpath; 1001 my $user = $r->param('user'); 1002 1003 my $courseName = $urlpath->arg("courseID"); 1004 1005 # FIXME: move editor link to top, next to problem number. 1006 # format as "[edit]" like we're doing with course info file, etc. 1007 # add edit link for set as well. 1008 my $editorLink = ""; 1009 # if we are here without a real homework set, carry that through 1010 my $forced_field = []; 1011 $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if 1012 ($set->set_id eq 'Undefined_Set'); 1013 if ($authz->hasPermissions($user, "modify_problem_sets")) { 1014 my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r, 1015 courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id); 1016 my $editorURL = $self->systemLink($editorPage, params=>$forced_field); 1017 $editorLink = CGI::p(CGI::a({href=>$editorURL,target =>'WW_Editor'}, $r->maketext("Edit this problem"))); 1018 } 1019 1020 ##### translation errors? ##### 1021 1022 if ($pg->{flags}->{error_flag}) { 1023 if ($authz->hasPermissions($user, "view_problem_debugging_info")) { 1024 print $self->errorOutput($pg->{errors}, $pg->{body_text}); 1025 } else { 1026 print $self->errorOutput($pg->{errors}, $r->maketext("You do not have permission to view the details of this error.")); 1027 } 1028 print ""; 1029 } 1030 else{ 1031 print $editorLink; 1032 } 1033 return ""; 1034 } 1035 1036 # output_checkboxes subroutine 1037 1038 # prints out the checkbox input elements that are available for the current problem 1039 1040 sub output_checkboxes{ 1041 my $self = shift; 1042 my $r = $self->r; 1043 my %can = %{ $self->{can} }; 1044 my %will = %{ $self->{will} }; 1045 1046 if ($can{showCorrectAnswers}) { 1047 print WeBWorK::CGI_labeled_input( 1048 -type => "checkbox", 1049 -id => "showCorrectAnswers_id", 1050 -label_text => $r->maketext("Show correct answers"), 1051 -input_attr => $will{showCorrectAnswers} ? 1052 { 1053 -name => "showCorrectAnswers", 1054 -checked => "checked", 1055 -value => 1, 1056 } 1057 : 1058 { 1059 -name => "showCorrectAnswers", 1060 -value => 1, 1061 } 1062 )," "; 1063 } 1064 if ($can{showHints}) { 1065 print CGI::span({style=>"color:red"}, 1066 WeBWorK::CGI_labeled_input( 1067 -type => "checkbox", 1068 -id => "showHints_id", 1069 -label_text => $r->maketext("Show Hints"), 1070 -input_attr => $will{showHints} ? 1071 { 1072 -name => "showHints", 1073 -checked => "checked", 1074 -value => 1, 1075 } 1076 : 1077 { 1078 -name => "showHints", 1079 -value => 1, 1080 } 1081 ) 1082 )," "; 1083 } 1084 if ($can{showSolutions}) { 1085 print WeBWorK::CGI_labeled_input( 1086 -type => "checkbox", 1087 -id => "showSolutions_id", 1088 -label_text => $r->maketext("Show Solutions"), 1089 -input_attr => $will{showSolutions} ? 1090 { 1091 -name => "showSolutions", 1092 -checked => "checked", 1093 -value => 1, 1094 } 1095 : 1096 { 1097 -name => "showSolutions", 1098 -value => 1, 1099 } 1100 )," "; 1101 } 1102 1103 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) { 1104 print CGI::br(); 1105 } 1106 1107 return ""; 1108 } 1109 1110 # output_submit_buttons 1111 1112 # prints out the submit button input elements that are available for the current problem 1113 1114 sub output_submit_buttons{ 1115 my $self = shift; 1116 my $r = $self->r; 1117 my %can = %{ $self->{can} }; 1118 1119 my $user = $r->param('user'); 1120 my $effectiveUser = $r->param('effectiveUser'); 1121 1122 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"previewAnswers_id", -input_attr=>{-name=>"previewAnswers", -value=>$r->maketext("Preview Answers")}); 1123 if ($can{checkAnswers}) { 1124 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"checkAnswers_id", -input_attr=>{-name=>"checkAnswers", -value=>$r->maketext("Check Answers")}); 1125 } 1126 if ($can{getSubmitButton}) { 1127 if ($user ne $effectiveUser) { 1128 # if acting as a student, make it clear that answer submissions will 1129 # apply to the student's records, not the professor's. 1130 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"submitAnswers_id", -input_attr=>{-name=>$r->maketext("submitAnswers"), -value=>$r->maketext("Submit Answers for [_1]", $effectiveUser)}); 1131 } else { 1132 #print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>"alert('submit button clicked')"); 1133 print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"submitAnswers_id", -input_attr=>{-name=>"submitAnswers", -value=>$r->maketext("Submit Answers"), -onclick=>""}); 1134 # FIXME for unknown reasons the -onclick label seems to have to be there in order to allow the forms onsubmit to trigger 1135 # WTF??? 1136 } 1137 } 1138 1139 return ""; 1140 } 1141 1142 # output_score_summary subroutine 1143 1144 # prints out a summary of the student's current progress and status on the current problem 1145 1146 sub output_score_summary{ 1147 my $self = shift; 1148 my $r = $self->r; 1149 my $problem = $self->{problem}; 1150 my $set = $self->{set}; 1151 my $pg = $self->{pg}; 1152 my $scoreRecordedMessage = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_and_log_answer($self) || ""; 1153 my $submitAnswers = $self->{submitAnswers}; 1154 1155 # score summary 1156 warn "num_correct =", $problem->num_correct,"num_incorrect=",$problem->num_incorrect 1157 unless defined($problem->num_correct) and defined($problem->num_incorrect) ; 1158 my $attempts = $problem->num_correct + $problem->num_incorrect; 1159 #my $attemptsNoun = $attempts != 1 ? $r->maketext("times") : $r->maketext("time"); 1160 my $problem_status = $problem->status || 0; 1161 my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number 1162 my $attemptsLeft = $problem->max_attempts - $attempts; 1163 1164 1165 my $setClosed = 0; 1166 my $setClosedMessage; 1167 if (before($set->open_date) or after($set->due_date)) { 1168 $setClosed = 1; 1169 if (before($set->open_date)) { 1170 $setClosedMessage = $r->maketext("This homework set is not yet open."); 1171 } elsif (after($set->due_date)) { 1172 $setClosedMessage = $r->maketext("This homework set is closed."); 1173 } 1174 } 1175 #if (before($set->open_date) or after($set->due_date)) { 1176 # $setClosed = 1; 1177 # $setClosedMessage = "This homework set is closed."; 1178 # if ($authz->hasPermissions($user, "view_answers")) { 1179 # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; 1180 # } else { 1181 # $setClosedMessage .= " Additional attempts will not be recorded."; 1182 # } 1183 #} 1184 unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) { 1185 my $notCountedMessage = ($problem->value) ? "" : $r->maketext("(This problem will not count towards your grade.)"); 1186 print CGI::p(join("", 1187 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", 1188 $r->maketext("You have attempted this problem [quant,_1,time,times].",$attempts), CGI::br(), 1189 $submitAnswers ? $r->maketext("You received a score of [_1] for this attempt.",sprintf("%.0f%%", $pg->{result}->{score} * 100)) . CGI::br():'', 1190 $problem->attempted 1191 ? $r->maketext("Your overall recorded score is [_1]. [_2]",$lastScore,$notCountedMessage) . CGI::br() 1192 : "", 1193 $setClosed ? $setClosedMessage : $r->maketext("You have [negquant,_1,unlimited attempts,attempt,attempts] remaining.",$attemptsLeft) 1194 )); 1195 }else { 1196 print CGI::p($pg->{state}->{state_summary_msg}); 1197 } 1198 1199 return ""; 1200 } 1201 1202 # output_misc subroutine 1203 1204 # prints out other necessary elements 1205 1206 sub output_misc{ 1207 1208 my $self = shift; 1209 my $r = $self->r; 1210 my $ce = $r->ce; 1211 my $db = $r->db; 1212 my $pg = $self->{pg}; 1213 my %will = %{ $self->{will} }; 1214 my $user = $r->param('user'); 1215 1216 print CGI::start_div(); 1217 1218 my $pgdebug = join(CGI::br(), @{$pg->{pgcore}->{flags}->{DEBUG_messages}} ); 1219 my $pgwarning = join(CGI::br(), @{$pg->{pgcore}->{flags}->{WARNING_messages}} ); 1220 my $pginternalerrors = join(CGI::br(), @{$pg->{pgcore}->get_internal_debug_messages} ); 1221 my $pgerrordiv = $pgdebug||$pgwarning||$pginternalerrors; # is 1 if any of these are non-empty 1222 1223 print CGI::p({style=>"color:red;"}, $r->maketext("Checking additional error messages")) if $pgerrordiv ; 1224 print CGI::p("pg debug<br/> $pgdebug" ) if $pgdebug ; 1225 print CGI::p("pg warning<br/>$pgwarning" ) if $pgwarning ; 1226 print CGI::p("pg internal errors<br/> $pginternalerrors") if $pginternalerrors; 1227 print CGI::end_div() if $pgerrordiv ; 1228 1229 # save state for viewOptions 1230 print CGI::hidden( 1231 -name => "showOldAnswers", 1232 -value => $will{showOldAnswers} 1233 ), 1234 1235 CGI::hidden( 1236 -name => "displayMode", 1237 -value => $self->{displayMode} 1238 ); 1239 print( CGI::hidden( 1240 -name => 'editMode', 1241 -value => $self->{editMode}, 1242 ) 1243 ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile'; 1244 1245 # this is a security risk -- students can use this to find the source code for the problem 1246 1247 my $permissionLevel = $db->getPermissionLevel($user)->permission; 1248 my $professorPermissionLevel = $ce->{userRoles}->{professor}; 1249 print( CGI::hidden( 1250 -name => 'sourceFilePath', 1251 -value => $self->{problem}->{source_file} 1252 )) if defined($self->{problem}->{source_file}) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1253 1254 print( CGI::hidden( 1255 -name => 'problemSeed', 1256 -value => $r->param("problemSeed") 1257 )) if defined($r->param("problemSeed")) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors 1258 1259 return ""; 1260 } 1261 1262 # output_summary subroutine 1263 1264 # prints out the summary of the questions that the student has answered for the current problem, along with available information about correctness 1265 1266 sub output_summary{ 1267 1268 my $self = shift; 1269 1270 my $editMode = $self->{editMode}; 1271 my $problem = $self->{problem}; 1272 my $pg = $self->{pg}; 1273 my $submitAnswers = $self->{submitAnswers}; 1274 my %will = %{ $self->{will} }; 1275 my $checkAnswers = $self->{checkAnswers}; 1276 my $previewAnswers = $self->{previewAnswers}; 1277 1278 my $r = $self->r; 1279 1280 my $authz = $r->authz; 1281 my $user = $r->param('user'); 1282 1283 # attempt summary 1284 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. 1285 # until after the due date 1286 # do I need to check $will{showCorrectAnswers} to make preflight work?? 1287 if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) { 1288 # print this if user submitted answers OR requested correct answers 1289 1290 print $self->attemptResults($pg, 1, 1291 $will{showCorrectAnswers}, 1292 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); 1293 } elsif ($checkAnswers) { 1294 # print this if user previewed answers 1295 print CGI::div({class=>'ResultsWithError'},$r->maketext("ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED")), CGI::br(); 1296 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); 1297 # show attempt answers 1298 # show correct answers if asked 1299 # show attempt results (correctness) 1300 # show attempt previews 1301 } elsif ($previewAnswers) { 1302 # print this if user previewed answers 1303 print CGI::div({class=>'ResultsWithError'},$r->maketext("PREVIEW ONLY -- ANSWERS NOT RECORDED")),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); 1304 # show attempt answers 1305 # don't show correct answers 1306 # don't show attempt results (correctness) 1307 # show attempt previews 1308 } 1309 1310 return ""; 1311 } 1312 1313 # output_custom_edit_message 1314 1315 # prints out a custom edit message 1316 1317 sub output_custom_edit_message{ 1318 my $self = shift; 1319 my $r = $self->r; 1320 my $authz = $r->authz; 1321 my $user = $r->param('user'); 1322 my $editMode = $self->{editMode}; 1323 my $problem = $self->{problem}; 1324 1325 # custom message for editor 1326 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) { 1327 if ($editMode eq "temporaryFile") { 1328 print CGI::p(CGI::div({class=>'temporaryFile'}, $r->maketext("Viewing temporary file: "), $problem->source_file)); 1329 } elsif ($editMode eq "savedFile") { 1330 # taken care of in the initialization phase 1331 } 1332 } 1333 1334 return ""; 1335 } 1336 1337 1338 1339 1340 # output_past_answer_button 1341 1342 # prints out the "Show Past Answers" button 1343 1344 sub output_past_answer_button{ 1345 my $self = shift; 1346 my $r = $self->r; 1347 my $problem = $self->{problem}; 1348 1349 my $authz = $r->authz; 1350 my $urlpath = $r->urlpath; 1351 my $user = $r->param('user'); 1352 1353 my $courseName = $urlpath->arg("courseID"); 1354 1355 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", $r, 1356 courseID => $courseName); 1357 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action 1358 1359 # print answer inspection button 1360 if ($authz->hasPermissions($user, "view_answers")) { 1361 print "\n", 1362 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n", 1363 $self->hidden_authen_fields,"\n", 1364 CGI::hidden(-name => 'courseID', -value=>$courseName), "\n", 1365 CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n", 1366 CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n", 1367 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", 1368 CGI::p( {-align=>"left"}, 1369 CGI::submit(-name => 'action', -value=>$r->maketext("Show Past Answers")) 1370 ), "\n", 1371 CGI::endform(); 1372 } 1373 1374 return ""; 1375 } 1376 1377 # output_email_instructor subroutine 1378 1379 # prints out the "Email Instructor" button 1380 1381 sub output_email_instructor{ 1382 my $self = shift; 1383 my $problem = $self->{problem}; 1384 my %will = %{ $self->{will} }; 1385 my $pg = $self->{pg}; 1386 1387 print $self->feedbackMacro( 1388 module => __PACKAGE__, 1389 set => $self->{set}->set_id, 1390 problem => $problem->problem_id, 1391 displayMode => $self->{displayMode}, 1392 showOldAnswers => $will{showOldAnswers}, 1393 showCorrectAnswers => $will{showCorrectAnswers}, 1394 showHints => $will{showHints}, 1395 showSolutions => $will{showSolutions}, 1396 pg_object => $pg, 1397 ); 1398 1399 return ""; 1400 } 1401 1402 # output_hidden_info subroutine 1403 1404 # outputs the hidden fields required for the form 1405 1406 sub output_hidden_info{ 1407 my $self = shift; 1408 my $previewAnswers = $self->{previewAnswers}; 1409 my $checkAnswers = $self->{checkAnswers}; 1410 my $showPartialCorrectAnswers = $self->{pg}->{flags}->{showPartialCorrectAnswers}; 1411 if($previewAnswers){ # never color previewed answers 1412 return ""; 1413 } 1414 elsif ( ($checkAnswers ) 1415 or $showPartialCorrectAnswers ) { # color answers when partialCorrectAnswers is set 1416 # or when checkAnswers is submitted 1417 if(defined $self->{correct_ids}){ 1418 my $correctRef = $self->{correct_ids}; 1419 my @correct = @$correctRef; 1420 foreach(@correct){ 1421 print CGI::hidden(-name=>"correct_ids", -value=>$_."_val"); 1422 } 1423 } 1424 if(defined $self->{incorrect_ids}){ 1425 my $incorrectRef = $self->{incorrect_ids}; 1426 my @incorrect = @$incorrectRef; 1427 foreach(@incorrect){ 1428 print CGI::hidden(-name=>"incorrect_ids", -value=>$_."_val"); 1429 } 1430 } 1431 return ""; 1432 } else { 1433 return ""; 1434 } 1435 } 1436 1437 # output_JS subroutine 1438 1439 # prints out the wz_tooltip.js script for the current site. 1440 1441 sub output_wztooltip_JS{ 1442 1443 my $self = shift; 1444 my $r = $self->r; 1445 my $ce = $r->ce; 1446 1447 my $site_url = $ce->{webworkURLs}->{htdocs}; 1448 1449 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/wz_tooltip.js"}), CGI::end_script(); 1450 return ""; 1451 } 1452 1453 # outputs all of the Javascript needed for this page. 1454 # The main javascript needed here is color.js, which colors input fields based on whether or not 1455 # they are correct when answers are submitted. When a problem attempts results, it prints out hidden fields containing identification 1456 # information for the fields that were correct and the fields that were incorrect. color.js collects of the correct and incorrect fields into 1457 # two arrays using the information gathered from the hidden fields, and then loops through and changes the styles so 1458 # that the colors will show up correctly. 1459 1460 sub output_JS{ 1461 my $self = shift; 1462 my $r = $self->r; 1463 my $ce = $r->ce; 1464 1465 my $site_url = $ce->{webworkURLs}->{htdocs}; 1466 1467 # This file declares a function called addOnLoadEvent which allows multiple different scripts to add to a single onLoadEvent handler on a page. 1468 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/addOnLoadEvent.js"}), CGI::end_script(); 1469 1470 # This is a file which initializes the proper JAVA applets should they be needed for the current problem. 1471 print CGI::start_script({type=>"tesxt/javascript", src=>"$site_url/js/java_init.js"}), CGI::end_script(); 1472 1473 # The color.js file, which uses javascript to color the input fields based on whether they are correct or incorrect. 1474 print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/color.js"}), CGI::end_script(); 1475 return ""; 1476 } 1477 1478 # Simply here to indicate to the template that this page has body part methods which can be called 1479 1480 sub can_body_parts{ 1481 return ""; 1482 } 1483 1484 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |