Parent Directory
| 
Revision Log
Make tth use unicode for the preview (as it does for the calls within the body of the problem). Also, do the preview in display mode, but fix the tables so that they won't have unwanted borders (really need to fix the ur.css to get this right) and remove the unneeded initial <BR> that tth produces.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.174 2005/07/05 18:56:07 sh002i 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::ContentGenerator); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. 23 24 =cut 25 26 use strict; 27 use warnings; 28 use CGI qw(); 29 use File::Path qw(rmtree); 30 use WeBWorK::Form; 31 use WeBWorK::PG; 32 use WeBWorK::PG::ImageGenerator; 33 use WeBWorK::PG::IO; 34 use WeBWorK::Utils qw(readFile writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory); 35 use WeBWorK::DB::Utils qw(global2user user2global findDefaults); 36 use WeBWorK::Timing; 37 use URI::Escape; 38 39 use WeBWorK::Utils::Tasks qw(fake_set fake_problem); 40 41 ################################################################################ 42 # CGI param interface to this module (up-to-date as of v1.153) 43 ################################################################################ 44 45 # Standard params: 46 # 47 # user - user ID of real user 48 # key - session key 49 # effectiveUser - user ID of effective user 50 # 51 # Integration with PGProblemEditor: 52 # 53 # editMode - if set, indicates alternate problem source location. 54 # can be "temporaryFile" or "savedFile". 55 # 56 # sourceFilePath - path to file to be edited 57 # problemSeed - force problem seed to value 58 # success - success message to display 59 # failure - failure message to display 60 # 61 # Rendering options: 62 # 63 # displayMode - name of display mode to use 64 # 65 # showOldAnswers - request that last entered answer be shown (if allowed) 66 # showCorrectAnswers - request that correct answers be shown (if allowed) 67 # showHints - request that hints be shown (if allowed) 68 # showSolutions - request that solutions be shown (if allowed) 69 # 70 # Problem interaction: 71 # 72 # AnSwEr# - answer blanks in problem 73 # 74 # redisplay - name of the "Redisplay Problem" button 75 # submitAnswers - name of "Submit Answers" button 76 # checkAnswers - name of the "Check Answers" button 77 # previewAnswers - name of the "Preview Answers" button 78 79 ################################################################################ 80 # "can" methods 81 ################################################################################ 82 83 # Subroutines to determine if a user "can" perform an action. Each subroutine is 84 # called with the following arguments: 85 # 86 # ($self, $User, $EffectiveUser, $Set, $Problem) 87 88 sub can_showOldAnswers { 89 #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 90 91 return 1; 92 } 93 94 sub can_showCorrectAnswers { 95 my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 96 my $authz = $self->r->authz; 97 98 return 99 after($Set->answer_date) 100 || 101 $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date") 102 ; 103 } 104 105 sub can_showHints { 106 #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 107 108 return 1; 109 } 110 111 sub can_showSolutions { 112 my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; 113 my $authz = $self->r->authz; 114 115 return 116 after($Set->answer_date) 117 || 118 $authz->hasPermissions($User->user_id, "show_solutions_before_answer_date") 119 ; 120 } 121 122 sub can_recordAnswers { 123 my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; 124 my $authz = $self->r->authz; 125 my $thisAttempt = $submitAnswers ? 1 : 0; 126 if ($User->user_id ne $EffectiveUser->user_id) { 127 return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student"); 128 } 129 if (before($Set->open_date)) { 130 return $authz->hasPermissions($User->user_id, "record_answers_before_open_date"); 131 } elsif (between($Set->open_date, $Set->due_date)) { 132 my $max_attempts = $Problem->max_attempts; 133 my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; 134 if ($max_attempts == -1 or $attempts_used < $max_attempts) { 135 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts"); 136 } else { 137 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts"); 138 } 139 } elsif (between($Set->due_date, $Set->answer_date)) { 140 return $authz->hasPermissions($User->user_id, "record_answers_after_due_date"); 141 } elsif (after($Set->answer_date)) { 142 return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date"); 143 } 144 } 145 146 sub can_checkAnswers { 147 my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; 148 my $authz = $self->r->authz; 149 my $thisAttempt = $submitAnswers ? 1 : 0; 150 151 if (before($Set->open_date)) { 152 return $authz->hasPermissions($User->user_id, "check_answers_before_open_date"); 153 } elsif (between($Set->open_date, $Set->due_date)) { 154 my $max_attempts = $Problem->max_attempts; 155 my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; 156 if ($max_attempts == -1 or $attempts_used < $max_attempts) { 157 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts"); 158 } else { 159 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts"); 160 } 161 } elsif (between($Set->due_date, $Set->answer_date)) { 162 return $authz->hasPermissions($User->user_id, "check_answers_after_due_date"); 163 } elsif (after($Set->answer_date)) { 164 return $authz->hasPermissions($User->user_id, "check_answers_after_answer_date"); 165 } 166 } 167 168 # Helper functions for calculating times 169 sub before { return time <= $_[0] } 170 sub after { return time >= $_[0] } 171 sub between { my $t = time; return $t > $_[0] && $t < $_[1] } 172 173 ################################################################################ 174 # output utilities 175 ################################################################################ 176 177 sub attemptResults { 178 my $self = shift; 179 my $pg = shift; 180 my $showAttemptAnswers = shift; 181 my $showCorrectAnswers = shift; 182 my $showAttemptResults = $showAttemptAnswers && shift; 183 my $showSummary = shift; 184 my $showAttemptPreview = shift || 0; 185 186 my $ce = $self->r->ce; 187 188 my $problemResult = $pg->{result}; # the overall result of the problem 189 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 190 191 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; 192 193 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; 194 195 # to make grabbing these options easier, we'll pull them out now... 196 my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}}; 197 198 my $imgGen = WeBWorK::PG::ImageGenerator->new( 199 tempDir => $ce->{webworkDirs}->{tmp}, 200 latex => $ce->{externalPrograms}->{latex}, 201 dvipng => $ce->{externalPrograms}->{dvipng}, 202 useCache => 1, 203 cacheDir => $ce->{webworkDirs}->{equationCache}, 204 cacheURL => $ce->{webworkURLs}->{equationCache}, 205 cacheDB => $ce->{webworkFiles}->{equationCacheDB}, 206 dvipng_align => $imagesModeOptions{dvipng_align}, 207 dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, 208 ); 209 210 my $header; 211 #$header .= CGI::th("Part"); 212 $header .= $showAttemptAnswers ? CGI::th("Entered") : ""; 213 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : ""; 214 $header .= $showCorrectAnswers ? CGI::th("Correct") : ""; 215 $header .= $showAttemptResults ? CGI::th("Result") : ""; 216 $header .= $showMessages ? CGI::th("Messages") : ""; 217 my $fully = ''; 218 my @tableRows = ( $header ); 219 my $numCorrect = 0; 220 my $tthPreambleCache; 221 foreach my $name (@answerNames) { 222 my $answerResult = $pg->{answers}->{$name}; 223 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 224 my $preview = ($showAttemptPreview 225 ? $self->previewAnswer($answerResult, $imgGen, \$tthPreambleCache) 226 : ""); 227 my $correctAnswer = $answerResult->{correct_ans}; 228 my $answerScore = $answerResult->{score}; 229 my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; 230 $answerMessage =~ s/\n/<BR>/g; 231 $numCorrect += $answerScore >= 1; 232 my $resultString = $answerScore >= 1 ? "correct" : 233 $answerScore > 0 ? int($answerScore*100)."% correct" : 234 "incorrect"; 235 $fully = 'completely ' if $answerScore >0 and $answerScore < 1; 236 237 # get rid of the goofy prefix on the answer names (supposedly, the format 238 # of the answer names is changeable. this only fixes it for "AnSwEr" 239 #$name =~ s/^AnSwEr//; 240 241 my $row; 242 #$row .= CGI::td($name); 243 $row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : ""; 244 $row .= $showAttemptPreview ? CGI::td($self->nbsp($preview)) : ""; 245 $row .= $showCorrectAnswers ? CGI::td($self->nbsp($correctAnswer)) : ""; 246 $row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : ""; 247 $row .= $showMessages ? CGI::td({-class=>"Message"},$self->nbsp($answerMessage)) : ""; 248 push @tableRows, $row; 249 } 250 251 # render equation images 252 $imgGen->render(refresh => 1); 253 254 # my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; 255 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); 256 # FIXME -- I left the old code in in case we have to back out. 257 # my $summary = "On this attempt, you answered $numCorrect out of " 258 # . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; 259 my $summary = ""; 260 if (scalar @answerNames == 1) { 261 if ($numCorrect == scalar @answerNames) { 262 $summary .= CGI::div({class=>"ResultsWithoutError"},"The above answer is correct."); 263 } else { 264 $summary .= CGI::div({class=>"ResultsWithError"},"The above answer is NOT ${fully}correct."); 265 } 266 } else { 267 if ($numCorrect == scalar @answerNames) { 268 $summary .= CGI::div({class=>"ResultsWithoutError"},"All of the above answers are correct."); 269 } else { 270 $summary .= CGI::div({class=>"ResultsWithError"},"At least one of the above answers is NOT ${fully}correct."); 271 } 272 } 273 274 return 275 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) 276 . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); 277 } 278 279 280 sub previewAnswer { 281 my ($self, $answerResult, $imgGen, $tthPreambleCache) = @_; 282 my $ce = $self->r->ce; 283 my $effectiveUser = $self->{effectiveUser}; 284 my $set = $self->{set}; 285 my $problem = $self->{problem}; 286 my $displayMode = $self->{displayMode}; 287 288 # note: right now, we have to do things completely differently when we are 289 # rendering math from INSIDE the translator and from OUTSIDE the translator. 290 # so we'll just deal with each case explicitly here. there's some code 291 # duplication that can be dealt with later by abstracting out tth/dvipng/etc. 292 293 my $tex = $answerResult->{preview_latex_string}; 294 295 return "" unless defined $tex and $tex ne ""; 296 297 if ($displayMode eq "plainText") { 298 return $tex; 299 } elsif ($displayMode eq "formattedText") { 300 301 # read the TTH preamble, or use the cached copy passed in from the caller 302 my $tthPreamble; 303 if (defined $$tthPreambleCache) { 304 $tthPreamble = $$tthPreambleCache; 305 } else { 306 my $tthPreambleFile = $ce->{courseDirs}->{templates} . "/tthPreamble.tex"; 307 if (-r $tthPreambleFile) { 308 $tthPreamble = readFile($tthPreambleFile); 309 # thanks to Jim Martino. each line in the definition file should end with 310 #a % to prevent adding supurious paragraphs to output: 311 $tthPreamble =~ s/(.)\n/$1%\n/g; 312 # solves the problem if the file doesn't end with a return: 313 $tthPreamble .="%\n"; 314 # store preamble in cache: 315 $$tthPreambleCache = $tthPreamble; 316 } else { 317 } 318 } 319 320 # construct TTH command line 321 my $tthCommand = $ce->{externalPrograms}->{tth} 322 . " -L -f5 -u -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" 323 . $tthPreamble . "\\[" . $tex . "\\]\n" 324 . "END_OF_INPUT\n"; 325 326 # call tth 327 my $result = `$tthCommand`; 328 if ($?) { 329 return "<b>[tth failed: $? $@]</b>"; 330 } else { 331 # avoid border problems in tables and remove unneeded initial <br> 332 $result =~ s/(<table [^>]*)>/$1 CLASS="ArrayLayout">/gi; 333 $result =~ s!\s*<br clear="all" />!!; 334 return $result; 335 } 336 337 } elsif ($displayMode eq "images") { 338 $imgGen->add($tex); 339 } elsif ($displayMode eq "jsMath") { 340 return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>'; 341 } 342 } 343 344 ################################################################################ 345 # Template escape implementations 346 ################################################################################ 347 348 sub pre_header_initialize { 349 my ($self) = @_; 350 my $r = $self->r; 351 my $ce = $r->ce; 352 my $db = $r->db; 353 my $authz = $r->authz; 354 my $urlpath = $r->urlpath; 355 356 my $setName = $urlpath->arg("setID"); 357 my $problemNumber = $r->urlpath->arg("problemID"); 358 my $userName = $r->param('user'); 359 my $effectiveUserName = $r->param('effectiveUser'); 360 my $key = $r->param('key'); 361 362 my $user = $db->getUser($userName); # checked 363 die "record for user $userName (real user) does not exist." 364 unless defined $user; 365 366 my $effectiveUser = $db->getUser($effectiveUserName); # checked 367 die "record for user $effectiveUserName (effective user) does not exist." 368 unless defined $effectiveUser; 369 370 # obtain the merged set for $effectiveUser 371 my $set = $db->getMergedSet($effectiveUserName, $setName); # checked 372 373 # Database fix (in case of undefined published values) 374 # this is only necessary because some people keep holding to ww1.9 which did not have a published field 375 # make sure published is set to 0 or 1 376 if ( $set and $set->published ne "0" and $set->published ne "1") { 377 my $globalSet = $db->getGlobalSet($set->set_id); 378 $globalSet->published("1"); # defaults to published 379 $db->putGlobalSet($globalSet); 380 $set = $db->getMergedSet($effectiveUserName, $setName); 381 } else { 382 # don't do anything just yet, maybe we're a professor and we're 383 # fabricating a set or haven't assigned it to ourselves just yet 384 } 385 386 # obtain the merged problem for $effectiveUser 387 my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked 388 389 my $editMode = $r->param("editMode"); 390 391 if ($authz->hasPermissions($userName, "modify_problem_sets")) { 392 # professors are allowed to fabricate sets and problems not 393 # assigned to them (or anyone). this allows them to use the 394 # editor to 395 396 # if a User Set does not exist for this user and this set 397 # then we check the Global Set 398 # if that does not exist we create a fake set 399 # if it does, we add fake user data 400 unless (defined $set) { 401 my $userSetClass = $db->{set_user}->{record}; 402 my $globalSet = $db->getGlobalSet($setName); # checked 403 404 if (not defined $globalSet) { 405 $set = fake_set($db); 406 } else { 407 $set = global2user($userSetClass, $globalSet); 408 $set->psvn(0); 409 } 410 } 411 412 # if that is not yet defined obtain the global problem, 413 # convert it to a user problem, and add fake user data 414 unless (defined $problem) { 415 my $userProblemClass = $db->{problem_user}->{record}; 416 my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked 417 # if the global problem doesn't exist either, bail! 418 if(not defined $globalProblem) { 419 my $sourceFilePath = $r->param("sourceFilePath"); 420 # These are problems from setmaker. If declared invalid, they won't come up 421 $self->{invalidProblem} = $self->{invalidSet} = 1 unless defined $sourceFilePath; 422 # die "Problem $problemNumber in set $setName does not exist" unless defined $sourceFilePath; 423 $problem = fake_problem($db); 424 $problem->problem_id(1); 425 $problem->source_file($sourceFilePath); 426 $problem->user_id($effectiveUserName); 427 } else { 428 $problem = global2user($userProblemClass, $globalProblem); 429 $problem->user_id($effectiveUserName); 430 $problem->problem_seed(0); 431 $problem->status(0); 432 $problem->attempted(0); 433 $problem->last_answer(""); 434 $problem->num_correct(0); 435 $problem->num_incorrect(0); 436 } 437 } 438 439 # now we're sure we have valid UserSet and UserProblem objects 440 # yay! 441 442 # now deal with possible editor overrides: 443 444 # if the caller is asking to override the source file, and 445 # editMode calls for a temporary file, do so 446 my $sourceFilePath = $r->param("sourceFilePath"); 447 if (defined $sourceFilePath and 448 (not defined $editMode or $editMode eq "temporaryFile")) { 449 $problem->source_file($sourceFilePath); 450 } 451 452 # if the problem does not have a source file or no source file has been passed in 453 # then this is really an invalid problem (probably from a bad URL) 454 $self->{invalidProblem} = not (defined $sourceFilePath or $problem->source_file); 455 456 # if the caller is asking to override the problem seed, do so 457 my $problemSeed = $r->param("problemSeed"); 458 if (defined $problemSeed) { 459 $problem->problem_seed($problemSeed); 460 } 461 462 my $publishedClass = ($set->published) ? "Published" : "Unpublished"; 463 my $publishedText = ($set->published) ? "visible to students." : "hidden from students."; 464 $self->addmessage(CGI::p("This set is " . CGI::font({class=>$publishedClass}, $publishedText))); 465 } else { 466 467 # A set is valid if it exists and if it is either published or the user is privileged. 468 $self->{invalidSet} = !(defined $set and ($set->published || $authz->hasPermissions($userName, "view_unpublished_sets"))); 469 $self->{invalidProblem} = !(defined $problem and ($set->published || $authz->hasPermissions($userName, "view_unpublished_sets"))); 470 471 $self->addbadmessage(CGI::p("This problem will not count towards your grade.")) if $problem and not $problem->value and not $self->{invalidProblem}; 472 } 473 474 $self->{userName} = $userName; 475 $self->{effectiveUserName} = $effectiveUserName; 476 $self->{user} = $user; 477 $self->{effectiveUser} = $effectiveUser; 478 $self->{set} = $set; 479 $self->{problem} = $problem; 480 $self->{editMode} = $editMode; 481 482 ##### form processing ##### 483 484 # set options from form fields (see comment at top of file for names) 485 my $displayMode = $r->param("displayMode") || $ce->{pg}->{options}->{displayMode}; 486 my $redisplay = $r->param("redisplay"); 487 my $submitAnswers = $r->param("submitAnswers"); 488 my $checkAnswers = $r->param("checkAnswers"); 489 my $previewAnswers = $r->param("previewAnswers"); 490 491 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 492 493 $self->{displayMode} = $displayMode; 494 $self->{redisplay} = $redisplay; 495 $self->{submitAnswers} = $submitAnswers; 496 $self->{checkAnswers} = $checkAnswers; 497 $self->{previewAnswers} = $previewAnswers; 498 $self->{formFields} = $formFields; 499 500 # get result and send to message 501 my $status_message = $r->param("status_message"); 502 $self->addmessage(CGI::p("$status_message")) if $status_message; 503 504 # now that we've set all the necessary variables quit out if the set or problem is invalid 505 return if $self->{invalidSet} || $self->{invalidProblem}; 506 507 ##### permissions ##### 508 509 # are we allowed to view this problem? 510 $self->{isOpen} = after($set->open_date) || $authz->hasPermissions($userName, "view_unopened_sets"); 511 return unless $self->{isOpen}; 512 513 # what does the user want to do? 514 #FIXME There is a problem with checkboxes -- if they are not checked they are invisible. Hence if the default mode in $ce is 1 515 # there is no way to override this. Probably this is ok for the last three options, but it was definitely not ok for showing 516 # saved answers which is normally on, but you want to be able to turn it off! This section should be moved to ContentGenerator 517 # so that you can set these options anywhere. We also need mechanisms for making them sticky. 518 my %want = ( 519 showOldAnswers => defined($r->param("showOldAnswers")) ? $r->param("showOldAnswers") : $ce->{pg}->{options}->{showOldAnswers}, 520 showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers}, 521 showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints}, 522 showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions}, 523 recordAnswers => $submitAnswers, 524 checkAnswers => $checkAnswers, 525 getSubmitButton => 1, 526 ); 527 528 # are certain options enforced? 529 my %must = ( 530 showOldAnswers => 0, 531 showCorrectAnswers => 0, 532 showHints => 0, 533 showSolutions => 0, 534 recordAnswers => ! $authz->hasPermissions($userName, "avoid_recording_answers"), 535 checkAnswers => 0, 536 getSubmitButton => 0, 537 ); 538 539 # does the user have permission to use certain options? 540 my @args = ($user, $effectiveUser, $set, $problem); 541 my %can = ( 542 showOldAnswers => $self->can_showOldAnswers(@args), 543 showCorrectAnswers => $self->can_showCorrectAnswers(@args), 544 showHints => $self->can_showHints(@args), 545 showSolutions => $self->can_showSolutions(@args), 546 recordAnswers => $self->can_recordAnswers(@args, 0), 547 checkAnswers => $self->can_checkAnswers(@args, $submitAnswers), 548 getSubmitButton => $self->can_recordAnswers(@args, $submitAnswers), 549 ); 550 551 # final values for options 552 my %will; 553 foreach (keys %must) { 554 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 555 } 556 557 ##### sticky answers ##### 558 559 if (not ($submitAnswers or $previewAnswers or $checkAnswers) and $will{showOldAnswers}) { 560 # do this only if new answers are NOT being submitted 561 my %oldAnswers = decodeAnswers($problem->last_answer); 562 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; 563 } 564 565 ##### translation ##### 566 567 $WeBWorK::timer->continue("begin pg processing") if defined($WeBWorK::timer); 568 my $pg = WeBWorK::PG->new( 569 $ce, 570 $effectiveUser, 571 $key, 572 $set, 573 $problem, 574 $set->psvn, # FIXME: this field should be removed 575 $formFields, 576 { # translation options 577 displayMode => $displayMode, 578 showHints => $will{showHints}, 579 showSolutions => $will{showSolutions}, 580 refreshMath2img => $will{showHints} || $will{showSolutions}, 581 processAnswers => 1, 582 }, 583 ); 584 585 $WeBWorK::timer->continue("end pg processing") if defined($WeBWorK::timer); 586 587 ##### fix hint/solution options ##### 588 589 $can{showHints} &&= $pg->{flags}->{hintExists} 590 &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; 591 $can{showSolutions} &&= $pg->{flags}->{solutionExists}; 592 593 ##### store fields ##### 594 595 $self->{want} = \%want; 596 $self->{must} = \%must; 597 $self->{can} = \%can; 598 $self->{will} = \%will; 599 $self->{pg} = $pg; 600 } 601 602 sub if_errors($$) { 603 my ($self, $arg) = @_; 604 605 if ($self->{isOpen}) { 606 return $self->{pg}->{flags}->{error_flag} ? $arg : !$arg; 607 } else { 608 return !$arg; 609 } 610 } 611 612 sub head { 613 my ($self) = @_; 614 615 return "" unless $self->{isOpen}; 616 return $self->{pg}->{head_text} if $self->{pg}->{head_text}; 617 } 618 619 # sub options { 620 # my ($self) = @_; 621 # warn "doing options in Problem"; 622 # return "" if $self->{invalidProblem}; 623 # my $sourceFilePathfield = ''; 624 # if($self->r->param("sourceFilePath")) { 625 # $sourceFilePathfield = CGI::hidden(-name => "sourceFilePath", 626 # -value => $self->r->param("sourceFilePath")); 627 # } 628 # 629 # return join("", 630 # CGI::start_form("POST", $self->{r}->uri), 631 # $self->hidden_authen_fields, 632 # $sourceFilePathfield, 633 # CGI::hr(), 634 # CGI::start_div({class=>"viewOptions"}), 635 # $self->viewOptions(), 636 # CGI::end_div(), 637 # CGI::end_form() 638 # ); 639 # } 640 641 sub siblings { 642 my ($self) = @_; 643 my $r = $self->r; 644 my $db = $r->db; 645 my $urlpath = $r->urlpath; 646 647 # can't show sibling problems if the set is invalid 648 return "" if $self->{invalidSet}; 649 650 my $courseID = $urlpath->arg("courseID"); 651 my $setID = $self->{set}->set_id; 652 my $eUserID = $r->param("effectiveUser"); 653 my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID); 654 655 print CGI::start_ul({class=>"LinksMenu"}); 656 print CGI::start_li(); 657 print CGI::span({style=>"font-size:larger"}, "Problems"); 658 print CGI::start_ul(); 659 660 foreach my $problemID (@problemIDs) { 661 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", 662 courseID => $courseID, setID => $setID, problemID => $problemID); 663 print CGI::li(CGI::a( {href=>$self->systemLink($problemPage, 664 params=>{ displayMode => $self->{displayMode}, 665 showOldAnswers => $self->{will}->{showOldAnswers} 666 })}, "Problem $problemID") 667 ); 668 } 669 670 print CGI::end_ul(); 671 print CGI::end_li(); 672 print CGI::end_ul(); 673 674 return ""; 675 } 676 677 sub nav { 678 my ($self, $args) = @_; 679 my $r = $self->r; 680 my $db = $r->db; 681 my $urlpath = $r->urlpath; 682 683 my $courseID = $urlpath->arg("courseID"); 684 my $setID = $self->{set}->set_id if !($self->{invalidSet}); 685 my $problemID = $self->{problem}->problem_id if !($self->{invalidProblem}); 686 my $eUserID = $r->param("effectiveUser"); 687 688 my ($prevID, $nextID); 689 690 if (!$self->{invalidProblem}) { 691 my @problemIDs = $db->listUserProblems($eUserID, $setID); 692 foreach my $id (@problemIDs) { 693 $prevID = $id if $id < $problemID 694 and (not defined $prevID or $id > $prevID); 695 $nextID = $id if $id > $problemID 696 and (not defined $nextID or $id < $nextID); 697 } 698 } 699 700 my @links; 701 702 if ($prevID) { 703 my $prevPage = $urlpath->newFromModule(__PACKAGE__, 704 courseID => $courseID, setID => $setID, problemID => $prevID); 705 push @links, "Previous Problem", $r->location . $prevPage->path, "navPrev"; 706 } else { 707 push @links, "Previous Problem", "", "navPrev"; 708 } 709 710 push @links, "Problem List", $r->location . $urlpath->parent->path, "navProbList"; 711 712 if ($nextID) { 713 my $nextPage = $urlpath->newFromModule(__PACKAGE__, 714 courseID => $courseID, setID => $setID, problemID => $nextID); 715 push @links, "Next Problem", $r->location . $nextPage->path, "navNext"; 716 } else { 717 push @links, "Next Problem", "", "navNext"; 718 } 719 720 my $tail = "&displayMode=".$self->{displayMode}."&showOldAnswers=".$self->{will}->{showOldAnswers}; 721 return $self->navMacro($args, $tail, @links); 722 } 723 724 sub title { 725 my ($self) = @_; 726 727 # using the url arguments won't break if the set/problem are invalid 728 my $setID = $self->r->urlpath->arg("setID"); 729 my $problemID = $self->r->urlpath->arg("problemID"); 730 731 return "$setID: Problem $problemID"; 732 } 733 734 sub body { 735 my $self = shift; 736 my $r = $self->r; 737 my $ce = $r->ce; 738 my $db = $r->db; 739 my $authz = $r->authz; 740 my $urlpath = $r->urlpath; 741 my $user = $r->param('user'); 742 my $effectiveUser = $r->param('effectiveUser'); 743 744 if ($self->{invalidSet}) { 745 return CGI::div({class=>"ResultsWithError"}, 746 CGI::p("The selected homework set (" . $urlpath->arg("setID") . ") is not a valid set for " . $r->param("effectiveUser") . ".")); 747 } 748 749 if ($self->{invalidProblem}) { 750 return CGI::div({class=>"ResultsWithError"}, 751 CGI::p("The selected problem (" . $urlpath->arg("problemID") . ") is not a valid problem for set " . $self->{set}->set_id . ".")); 752 } 753 754 unless ($self->{isOpen}) { 755 return CGI::div({class=>"ResultsWithError"}, 756 CGI::p("This problem is not available because the homework set that contains it is not yet open.")); 757 } 758 # unpack some useful variables 759 my $set = $self->{set}; 760 my $problem = $self->{problem}; 761 my $editMode = $self->{editMode}; 762 my $submitAnswers = $self->{submitAnswers}; 763 my $checkAnswers = $self->{checkAnswers}; 764 my $previewAnswers = $self->{previewAnswers}; 765 my %want = %{ $self->{want} }; 766 my %can = %{ $self->{can} }; 767 my %must = %{ $self->{must} }; 768 my %will = %{ $self->{will} }; 769 my $pg = $self->{pg}; 770 771 my $courseName = $urlpath->arg("courseID"); 772 773 # FIXME: move editor link to top, next to problem number. 774 # format as "[edit]" like we're doing with course info file, etc. 775 # add edit link for set as well. 776 my $editorLink = ""; 777 # if we are here without a real problem set, carry that through 778 my $forced_field = []; 779 $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if 780 ($set->set_id eq 'Undefined_Set'); 781 if ($authz->hasPermissions($user, "modify_problem_sets")) { 782 my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", 783 courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id); 784 my $editorURL = $self->systemLink($editorPage, params=>$forced_field); 785 $editorLink = CGI::a({href=>$editorURL}, "Edit this problem"); 786 } 787 788 ##### translation errors? ##### 789 790 if ($pg->{flags}->{error_flag}) { 791 print $self->errorOutput($pg->{errors}, $pg->{body_text}); 792 print $editorLink; 793 return ""; 794 } 795 796 ##### answer processing ##### 797 $WeBWorK::timer->continue("begin answer processing") if defined($WeBWorK::timer); 798 # if answers were submitted: 799 my $scoreRecordedMessage; 800 my $pureProblem; 801 if ($submitAnswers) { 802 # get a "pure" (unmerged) UserProblem to modify 803 # this will be undefined if the problem has not been assigned to this user 804 $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); # checked 805 if (defined $pureProblem) { 806 # store answers in DB for sticky answers 807 my %answersToStore; 808 my %answerHash = %{ $pg->{answers} }; 809 $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!! 810 foreach (keys %answerHash); 811 812 # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating 813 # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs 814 # however we need to store them. Fortunately they are still in the input form. 815 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}}; 816 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names); 817 818 # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order 819 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names); 820 my $answerString = encodeAnswers(%answersToStore, 821 @answer_order); 822 823 # store last answer to database 824 $problem->last_answer($answerString); 825 $pureProblem->last_answer($answerString); 826 $db->putUserProblem($pureProblem); 827 828 # store state in DB if it makes sense 829 if ($will{recordAnswers}) { 830 $problem->status($pg->{state}->{recorded_score}); 831 $problem->attempted(1); 832 $problem->num_correct($pg->{state}->{num_of_correct_ans}); 833 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 834 $pureProblem->status($pg->{state}->{recorded_score}); 835 $pureProblem->attempted(1); 836 $pureProblem->num_correct($pg->{state}->{num_of_correct_ans}); 837 $pureProblem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 838 if ($db->putUserProblem($pureProblem)) { 839 $scoreRecordedMessage = "Your score was recorded."; 840 } else { 841 $scoreRecordedMessage = "Your score was not recorded because there was a failure in storing the problem record to the database."; 842 } 843 # write to the transaction log, just to make sure 844 writeLog($self->{ce}, "transaction", 845 $problem->problem_id."\t". 846 $problem->set_id."\t". 847 $problem->user_id."\t". 848 $problem->source_file."\t". 849 $problem->value."\t". 850 $problem->max_attempts."\t". 851 $problem->problem_seed."\t". 852 $pureProblem->status."\t". 853 $pureProblem->attempted."\t". 854 $pureProblem->last_answer."\t". 855 $pureProblem->num_correct."\t". 856 $pureProblem->num_incorrect 857 ); 858 } else { 859 if (before($set->open_date) or after($set->due_date)) { 860 $scoreRecordedMessage = "Your score was not recorded because this homework set is closed."; 861 } else { 862 $scoreRecordedMessage = "Your score was not recorded."; 863 } 864 } 865 } else { 866 $scoreRecordedMessage = "Your score was not recorded because this problem has not been assigned to you."; 867 } 868 } 869 870 # logging student answers 871 872 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 873 if ( defined($answer_log ) and defined($pureProblem)) { 874 if ($submitAnswers && !$authz->hasPermissions($effectiveUser, "dont_log_past_answers")) { 875 my $answerString = ""; my $scores = ""; 876 my %answerHash = %{ $pg->{answers} }; 877 # FIXME this is the line 552 error. make sure original student ans is defined. 878 # The fact that it is not defined is probably due to an error in some answer evaluator. 879 # But I think it is useful to suppress this error message in the log. 880 foreach (sort keys %answerHash) { 881 my $orig_ans = $answerHash{$_}->{original_student_ans}; 882 my $student_ans = defined $orig_ans ? $orig_ans : ''; 883 $answerString .= $student_ans."\t"; 884 $scores .= $answerHash{$_}->{score} >= 1 ? "1" : "0"; 885 } 886 $answerString = '' unless defined($answerString); # insure string is defined. 887 writeCourseLog($self->{ce}, "answer_log", 888 join("", 889 '|', $problem->user_id, 890 '|', $problem->set_id, 891 '|', $problem->problem_id, 892 '|', $scores, "\t", 893 time(),"\t", 894 $answerString, 895 ), 896 ); 897 898 } 899 } 900 901 $WeBWorK::timer->continue("end answer processing") if defined($WeBWorK::timer); 902 903 ##### output ##### 904 # custom message for editor 905 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) { 906 if ($editMode eq "temporaryFile") { 907 print CGI::p(CGI::div({class=>'temporaryFile'}, "Viewing temporary file: ", $problem->source_file)); 908 } elsif ($editMode eq "savedFile") { 909 # taken care of in the initialization phase 910 } 911 } 912 print CGI::start_div({class=>"problemHeader"}); 913 914 915 916 # attempt summary 917 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. 918 # until after the due date 919 # do I need to check $will{showCorrectAnswers} to make preflight work?? 920 if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) { 921 # print this if user submitted answers OR requested correct answers 922 923 print $self->attemptResults($pg, 1, 924 $will{showCorrectAnswers}, 925 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); 926 } elsif ($checkAnswers) { 927 # print this if user previewed answers 928 print CGI::div({class=>'ResultsWithError'},"ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED"), CGI::br(); 929 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); 930 # show attempt answers 931 # show correct answers if asked 932 # show attempt results (correctness) 933 # show attempt previews 934 } elsif ($previewAnswers) { 935 # print this if user previewed answers 936 print CGI::div({class=>'ResultsWithError'},"PREVIEW ONLY -- ANSWERS NOT RECORDED"),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); 937 # show attempt answers 938 # don't show correct answers 939 # don't show attempt results (correctness) 940 # show attempt previews 941 } 942 943 print CGI::end_div(); 944 945 # main form 946 print CGI::startform("POST", $r->uri); 947 print $self->hidden_authen_fields; 948 949 print CGI::start_div({class=>"problem"}); 950 print CGI::p($pg->{body_text}); 951 print CGI::p(CGI::b("Note: "), CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg}; 952 print CGI::end_div(); 953 954 print CGI::start_p(); 955 956 if ($can{showCorrectAnswers}) { 957 print CGI::checkbox( 958 -name => "showCorrectAnswers", 959 -checked => $will{showCorrectAnswers}, 960 -label => "Show correct answers", 961 ); 962 } 963 if ($can{showHints}) { 964 print CGI::div({style=>"color:red"}, 965 CGI::checkbox( 966 -name => "showHints", 967 -checked => $will{showHints}, 968 -label => "Show Hints", 969 ) 970 ); 971 } 972 if ($can{showSolutions}) { 973 print CGI::checkbox( 974 -name => "showSolutions", 975 -checked => $will{showSolutions}, 976 -label => "Show Solutions", 977 ); 978 } 979 980 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) { 981 print CGI::br(); 982 } 983 984 print CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers"); 985 if ($can{checkAnswers}) { 986 print CGI::submit(-name=>"checkAnswers", -label=>"Check Answers"); 987 } 988 if ($can{getSubmitButton}) { 989 if ($user ne $effectiveUser) { 990 # if acting as a student, make it clear that answer submissions will 991 # apply to the student's records, not the professor's. 992 print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers for $effectiveUser"); 993 } else { 994 print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers"); 995 } 996 } 997 998 print CGI::end_p(); 999 1000 print CGI::start_div({class=>"scoreSummary"}); 1001 1002 # score summary 1003 my $attempts = $problem->num_correct + $problem->num_incorrect; 1004 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 1005 my $problem_status = $problem->status || 0; 1006 my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number 1007 my ($attemptsLeft, $attemptsLeftNoun); 1008 if ($problem->max_attempts == -1) { 1009 # unlimited attempts 1010 $attemptsLeft = "unlimited"; 1011 $attemptsLeftNoun = "attempts"; 1012 } else { 1013 $attemptsLeft = $problem->max_attempts - $attempts; 1014 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 1015 } 1016 1017 my $setClosed = 0; 1018 my $setClosedMessage; 1019 if (before($set->open_date) or after($set->due_date)) { 1020 $setClosed = 1; 1021 if (before($set->open_date)) { 1022 $setClosedMessage = "This homework set is not yet open."; 1023 } elsif (after($set->due_date)) { 1024 $setClosedMessage = "This homework set is closed."; 1025 } 1026 } 1027 #if (before($set->open_date) or after($set->due_date)) { 1028 # $setClosed = 1; 1029 # $setClosedMessage = "This homework set is closed."; 1030 # if ($authz->hasPermissions($user, "view_answers")) { 1031 # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; 1032 # } else { 1033 # $setClosedMessage .= " Additional attempts will not be recorded."; 1034 # } 1035 #} 1036 1037 my $notCountedMessage = ($problem->value) ? "" : "(This problem will not count towards your grade.)"; 1038 print CGI::p( 1039 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", 1040 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), 1041 $problem->attempted 1042 ? "Your recorded score is $lastScore. $notCountedMessage" . CGI::br() 1043 : "", 1044 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." 1045 ); 1046 print CGI::end_div(); 1047 1048 # save state for viewOptions 1049 print CGI::hidden( 1050 -name => "showOldAnswers", 1051 -value => $will{showOldAnswers} 1052 ), 1053 1054 CGI::hidden( 1055 -name => "displayMode", 1056 -value => $self->{displayMode} 1057 ); 1058 print( CGI::hidden( 1059 -name => 'editMode', 1060 -value => $self->{editMode}, 1061 ) 1062 ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile'; 1063 print( CGI::hidden( 1064 -name => 'sourceFilePath', 1065 -value => $self->{problem}->{source_file} 1066 )) if defined($self->{problem}->{source_file}); 1067 1068 print( CGI::hidden( 1069 -name => 'problemSeed', 1070 -value => $r->param("problemSeed") 1071 )) if defined($r->param("problemSeed")); 1072 1073 # end of main form 1074 print CGI::endform(); 1075 1076 print CGI::start_div({class=>"problemFooter"}); 1077 1078 ## arguments for answer inspection button 1079 #my $prof_url = $ce->{webworkURLs}->{oldProf}; 1080 #my $webworkURL = $ce->{webworkURLs}->{root}; 1081 #my $cgi_url = $prof_url; 1082 #$cgi_url=~ s|/[^/]*$||; # clip profLogin.pl 1083 #my $authen_args = $self->url_authen_args(); 1084 #my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/"; 1085 1086 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", 1087 courseID => $courseName); 1088 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action 1089 1090 # print answer inspection button 1091 if ($authz->hasPermissions($user, "view_answers")) { 1092 print "\n", 1093 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", 1094 $self->hidden_authen_fields,"\n", 1095 CGI::hidden(-name => 'courseID', -value=>$courseName), "\n", 1096 CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n", 1097 CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n", 1098 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", 1099 CGI::p( {-align=>"left"}, 1100 CGI::submit(-name => 'action', -value=>'Show Past Answers') 1101 ), "\n", 1102 CGI::endform(); 1103 } 1104 1105 # feedback form url 1106 my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback", 1107 courseID => $courseName); 1108 my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action 1109 1110 #print feedback form 1111 print 1112 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", 1113 $self->hidden_authen_fields,"\n", 1114 CGI::hidden("module", __PACKAGE__),"\n", 1115 CGI::hidden("set", $set->set_id),"\n", 1116 CGI::hidden("problem", $problem->problem_id),"\n", 1117 CGI::hidden("displayMode", $self->{displayMode}),"\n", 1118 CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", 1119 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", 1120 CGI::hidden("showHints", $will{showHints}),"\n", 1121 CGI::hidden("showSolutions", $will{showSolutions}),"\n", 1122 CGI::p({-align=>"left"}, 1123 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") 1124 ), 1125 CGI::endform(),"\n"; 1126 1127 # FIXME print editor link 1128 print $editorLink; #empty unless it is appropriate to have an editor link. 1129 1130 print CGI::end_div(); 1131 1132 # debugging stuff 1133 if (0) { 1134 print 1135 CGI::hr(), 1136 CGI::h2("debugging information"), 1137 CGI::h3("form fields"), 1138 ref2string($self->{formFields}), 1139 CGI::h3("user object"), 1140 ref2string($self->{user}), 1141 CGI::h3("set object"), 1142 ref2string($set), 1143 CGI::h3("problem object"), 1144 ref2string($problem), 1145 CGI::h3("PG object"), 1146 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 1147 } 1148 1149 return ""; 1150 } 1151 1152 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |