| … | |
… | |
| 58 | my $set = $wwdb->getSet($effectiveUserName, $setName); |
58 | my $set = $wwdb->getSet($effectiveUserName, $setName); |
| 59 | my $problem = $wwdb->getProblem($effectiveUserName, $setName, $problemNumber); |
59 | my $problem = $wwdb->getProblem($effectiveUserName, $setName, $problemNumber); |
| 60 | my $psvn = $wwdb->getPSVN($effectiveUserName, $setName); |
60 | my $psvn = $wwdb->getPSVN($effectiveUserName, $setName); |
| 61 | my $permissionLevel = $authdb->getPermissions($userName); |
61 | my $permissionLevel = $authdb->getPermissions($userName); |
| 62 | |
62 | |
|
|
63 | $self->{cldb} = $cldb; |
|
|
64 | $self->{wwdb} = $wwdb; |
|
|
65 | $self->{authdb} = $authdb; |
|
|
66 | |
|
|
67 | $self->{userName} = $userName; |
|
|
68 | $self->{user} = $user; |
|
|
69 | $self->{effectiveUser} = $effectiveUser; |
|
|
70 | $self->{set} = $set; |
|
|
71 | $self->{problem} = $problem; |
|
|
72 | $self->{permissionLevel} = $permissionLevel; |
|
|
73 | |
| 63 | ##### form processing ##### |
74 | ##### form processing ##### |
| 64 | |
75 | |
| 65 | # set options from form fields (see comment at top of file for names) |
76 | # set options from form fields (see comment at top of file for names) |
| 66 | my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; |
77 | my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; |
| 67 | my $redisplay = $r->param("redisplay"); |
78 | my $redisplay = $r->param("redisplay"); |
| … | |
… | |
| 70 | my $previewAnswers = $r->param("previewAnswers"); |
81 | my $previewAnswers = $r->param("previewAnswers"); |
| 71 | |
82 | |
| 72 | # coerce form fields into CGI::Vars format |
83 | # coerce form fields into CGI::Vars format |
| 73 | my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; |
84 | my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; |
| 74 | |
85 | |
|
|
86 | $self->{displayMode} = $displayMode; |
|
|
87 | $self->{redisplay} = $redisplay; |
|
|
88 | $self->{submitAnswers} = $submitAnswers; |
|
|
89 | $self->{checkAnswers} = $checkAnswers; |
|
|
90 | $self->{previewAnswers} = $previewAnswers; |
|
|
91 | $self->{formFields} = $formFields; |
|
|
92 | |
| 75 | ##### permissions ##### |
93 | ##### permissions ##### |
|
|
94 | |
|
|
95 | # are we allowed to view this problem? |
|
|
96 | $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0; |
|
|
97 | return unless $self->{isOpen}; |
| 76 | |
98 | |
| 77 | # what does the user want to do? |
99 | # what does the user want to do? |
| 78 | my %want = ( |
100 | my %want = ( |
| 79 | showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, |
101 | showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, |
| 80 | showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, |
102 | showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, |
| … | |
… | |
| 142 | $can{showHints} &&= $pg->{flags}->{hintExists}; |
164 | $can{showHints} &&= $pg->{flags}->{hintExists}; |
| 143 | $can{showSolutions} &&= $pg->{flags}->{solutionExists}; |
165 | $can{showSolutions} &&= $pg->{flags}->{solutionExists}; |
| 144 | |
166 | |
| 145 | ##### store fields ##### |
167 | ##### store fields ##### |
| 146 | |
168 | |
| 147 | $self->{cldb} = $cldb; |
|
|
| 148 | $self->{wwdb} = $wwdb; |
|
|
| 149 | $self->{authdb} = $authdb; |
|
|
| 150 | |
|
|
| 151 | $self->{userName} = $userName; |
|
|
| 152 | $self->{user} = $user; |
|
|
| 153 | $self->{effectiveUser} = $effectiveUser; |
|
|
| 154 | $self->{set} = $set; |
|
|
| 155 | $self->{problem} = $problem; |
|
|
| 156 | $self->{permissionLevel} = $permissionLevel; |
|
|
| 157 | |
|
|
| 158 | $self->{displayMode} = $displayMode; |
|
|
| 159 | $self->{redisplay} = $redisplay; |
|
|
| 160 | $self->{submitAnswers} = $submitAnswers; |
|
|
| 161 | $self->{checkAnswers} = $checkAnswers; |
|
|
| 162 | $self->{previewAnswers} = $previewAnswers; |
|
|
| 163 | $self->{formFields} = $formFields; |
|
|
| 164 | |
|
|
| 165 | $self->{want} = \%want; |
169 | $self->{want} = \%want; |
| 166 | $self->{must} = \%must; |
170 | $self->{must} = \%must; |
| 167 | $self->{can} = \%can; |
171 | $self->{can} = \%can; |
| 168 | $self->{will} = \%will; |
172 | $self->{will} = \%will; |
| 169 | |
173 | |
| 170 | $self->{pg} = $pg; |
174 | $self->{pg} = $pg; |
| 171 | } |
175 | } |
| 172 | |
176 | |
| 173 | sub if_warnings($$) { |
177 | sub if_warnings($$) { |
| 174 | my ($self, $arg) = @_; |
178 | my ($self, $arg) = @_; |
|
|
179 | return 0 unless $self->{isOpen}; |
| 175 | return $self->{pg}->{warnings} ne ""; |
180 | return $self->{pg}->{warnings} ne ""; |
| 176 | } |
181 | } |
| 177 | |
182 | |
| 178 | sub if_errors($$) { |
183 | sub if_errors($$) { |
| 179 | my ($self, $arg) = @_; |
184 | my ($self, $arg) = @_; |
|
|
185 | return 0 unless $self->{isOpen}; |
| 180 | return $self->{pg}->{flags}->{error_flag}; |
186 | return $self->{pg}->{flags}->{error_flag}; |
| 181 | } |
187 | } |
| 182 | |
188 | |
| 183 | sub head { |
189 | sub head { |
| 184 | my $self = shift; |
190 | my $self = shift; |
| 185 | |
191 | return "" unless $self->{isOpen}; |
| 186 | return $self->{pg}->{head_text} if $self->{pg}->{head_text}; |
192 | return $self->{pg}->{head_text} if $self->{pg}->{head_text}; |
| 187 | } |
193 | } |
| 188 | |
194 | |
| 189 | sub path { |
195 | sub path { |
| 190 | my $self = shift; |
196 | my $self = shift; |
| … | |
… | |
| 262 | return "$setName : Problem $problemNumber"; |
268 | return "$setName : Problem $problemNumber"; |
| 263 | } |
269 | } |
| 264 | |
270 | |
| 265 | sub body { |
271 | sub body { |
| 266 | my $self = shift; |
272 | my $self = shift; |
|
|
273 | |
|
|
274 | unless ($self->{isOpen}) { |
|
|
275 | return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open.")); |
|
|
276 | } |
| 267 | |
277 | |
| 268 | # unpack some useful variables |
278 | # unpack some useful variables |
| 269 | my $r = $self->{r}; |
279 | my $r = $self->{r}; |
| 270 | my $wwdb = $self->{wwdb}; |
280 | my $wwdb = $self->{wwdb}; |
| 271 | my $set = $self->{set}; |
281 | my $set = $self->{set}; |
| … | |
… | |
| 428 | if ($pg->{warnings} ne "") { |
438 | if ($pg->{warnings} ne "") { |
| 429 | print CGI::hr(), $self->warningOutput($pg->{warnings}); |
439 | print CGI::hr(), $self->warningOutput($pg->{warnings}); |
| 430 | } |
440 | } |
| 431 | |
441 | |
| 432 | # debugging stuff |
442 | # debugging stuff |
|
|
443 | if (1) { |
| 433 | #print |
444 | print |
| 434 | # CGI::hr(), |
445 | CGI::hr(), |
| 435 | # CGI::h2("debugging information"), |
446 | CGI::h2("debugging information"), |
| 436 | # CGI::h3("form fields"), |
447 | CGI::h3("form fields"), |
| 437 | # ref2string($self->{formFields}), |
448 | ref2string($self->{formFields}), |
| 438 | # CGI::h3("user object"), |
449 | CGI::h3("user object"), |
| 439 | # ref2string($self->{user}), |
450 | ref2string($self->{user}), |
| 440 | # CGI::h3("set object"), |
451 | CGI::h3("set object"), |
| 441 | # ref2string($set), |
452 | ref2string($set), |
| 442 | # CGI::h3("problem object"), |
453 | CGI::h3("problem object"), |
| 443 | # ref2string($problem), |
454 | ref2string($problem), |
| 444 | # CGI::h3("PG object"), |
455 | CGI::h3("PG object"), |
| 445 | # ref2string($pg, {'WeBWorK::PG::Translator' => 1}); |
456 | ref2string($pg, {'WeBWorK::PG::Translator' => 1}); |
|
|
457 | } |
| 446 | |
458 | |
| 447 | return ""; |
459 | return ""; |
| 448 | } |
460 | } |
| 449 | |
461 | |
| 450 | ##### output utilities ##### |
462 | ##### output utilities ##### |