| … | |
… | |
| 41 | my ($self, $setName, $problemNumber) = @_; |
41 | my ($self, $setName, $problemNumber) = @_; |
| 42 | my $courseEnv = $self->{courseEnvironment}; |
42 | my $courseEnv = $self->{courseEnvironment}; |
| 43 | my $r = $self->{r}; |
43 | my $r = $self->{r}; |
| 44 | my $userName = $r->param('user'); |
44 | my $userName = $r->param('user'); |
| 45 | |
45 | |
| 46 | # fix format of setName and problem |
|
|
| 47 | $setName =~ s/^set//; |
|
|
| 48 | $problemNumber =~ s/^prob//; |
|
|
| 49 | |
|
|
| 50 | ##### database setup ##### |
46 | ##### database setup ##### |
| 51 | |
47 | |
| 52 | my $cldb = WeBWorK::DB::Classlist->new($courseEnv); |
48 | my $cldb = WeBWorK::DB::Classlist->new($courseEnv); |
| 53 | my $wwdb = WeBWorK::DB::WW->new($courseEnv); |
49 | my $wwdb = WeBWorK::DB::WW->new($courseEnv); |
| 54 | my $authdb = WeBWorK::DB::Auth->new($courseEnv); |
50 | my $authdb = WeBWorK::DB::Auth->new($courseEnv); |
| … | |
… | |
| 156 | $self->{will} = \%will; |
152 | $self->{will} = \%will; |
| 157 | |
153 | |
| 158 | $self->{pg} = $pg; |
154 | $self->{pg} = $pg; |
| 159 | } |
155 | } |
| 160 | |
156 | |
| 161 | #sub header { |
157 | sub header { |
| 162 | # # *** we need to print $pg->{header_text} here! |
158 | my $self = shift; |
| 163 | #} |
159 | |
|
|
160 | return $self->{pg}->{head_text} if $self->{pg}->{head_text}; |
|
|
161 | } |
| 164 | |
162 | |
| 165 | sub path { |
163 | sub path { |
| 166 | my $self = shift; |
164 | my $self = shift; |
| 167 | my $args = $_[-1]; |
165 | my $args = $_[-1]; |
| 168 | my $setName = $self->{set}->id; |
166 | my $setName = $self->{set}->id; |
| … | |
… | |
| 172 | my $root = $ce->{webworkURLs}->{root}; |
170 | my $root = $ce->{webworkURLs}->{root}; |
| 173 | my $courseName = $ce->{courseName}; |
171 | my $courseName = $ce->{courseName}; |
| 174 | return $self->pathMacro($args, |
172 | return $self->pathMacro($args, |
| 175 | "Home" => "$root", |
173 | "Home" => "$root", |
| 176 | $courseName => "$root/$courseName", |
174 | $courseName => "$root/$courseName", |
| 177 | $setName => "$root/$courseName/set$setName", |
175 | $setName => "$root/$courseName/$setName", |
| 178 | "Problem $problemNumber" => "", |
176 | "Problem $problemNumber" => "", |
| 179 | ); |
177 | ); |
| 180 | } |
178 | } |
| 181 | |
179 | |
| 182 | sub siblings { |
180 | sub siblings { |
| … | |
… | |
| 212 | my $courseName = $ce->{courseName}; |
210 | my $courseName = $ce->{courseName}; |
| 213 | |
211 | |
| 214 | my $wwdb = $self->{wwdb}; |
212 | my $wwdb = $self->{wwdb}; |
| 215 | my $user = $self->{r}->param("user"); |
213 | my $user = $self->{r}->param("user"); |
| 216 | |
214 | |
| 217 | my @links = ("Problem List" => "$root/$courseName/set$setName"); |
215 | my @links = ("Problem List" => "$root/$courseName/$setName"); |
| 218 | |
216 | |
| 219 | my $prevProblem = $wwdb->getProblem($user, $setName, $problemNumber-1); |
217 | my $prevProblem = $wwdb->getProblem($user, $setName, $problemNumber-1); |
| 220 | my $nextProblem = $wwdb->getProblem($user, $setName, $problemNumber+1); |
218 | my $nextProblem = $wwdb->getProblem($user, $setName, $problemNumber+1); |
| 221 | unshift @links, "Previous Problem" => "$root/$courseName/set$setName/prob".$prevProblem->id |
219 | unshift @links, "Previous Problem" => $prevProblem |
| 222 | if $prevProblem; |
220 | ? "$root/$courseName/$setName/".$prevProblem->id |
| 223 | push @links, "Next Problem" => "$root/$courseName/set$setName/prob".$nextProblem->id |
221 | : ""; |
| 224 | if $nextProblem; |
222 | push @links, "Next Problem" => $nextProblem |
|
|
223 | ? "$root/$courseName/$setName/".$nextProblem->id |
|
|
224 | : ""; |
| 225 | |
225 | |
| 226 | return $self->navMacro($args, @links); |
226 | return $self->navMacro($args, @links); |
| 227 | } |
227 | } |
| 228 | |
228 | |
| 229 | sub title { |
229 | sub title { |
| … | |
… | |
| 330 | |
330 | |
| 331 | # main form |
331 | # main form |
| 332 | print |
332 | print |
| 333 | CGI::startform("POST", $r->uri), |
333 | CGI::startform("POST", $r->uri), |
| 334 | $self->hidden_authen_fields, |
334 | $self->hidden_authen_fields, |
|
|
335 | $self->viewOptions, |
| 335 | CGI::p(CGI::i($pg->{result}->{msg})), |
336 | CGI::p(CGI::i($pg->{result}->{msg})), |
| 336 | CGI::p($pg->{body_text}), |
337 | CGI::p($pg->{body_text}), |
| 337 | CGI::p(CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers")), |
338 | CGI::p(CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers")), |
| 338 | $self->viewOptions, |
|
|
| 339 | CGI::endform(); |
339 | CGI::endform(); |
| 340 | |
340 | |
| 341 | # debugging stuff |
341 | # debugging stuff |
| 342 | #print |
342 | #print |
| 343 | # hr(), |
343 | # hr(), |
| … | |
… | |
| 394 | my $correctAnswer = $answerResult->{correct_ans}; |
394 | my $correctAnswer = $answerResult->{correct_ans}; |
| 395 | my $answerScore = $answerResult->{score}; |
395 | my $answerScore = $answerResult->{score}; |
| 396 | my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; |
396 | my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; |
| 397 | |
397 | |
| 398 | $numCorrect += $answerScore > 0; |
398 | $numCorrect += $answerScore > 0; |
| 399 | my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; |
399 | my $resultString = $answerScore ? "correct" : "incorrect"; |
|
|
400 | |
|
|
401 | # get rid of the goofy prefix on the answer names (supposedly, the format |
|
|
402 | # of the answer names is changeable. this only fixes |
|
|
403 | $name =~ s/^AnSwEr//; |
| 400 | |
404 | |
| 401 | my $row = CGI::td($name); |
405 | my $row = CGI::td($name); |
| 402 | $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : ""; |
406 | $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : ""; |
| 403 | $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : ""; |
407 | $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : ""; |
| 404 | $row .= $showAttemptResults ? CGI::td($resultString) : ""; |
408 | $row .= $showAttemptResults ? CGI::td($resultString) : ""; |