Parent Directory
| 
Revision Log
sticky answers work. ha HA! -sam
1 package WeBWorK::ContentGenerator::Problem; 2 use base qw(WeBWorK::ContentGenerator); 3 4 use strict; 5 use warnings; 6 use CGI qw(:html :form); 7 use WeBWorK::Utils qw(ref2string encodeAnswers decodeAnswers); 8 use WeBWorK::PG; 9 use WeBWorK::Form; 10 11 # user 12 # key 13 # 14 # displayMode 15 # showOldAnswers 16 # showCorrectAnswers 17 # showHints 18 # showSolutions 19 # 20 # AnSwEr# - answer blanks in problem 21 # 22 # redisplay - name of the "Redisplay Problem" button 23 # submitAnswers - name of "Submit Answers" button 24 25 sub title { 26 my ($self, $setName, $problemNumber) = @_; 27 my $userName = $self->{r}->param('user'); 28 return "Problem $problemNumber of problem set $setName for $userName"; 29 } 30 31 # TODO: 32 # :) enforce permissions for showCorrectAnswers and showSolutions 33 # (use $PRIV = $mustPRIV || ($canPRIV && $wantPRIV) -- cool syntax!) 34 # 2. if answers were not submitted and there are student answers in the DB, 35 # decode them and put them into $formFields for the translator 36 # 3. Latex2HTML massaging code 37 # 4. store submitted answers hash in database for sticky answers 38 # 5. deal with the results of answer evaluation and grading :p 39 # :) introduce a recordAnswers option, which works on the same principle as 40 # the other permission-based options 41 # 7. make warnings work 42 43 sub body { 44 my ($self, $setName, $problemNumber) = @_; 45 my $courseEnv = $self->{courseEnvironment}; 46 my $r = $self->{r}; 47 my $userName = $r->param('user'); 48 49 # fix format of setName and problem 50 $setName =~ s/^set//; 51 $problemNumber =~ s/^prob//; 52 53 ##### database setup ##### 54 55 my $classlist = WeBWorK::DB::Classlist->new($courseEnv); 56 my $wwdb = WeBWorK::DB::WW->new($courseEnv); 57 my $authdb = WeBWorK::DB::Auth->new($courseEnv); 58 59 my $user = $classlist->getUser($userName); 60 my $set = $wwdb->getSet($userName, $setName); 61 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 62 my $psvn = $wwdb->getPSVN($userName, $setName); 63 my $permissionLevel = $authdb->getPermissions($userName); 64 65 ##### form processing ##### 66 67 # set options from form fields (see comment at top of file for names) 68 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 69 my $redisplay = $r->param("redisplay"); 70 my $submitAnswers = $r->param("submitAnswers"); 71 72 my $wantShowOldAnswers = $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}; 73 my $wantShowCorrectAnswers = $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}; 74 my $wantShowHints = $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}; 75 my $wantShowSolutions = $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}; 76 my $wantRecordAnswers = $r->param("recordAnswers") || 1; 77 78 # coerce form fields into CGI::Vars format 79 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 80 81 ##### permissions ##### 82 83 # does the user have permission to use certain options? 84 my $canShowOldAnswers = 1; 85 my $canShowCorrectAnswers = canShowCorrectAnswers($permissionLevel, $set->answer_date); 86 my $canShowHints = 1; 87 my $canShowSolutions = canShowSolutions($permissionLevel, $set->answer_date); 88 my $canRecordAnswers = canRecordAnswers($permissionLevel, $set->open_date, $set->due_date); 89 90 # are certain options enforced? 91 my $mustShowOldAnswers = 0; 92 my $mustShowCorrectAnswers = 0; 93 my $mustShowHints = 0; 94 my $mustShowSolutions = 0; 95 my $mustRecordAnswers = mustRecordAnswers($permissionLevel); 96 97 # final values for options 98 my $showOldAnswers = $mustShowOldAnswers || ($canShowOldAnswers && $wantShowOldAnswers ); 99 my $showCorrectAnswers = $mustShowCorrectAnswers || ($canShowCorrectAnswers && $wantShowCorrectAnswers); 100 my $showHints = $mustShowHints || ($canShowHints && $wantShowHints ); 101 my $showSolutions = $mustShowSolutions || ($canShowSolutions && $wantShowSolutions ); 102 my $recordAnswers = $mustRecordAnswers || ($canRecordAnswers && $wantRecordAnswers ); 103 104 ##### sticky answers ##### 105 106 # [TODO #2] 107 108 if (not $submitAnswers and $showOldAnswers) { 109 # only do this if new answers are NOT being submitted 110 my %oldAnswers = decodeAnswers($problem->last_answer); 111 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; 112 } 113 114 ##### translation ##### 115 116 my $pg = WeBWorK::PG->new( 117 $courseEnv, 118 $r->param('user'), 119 $r->param('key'), 120 $setName, 121 $problemNumber, 122 { # translation options 123 displayMode => $displayMode, 124 showHints => $showHints, 125 showSolutions => $showSolutions, 126 # try leaving processAnswers on all the time: 127 processAnswers => 1, #$submitAnswers ? 1 : 0, 128 }, 129 $formFields 130 ); 131 132 # handle any errors in translation 133 if ($pg->{flags}->{error_flag}) { 134 # there was an error in translation 135 print 136 h2("Software Error"), 137 translationError($pg->{errors}, $pg->{body_text}); 138 139 return ""; 140 } 141 142 # massage LaTeX2HTML [TODO #3] 143 144 ##### answer processing ##### 145 146 # if answers were submitted: 147 if ($submitAnswers) { 148 # store answers in DB for sticky answers [TODO #4] 149 my %answersToStore; 150 my %answerHash = %{ $pg->{answers} }; 151 $answersToStore{$_} = $answerHash{$_}->{original_student_ans} 152 foreach (keys %answerHash); 153 my $answerString = encodeAnswers(%answersToStore, 154 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); 155 $problem->last_answer($answerString); 156 $wwdb->setProblem($problem); 157 158 # store score in DB if it makes sense [TODO #5] 159 160 # print the answer summary table 161 print 162 h3("Results of your latest attempt"), 163 attemptResults($pg, $showCorrectAnswers, 164 $pg->{flags}->{showPartialCorrectAnswers}), 165 hr(); 166 } 167 168 ##### output ##### 169 170 # view options 171 # what i'd really like to do here is: 172 # - preserve the answers currently in the form fields 173 # - display the answer summary box 174 # - NOT record answers UNDER ANY CIRCUMSTANCES! 175 176 # main form 177 print 178 startform("POST", $r->uri), 179 $self->hidden_authen_fields, 180 p($pg->{body_text}), 181 p(submit(-name=>"submitAnswers", -label=>"Submit Answers")), 182 viewOptions($displayMode, $showOldAnswers, $showCorrectAnswers, 183 $showHints, $showSolutions), 184 endform(), 185 hr(); 186 187 # debugging stuff 188 print 189 h2("debugging information"), 190 h3("form fields"), 191 ref2string($formFields), 192 h3("user object"), 193 ref2string($user), 194 h3("set object"), 195 ref2string($set), 196 h3("problem object"), 197 ref2string($problem), 198 h3("PG object"), 199 ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 200 201 return ""; 202 } 203 204 # ----- 205 206 sub translationError($$) { 207 my ($error, $details) = @_; 208 return 209 p(<<EOF), 210 WeBWorK has encountered a software error while attempting to process this problem. 211 It is likely that there is an error in the problem itself. 212 If you are a student, contact your professor to have the error corrected. 213 If you are a professor, please consut the error output below for more informaiton. 214 EOF 215 h3("Error messages"), blockquote(pre($error)), 216 h3("Error context"), blockquote(pre($details)); 217 } 218 219 sub attemptResults($$$) { 220 my $pg = shift; 221 my $showCorrectAnswers = shift; 222 my $showAttemptResults = shift; 223 my $problemResult = $pg->{result}; # the overall result of the problem 224 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 225 226 my $header = th("answer") . th("attempt"); 227 $header .= $showCorrectAnswers ? th("correct") : ""; 228 $header .= $showAttemptResults ? th("result") : ""; 229 $header .= th("messages"); 230 my @tableRows = ( $header ); 231 my $numCorrect; 232 foreach my $name (@answerNames) { 233 my $answerResult = $pg->{answers}->{$name}; 234 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 235 my $correctAnswer = $answerResult->{correct_ans}; 236 my $answerScore = $answerResult->{score}; 237 my $answerMessage = $answerResult->{ans_message}; 238 239 $numCorrect += $answerScore > 0; 240 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 241 242 my $row = td($name) . td($studentAnswer); 243 $row .= $showCorrectAnswers ? td($correctAnswer) : ""; 244 $row .= $showAttemptResults ? td($resultString) : ""; 245 $row .= $answerMessage ? td($answerMessage) : ""; 246 push @tableRows, $row; 247 } 248 249 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 250 my $message = i($problemResult->{msg}); 251 my $summary = "You answered $numCorrect questions out of " 252 . scalar @answerNames . " correct, for a score of $scorePercent."; 253 return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary); 254 } 255 256 sub viewOptions($$$$$) { 257 my ($displayMode, $showOldAnswers, $showCorrectAnswers, 258 $showHints, $showSolutions) = @_; 259 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, 260 "View equations as: ", 261 radio_group( 262 -name => "displayMode", 263 -values => ['plainText', 'formattedText', 'images'], 264 -default => $displayMode, 265 -labels => { 266 plainText => "plain text", 267 formattedText => "formatted text", 268 images => "images", 269 } 270 ), br(), 271 "Show: ", 272 checkbox( 273 -name => "showOldAnswers", 274 -checked => $showOldAnswers, 275 -label => "Old answers", 276 ), " ", 277 checkbox( 278 -name => "showCorrectAnswers", 279 -checked => $showCorrectAnswers, 280 -label => "Correct answers", 281 ), " ", 282 checkbox( 283 -name => "showHints", 284 -checked => $showHints, 285 -label => "Hints", 286 ), " ", 287 checkbox( 288 -name => "showSolutions", 289 -checked => $showSolutions, 290 -label => "Solutions", 291 ), br(), 292 submit(-name=>"redisplay", -label=>"Redisplay Problem"), 293 ); 294 } 295 296 # ----- 297 298 # this stuff should be abstracted out into the permissions system 299 # however, the permission system only knows about things in the 300 # course environment and the username. hmmm... 301 302 sub canShowCorrectAnswers($$) { 303 my ($permissionLevel, $answerDate) = @_; 304 return $permissionLevel > 0 || time > $answerDate; 305 } 306 307 sub canShowSolutions($$) { 308 my ($permissionLevel, $answerDate) = @_; 309 return canShowCorrectAnswers($permissionLevel, $answerDate); 310 } 311 312 sub canRecordAnswers($$$) { 313 my ($permissionLevel, $openDate, $dueDate) = @_; 314 return $permissionLevel > 0 || (time >= $openDate && time <= $dueDate); 315 } 316 317 sub mustRecordAnswers($) { 318 my ($permissionLevel) = @_; 319 return $permissionLevel == 0; 320 } 321 322 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |