Parent Directory
| 
Revision Log
made progress towards working hardcopy generation. next, i have to fix the call to pdflatex. screw pip. it's not working right, and it doesn't give me any speed gain, since latex has to goofily write the WHOLE DAMN FILE in whatever order it pleases before letting me have it. -sam
1 ################################################################################ 2 # WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::ContentGenerator::Problem; 7 8 =head1 NAME 9 10 WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. 11 12 =cut 13 14 use strict; 15 use warnings; 16 use base qw(WeBWorK::ContentGenerator); 17 use CGI qw(); 18 use WeBWorK::Form; 19 use WeBWorK::PG; 20 use WeBWorK::Utils qw(ref2string encodeAnswers decodeAnswers); 21 22 # TODO: 23 # 7. make warnings work 24 25 ############################################################ 26 # 27 # user 28 # key 29 # 30 # displayMode 31 # showOldAnswers 32 # showCorrectAnswers 33 # showHints 34 # showSolutions 35 # 36 # AnSwEr# - answer blanks in problem 37 # 38 # redisplay - name of the "Redisplay Problem" button 39 # submitAnswers - name of "Submit Answers" button 40 # 41 ############################################################ 42 43 sub pre_header_initialize { 44 my ($self, $setName, $problemNumber) = @_; 45 my $courseEnv = $self->{courseEnvironment}; 46 my $r = $self->{r}; 47 my $userName = $r->param('user'); 48 49 # make sure $problemNumber is numeric (see PG.pm) 50 die "Problem must be numeric!\n" unless $problemNumber =~ /^\d+$/; 51 52 # fix format of setName and problem 53 $setName =~ s/^set//; 54 $problemNumber =~ s/^prob//; 55 56 ##### database setup ##### 57 58 my $cldb = WeBWorK::DB::Classlist->new($courseEnv); 59 my $wwdb = WeBWorK::DB::WW->new($courseEnv); 60 my $authdb = WeBWorK::DB::Auth->new($courseEnv); 61 62 my $user = $cldb->getUser($userName); 63 my $set = $wwdb->getSet($userName, $setName); 64 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 65 my $permissionLevel = $authdb->getPermissions($userName); 66 67 ##### form processing ##### 68 69 # set options from form fields (see comment at top of file for names) 70 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 71 my $redisplay = $r->param("redisplay"); 72 my $submitAnswers = $r->param("submitAnswers"); 73 74 # coerce form fields into CGI::Vars format 75 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 76 77 ##### permissions ##### 78 79 # what does the user want to do? 80 my %want = ( 81 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, 82 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, 83 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, 84 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, 85 recordAnswers => $r->param("recordAnswers") || 1, 86 ); 87 88 # are certain options enforced? 89 my %must = ( 90 showOldAnswers => 0, 91 showCorrectAnswers => 0, 92 showHints => 0, 93 showSolutions => 0, 94 recordAnswers => mustRecordAnswers($permissionLevel), 95 ); 96 97 # does the user have permission to use certain options? 98 my %can = ( 99 showOldAnswers => 1, 100 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date), 101 showHints => 1, 102 showSolutions => canShowSolutions($permissionLevel, $set->answer_date), 103 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, 104 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), 105 # num_correct+num_incorrect+1 -- as this happens before updating $problem 106 ); 107 108 # final values for options 109 my %will; 110 foreach(keys %must) { 111 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 112 } 113 114 ##### sticky answers ##### 115 116 if (not $submitAnswers and $will{showOldAnswers}) { 117 # do this only if new answers are NOT being submitted 118 my %oldAnswers = decodeAnswers($problem->last_answer); 119 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; 120 } 121 122 ##### translation ##### 123 124 my $pg = WeBWorK::PG->new( 125 $courseEnv, 126 $r->param('user'), 127 $r->param('key'), 128 $setName, 129 $problemNumber, 130 { # translation options 131 displayMode => $displayMode, 132 showHints => $will{showHints}, 133 showSolutions => $will{showSolutions}, 134 refreshMath2img => $will{showHints} || $will{showSolutions}, 135 # try leaving processAnswers on all the time? 136 processAnswers => 1, #$submitAnswers ? 1 : 0, 137 }, 138 $formFields 139 ); 140 141 ##### store fields ##### 142 143 $self->{cldb} = $cldb; 144 $self->{wwdb} = $wwdb; 145 $self->{authdb} = $authdb; 146 147 $self->{user} = $user; 148 $self->{set} = $set; 149 $self->{problem} = $problem; 150 $self->{permissionLevel} = $permissionLevel; 151 152 $self->{displayMode} = $displayMode; 153 $self->{redisplay} = $redisplay; 154 $self->{submitAnswers} = $submitAnswers; 155 $self->{formFields} = $formFields; 156 157 $self->{want} = \%want; 158 $self->{must} = \%must; 159 $self->{can} = \%can; 160 $self->{will} = \%will; 161 162 $self->{pg} = $pg; 163 } 164 165 #sub header { 166 # # *** we need to print $pg->{header_text} here! 167 #} 168 169 sub path { 170 my $self = shift; 171 my $args = $_[-1]; 172 my $setName = $self->{set}->id; 173 my $problemNumber = $self->{problem}->id; 174 175 my $ce = $self->{courseEnvironment}; 176 my $root = $ce->{webworkURLs}->{root}; 177 my $courseName = $ce->{courseName}; 178 return $self->pathMacro($args, 179 "Home" => "$root", 180 $courseName => "$root/$courseName", 181 $setName => "$root/$courseName/set$setName", 182 "Problem $problemNumber" => "", 183 ); 184 } 185 186 sub siblings { 187 my $self = shift; 188 my $setName = $self->{set}->id; 189 my $problemNumber = $self->{problem}->id; 190 191 my $ce = $self->{courseEnvironment}; 192 my $root = $ce->{webworkURLs}->{root}; 193 my $courseName = $ce->{courseName}; 194 195 my $wwdb = $self->{wwdb}; 196 my $user = $self->{r}->param("user"); 197 my @problems; 198 push @problems, $wwdb->getProblem($user, $setName, $_) 199 foreach ($wwdb->getProblems($user, $setName)); 200 foreach my $problem (sort { $a->id <=> $b->id } @problems) { 201 print CGI::a({-href=>"$root/$courseName/$setName/".$problem->id."/?" 202 . $self->url_authen_args}, "Problem ".$problem->id), CGI::br(); 203 } 204 } 205 206 sub nav { 207 my $self = shift; 208 my $args = $_[-1]; 209 my $setName = $self->{set}->id; 210 my $problemNumber = $self->{problem}->id; 211 212 my $ce = $self->{courseEnvironment}; 213 my $root = $ce->{webworkURLs}->{root}; 214 my $courseName = $ce->{courseName}; 215 216 my $wwdb = $self->{wwdb}; 217 my $user = $self->{r}->param("user"); 218 219 my @links = ("Problem List" => "$root/$courseName/set$setName"); 220 221 my $prevProblem = $wwdb->getProblem($user, $setName, $problemNumber-1); 222 my $nextProblem = $wwdb->getProblem($user, $setName, $problemNumber+1); 223 unshift @links, "Previous Problem" => "$root/$courseName/set$setName/prob".$prevProblem->id 224 if $prevProblem; 225 push @links, "Next Problem" => "$root/$courseName/set$setName/prob".$nextProblem->id 226 if $nextProblem; 227 228 return $self->navMacro($args, @links); 229 } 230 231 sub title { 232 my $self = shift; 233 my $setName = $self->{set}->id; 234 my $problemNumber = $self->{problem}->id; 235 236 return "$setName : Problem $problemNumber"; 237 } 238 239 sub body { 240 my $self = shift; 241 242 #$self->prepare(@_); 243 244 # unpack some useful variables 245 my $r = $self->{r}; 246 my $wwdb = $self->{wwdb}; 247 my $set = $self->{set}; 248 my $problem = $self->{problem}; 249 my $permissionLevel = $self->{permissionLevel}; 250 my $submitAnswers = $self->{submitAnswers}; 251 my %will = %{ $self->{will} }; 252 my $pg = $self->{pg}; 253 254 ##### translation errors? ##### 255 256 if ($pg->{flags}->{error_flag}) { 257 print translationError($pg->{errors}, $pg->{body_text}); 258 return ""; 259 } 260 261 ##### answer processing ##### 262 263 # if answers were submitted: 264 if ($submitAnswers) { 265 # store answers in DB for sticky answers 266 my %answersToStore; 267 my %answerHash = %{ $pg->{answers} }; 268 $answersToStore{$_} = $answerHash{$_}->{original_student_ans} 269 foreach (keys %answerHash); 270 my $answerString = encodeAnswers(%answersToStore, 271 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); 272 $problem->last_answer($answerString); 273 $wwdb->setProblem($problem); 274 275 # store state in DB if it makes sense 276 if ($will{recordAnswers}) { 277 $problem->attempted(1); 278 $problem->status($pg->{state}->{recorded_score}); 279 $problem->num_correct($pg->{state}->{num_of_correct_ans}); 280 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 281 $wwdb->setProblem($problem); 282 } 283 } 284 285 ##### output ##### 286 287 # attempt summary 288 if ($submitAnswers or $will{showCorrectAnswers}) { 289 # print this if user submitted answers OR requested correct answers 290 print attemptResults($pg, $submitAnswers, $will{showCorrectAnswers}, 291 $pg->{flags}->{showPartialCorrectAnswers}); 292 } 293 294 # score summary 295 my $attempts = $problem->num_correct + $problem->num_incorrect; 296 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 297 my $lastScore = int ($problem->status * 100) . "%"; 298 my ($attemptsLeft, $attemptsLeftNoun); 299 if ($problem->max_attempts == -1) { 300 # unlimited attempts 301 $attemptsLeft = "unlimited"; 302 $attemptsLeftNoun = "attempts"; 303 } else { 304 $attemptsLeft = $problem->max_attempts - $attempts; 305 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 306 } 307 my $setClosedMessage; 308 if (time < $set->open_date or time > $set->due_date) { 309 $setClosedMessage = "This problem set is closed."; 310 if ($permissionLevel > 0) { 311 $setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded."; 312 } else { 313 $setClosedMessage .= " Additional attempts will not be recorded."; 314 } 315 } 316 print CGI::p( 317 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), 318 $problem->attempted 319 ? "Your recorded score is $lastScore." . CGI::br() 320 : "", 321 "You have $attemptsLeft $attemptsLeftNoun remaining.", CGI::br(), 322 $setClosedMessage, 323 ); 324 325 # BY THE WAY.......... 326 # we have to figure out some way to tell the student if their NEW answer, 327 # on THIS attempt, has been recorded. however, this is decided in part by 328 # the grader, so is there any way for us to know? we can rule out several 329 # cases where the answer is NOT being recorded, because of things decided 330 # in &canRecordAnswers... 331 332 print CGI::hr(); 333 334 # main form 335 print 336 CGI::startform("POST", $r->uri), 337 $self->hidden_authen_fields, 338 CGI::p(CGI::i($pg->{result}->{msg})), 339 CGI::p($pg->{body_text}), 340 CGI::p(CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers")), 341 $self->viewOptions, 342 CGI::endform(); 343 344 # debugging stuff 345 #print 346 # hr(), 347 # h2("debugging information"), 348 # h3("form fields"), 349 # ref2string($formFields), 350 # h3("user object"), 351 # ref2string($user), 352 # h3("set object"), 353 # ref2string($set), 354 # h3("problem object"), 355 # ref2string($problem), 356 # h3("PG object"), 357 # ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 358 359 return ""; 360 } 361 362 ##### output utilities ##### 363 364 sub translationError($$) { 365 my ($error, $details) = @_; 366 return 367 CGI::h2("Software Error"), 368 CGI::p(<<EOF), 369 WeBWorK has encountered a software error while attempting to process this problem. 370 It is likely that there is an error in the problem itself. 371 If you are a student, contact your professor to have the error corrected. 372 If you are a professor, please consut the error output below for more informaiton. 373 EOF 374 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)), 375 CGI::h3("Error context"), CGI::blockquote(CGI::pre($details)); 376 } 377 378 sub attemptResults($$$) { 379 my $pg = shift; 380 my $showAttemptAnswers = shift; 381 my $showCorrectAnswers = shift; 382 my $showAttemptResults = $showAttemptAnswers && shift; 383 my $problemResult = $pg->{result}; # the overall result of the problem 384 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 385 386 my $header = CGI::th("answer"); 387 $header .= $showAttemptAnswers ? CGI::th("attempt") : ""; 388 $header .= $showCorrectAnswers ? CGI::th("correct") : ""; 389 $header .= $showAttemptResults ? CGI::th("result") : ""; 390 $header .= $showAttemptAnswers ? CGI::th("messages") : ""; 391 my @tableRows = ( $header ); 392 my $numCorrect; 393 foreach my $name (@answerNames) { 394 my $answerResult = $pg->{answers}->{$name}; 395 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 396 my $correctAnswer = $answerResult->{correct_ans}; 397 my $answerScore = $answerResult->{score}; 398 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; 399 400 $numCorrect += $answerScore > 0; 401 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 402 403 my $row = CGI::td($name); 404 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : ""; 405 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : ""; 406 $row .= $showAttemptResults ? CGI::td($resultString) : ""; 407 $row .= $answerMessage ? CGI::td($answerMessage) : ""; 408 push @tableRows, $row; 409 } 410 411 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions"; 412 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 413 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of " 414 . scalar @answerNames . " correct, for a score of $scorePercent."; 415 return CGI::table({-border=>1}, CGI::Tr(\@tableRows)) . CGI::p($summary); 416 } 417 418 sub viewOptions($) { 419 my $self = shift; 420 my $displayMode = $self->{displayMode}; 421 my %must = %{ $self->{must} }; 422 my %can = %{ $self->{can} }; 423 my %will = %{ $self->{will} }; 424 425 my $optionLine; 426 $can{showOldAnswers} and $optionLine .= join "", 427 "Show: ", 428 CGI::checkbox( 429 -name => "showOldAnswers", 430 -checked => $will{showOldAnswers}, 431 -label => "Saved answers", 432 ), " "; 433 $can{showCorrectAnswers} and $optionLine .= join "", 434 CGI::checkbox( 435 -name => "showCorrectAnswers", 436 -checked => $will{showCorrectAnswers}, 437 -label => "Correct answers", 438 ), " "; 439 $can{showHints} and $optionLine .= join "", 440 CGI::checkbox( 441 -name => "showHints", 442 -checked => $will{showHints}, 443 -label => "Hints", 444 ), " "; 445 $can{showSolutions} and $optionLine .= join "", 446 CGI::checkbox( 447 -name => "showSolutions", 448 -checked => $will{showSolutions}, 449 -label => "Solutions", 450 ), " "; 451 $optionLine and $optionLine .= join "", CGI::br(); 452 453 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, 454 "View equations as: ", 455 CGI::radio_group( 456 -name => "displayMode", 457 -values => ['plainText', 'formattedText', 'images'], 458 -default => $displayMode, 459 -labels => { 460 plainText => "plain text", 461 formattedText => "formatted text", 462 images => "images", 463 } 464 ), CGI::br(), 465 $optionLine, 466 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"), 467 ); 468 } 469 470 ##### permission queries ##### 471 472 # this stuff should be abstracted out into the permissions system 473 # however, the permission system only knows about things in the 474 # course environment and the username. hmmm... 475 476 # also, i should fix these so that they have a consistent calling 477 # format -- perhaps: 478 # canPERM($courseEnv, $user, $set, $problem, $permissionLevel) 479 480 sub canShowCorrectAnswers($$) { 481 my ($permissionLevel, $answerDate) = @_; 482 return $permissionLevel > 0 || time > $answerDate; 483 } 484 485 sub canShowSolutions($$) { 486 my ($permissionLevel, $answerDate) = @_; 487 return canShowCorrectAnswers($permissionLevel, $answerDate); 488 } 489 490 sub canRecordAnswers($$$$$) { 491 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; 492 my $permHigh = $permissionLevel > 0; 493 my $timeOK = time >= $openDate && time <= $dueDate; 494 my $attemptsOK = $attempts <= $maxAttempts; 495 return $permHigh || ($timeOK && $attemptsOK); 496 } 497 498 sub mustRecordAnswers($) { 499 my ($permissionLevel) = @_; 500 return $permissionLevel == 0; 501 } 502 503 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |