| 1 | ################################################################################ |
1 | ################################################################################ |
| 2 | # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project |
2 | # WeBWorK Online Homework Delivery System |
| 3 | # $Id$ |
3 | # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ |
|
|
4 | # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.116 2004/03/04 21:05:54 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. |
| 4 | ################################################################################ |
15 | ################################################################################ |
| 5 | |
16 | |
| 6 | package WeBWorK::ContentGenerator::Problem; |
17 | package WeBWorK::ContentGenerator::Problem; |
| 7 | use base qw(WeBWorK::ContentGenerator); |
18 | use base qw(WeBWorK::ContentGenerator); |
| 8 | |
19 | |
| 9 | =head1 NAME |
20 | =head1 NAME |
| 10 | |
21 | |
| 11 | WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. |
22 | WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem. |
| 12 | |
23 | |
| 13 | =cut |
24 | =cut |
| 14 | my $timer0_ON=1; # times pg translation phase |
25 | |
| 15 | use strict; |
26 | use strict; |
| 16 | use warnings; |
27 | use warnings; |
| 17 | use CGI qw(); |
28 | use CGI qw(); |
| 18 | use File::Path qw(rmtree); |
29 | use File::Path qw(rmtree); |
| 19 | use WeBWorK::Form; |
30 | use WeBWorK::Form; |
| 20 | use WeBWorK::PG; |
31 | use WeBWorK::PG; |
| 21 | use WeBWorK::PG::ImageGenerator; |
32 | use WeBWorK::PG::ImageGenerator; |
| 22 | use WeBWorK::PG::IO; |
33 | use WeBWorK::PG::IO; |
| 23 | use WeBWorK::Utils qw(writeLog encodeAnswers decodeAnswers ref2string makeTempDirectory); |
34 | use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory); |
| 24 | use WeBWorK::DB::Utils qw(global2user user2global findDefaults); |
35 | use WeBWorK::DB::Utils qw(global2user user2global findDefaults); |
| 25 | use WeBWorK::Timing; |
36 | use WeBWorK::Timing; |
|
|
37 | |
| 26 | |
38 | |
| 27 | ############################################################ |
39 | ############################################################ |
| 28 | # |
40 | # |
| 29 | # user |
41 | # user |
| 30 | # effectiveUser |
42 | # effectiveUser |
| … | |
… | |
| 40 | # |
52 | # |
| 41 | # redisplay - name of the "Redisplay Problem" button |
53 | # redisplay - name of the "Redisplay Problem" button |
| 42 | # submitAnswers - name of "Submit Answers" button |
54 | # submitAnswers - name of "Submit Answers" button |
| 43 | # checkAnswers - name of the "Check Answers" button |
55 | # checkAnswers - name of the "Check Answers" button |
| 44 | # previewAnswers - name of the "Preview Answers" button |
56 | # previewAnswers - name of the "Preview Answers" button |
|
|
57 | # |
|
|
58 | # FIXME: this table is heinously out of date |
| 45 | # |
59 | # |
| 46 | ############################################################ |
60 | ############################################################ |
| 47 | |
61 | |
|
|
62 | # FIXME: what is this? |
|
|
63 | sub templateName { |
|
|
64 | "problem"; |
|
|
65 | } |
|
|
66 | |
| 48 | sub pre_header_initialize { |
67 | sub pre_header_initialize { |
| 49 | my ($self, $setName, $problemNumber) = @_; |
68 | my ($self) = @_; |
| 50 | my $r = $self->{r}; |
69 | my $r = $self->r; |
| 51 | my $courseEnv = $self->{ce}; |
70 | my $ce = $r->ce; |
| 52 | my $db = $self->{db}; |
71 | my $db = $r->db; |
|
|
72 | my $urlpath = $r->urlpath; |
|
|
73 | |
|
|
74 | my $setName = $urlpath->arg("setID"); |
|
|
75 | my $problemNumber = $r->urlpath->arg("problemID"); |
| 53 | my $userName = $r->param('user'); |
76 | my $userName = $r->param('user'); |
| 54 | my $effectiveUserName = $r->param('effectiveUser'); |
77 | my $effectiveUserName = $r->param('effectiveUser'); |
| 55 | my $key = $r->param('key'); |
78 | my $key = $r->param('key'); |
| 56 | my $user = $db->getUser($userName); |
79 | |
|
|
80 | my $user = $db->getUser($userName); # checked |
|
|
81 | die "record for user $userName (real user) does not exist." |
|
|
82 | unless defined $user; |
|
|
83 | |
| 57 | my $effectiveUser = $db->getUser($effectiveUserName); |
84 | my $effectiveUser = $db->getUser($effectiveUserName); # checked |
|
|
85 | die "record for user $effectiveUserName (effective user) does not exist." |
|
|
86 | unless defined $effectiveUser; |
|
|
87 | |
|
|
88 | my $PermissionLevel = $db->getPermissionLevel($userName); # checked |
|
|
89 | die "permission level record for user $userName does not exist (but the user does? odd...)" |
|
|
90 | unless defined $PermissionLevel; |
| 58 | my $permissionLevel = $db->getPermissionLevel($userName)->permission(); |
91 | my $permissionLevel = $PermissionLevel->permission; |
| 59 | |
92 | |
| 60 | # obtain the merged set for $effectiveUser |
93 | # obtain the merged set for $effectiveUser |
| 61 | my $set = $db->getMergedSet($effectiveUserName, $setName); |
94 | my $set = $db->getMergedSet($effectiveUserName, $setName); # checked |
| 62 | |
95 | |
| 63 | # obtain the merged problem for $effectiveUser |
96 | # obtain the merged problem for $effectiveUser |
| 64 | my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); |
97 | my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked |
| 65 | |
98 | |
| 66 | my $editMode = $r->param("editMode"); |
99 | my $editMode = $r->param("editMode"); |
| 67 | |
100 | |
| 68 | if ($permissionLevel > 0 and defined $editMode) { |
101 | if ($permissionLevel > 0 and defined $editMode) { |
| 69 | # professors are allowed to fabricate sets and problems not |
102 | # professors are allowed to fabricate sets and problems not |
| … | |
… | |
| 72 | |
105 | |
| 73 | # if that is not yet defined obtain the global set, convert |
106 | # if that is not yet defined obtain the global set, convert |
| 74 | # it to a user set, and add fake user data |
107 | # it to a user set, and add fake user data |
| 75 | unless (defined $set) { |
108 | unless (defined $set) { |
| 76 | my $userSetClass = $db->{set_user}->{record}; |
109 | my $userSetClass = $db->{set_user}->{record}; |
| 77 | $set = global2user($userSetClass, |
110 | my $globalSet = $db->getGlobalSet($setName); # checked |
| 78 | $db->getGlobalSet($setName)); |
111 | # if the global set doesn't exist either, bail! |
| 79 | die "Set $setName does not exist" |
112 | die "Set $setName does not exist" |
| 80 | unless defined $set; |
113 | unless defined $set; |
|
|
114 | $set = global2user($userSetClass, $globalSet); |
| 81 | $set->psvn(0); |
115 | $set->psvn(0); |
| 82 | } |
116 | } |
| 83 | |
117 | |
| 84 | # if that is not yet defined obtain the global problem, |
118 | # if that is not yet defined obtain the global problem, |
| 85 | # convert it to a user problem, and add fake user data |
119 | # convert it to a user problem, and add fake user data |
| 86 | unless (defined $problem) { |
120 | unless (defined $problem) { |
| 87 | my $userProblemClass = $db->{problem_user}->{record}; |
121 | my $userProblemClass = $db->{problem_user}->{record}; |
| 88 | $problem = global2user($userProblemClass, |
|
|
| 89 | $db->getGlobalProblem($setName,$problemNumber)); |
122 | my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked |
|
|
123 | # if the global problem doesn't exist either, bail! |
| 90 | die "Problem $problemNumber in set $setName does not exist" |
124 | die "Problem $problemNumber in set $setName does not exist" |
| 91 | unless defined $problem; |
125 | unless defined $problem; |
|
|
126 | $problem = global2user($userProblemClass, $globalProblem); |
| 92 | $problem->user_id($effectiveUserName); |
127 | $problem->user_id($effectiveUserName); |
| 93 | $problem->problem_seed(0); |
128 | $problem->problem_seed(0); |
| 94 | $problem->status(0); |
129 | $problem->status(0); |
| 95 | $problem->attempted(0); |
130 | $problem->attempted(0); |
| 96 | $problem->last_answer(""); |
131 | $problem->last_answer(""); |
| … | |
… | |
| 133 | $self->{editMode} = $editMode; |
168 | $self->{editMode} = $editMode; |
| 134 | |
169 | |
| 135 | ##### form processing ##### |
170 | ##### form processing ##### |
| 136 | |
171 | |
| 137 | # set options from form fields (see comment at top of file for names) |
172 | # set options from form fields (see comment at top of file for names) |
| 138 | my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; |
173 | my $displayMode = $r->param("displayMode") || $ce->{pg}->{options}->{displayMode}; |
| 139 | my $redisplay = $r->param("redisplay"); |
174 | my $redisplay = $r->param("redisplay"); |
| 140 | my $submitAnswers = $r->param("submitAnswers"); |
175 | my $submitAnswers = $r->param("submitAnswers"); |
| 141 | my $checkAnswers = $r->param("checkAnswers"); |
176 | my $checkAnswers = $r->param("checkAnswers"); |
| 142 | my $previewAnswers = $r->param("previewAnswers"); |
177 | my $previewAnswers = $r->param("previewAnswers"); |
| 143 | |
178 | |
| 144 | # fields which may be defined when using Problem Editor |
|
|
| 145 | #my $override_seed = ($permissionLevel>=10) ? $r->param('problemSeed') : undef; |
|
|
| 146 | #my $override_problem_source = ($permissionLevel>=10) ? $r->param('sourceFilePath') : undef; |
|
|
| 147 | #my $editMode = undef; |
|
|
| 148 | #my $submit_button = $r->param('submit_button'); |
|
|
| 149 | #if ( defined($submit_button ) ) { |
|
|
| 150 | # $editMode = "temporaryFile" if $submit_button eq 'Refresh'; |
|
|
| 151 | # $editMode = 'savedFile' if $submit_button eq 'Save'; |
|
|
| 152 | #} |
|
|
| 153 | # |
|
|
| 154 | ##override using the source file data from the form field |
|
|
| 155 | #$problem->source_file($override_problem_source) if defined($override_problem_source); |
|
|
| 156 | #$problem->problem_seed($override_seed) if defined($override_seed); |
|
|
| 157 | # |
|
|
| 158 | ## store path to source file for title. |
|
|
| 159 | #$self->{problem_source_name} = $problem->source_file; |
|
|
| 160 | #$self->{edit_mode} = $editMode; |
|
|
| 161 | #$self->{current_problem_source} = (defined($override_problem_source) ) ? |
|
|
| 162 | |
|
|
| 163 | # coerce form fields into CGI::Vars format |
|
|
| 164 | my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; |
179 | my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; |
| 165 | |
180 | |
| 166 | $self->{displayMode} = $displayMode; |
181 | $self->{displayMode} = $displayMode; |
| 167 | $self->{redisplay} = $redisplay; |
182 | $self->{redisplay} = $redisplay; |
| 168 | $self->{submitAnswers} = $submitAnswers; |
183 | $self->{submitAnswers} = $submitAnswers; |
| … | |
… | |
| 176 | $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0; |
191 | $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0; |
| 177 | return unless $self->{isOpen}; |
192 | return unless $self->{isOpen}; |
| 178 | |
193 | |
| 179 | # what does the user want to do? |
194 | # what does the user want to do? |
| 180 | my %want = ( |
195 | my %want = ( |
| 181 | showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, |
196 | showOldAnswers => $r->param("showOldAnswers") || $ce->{pg}->{options}->{showOldAnswers}, |
| 182 | showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, |
197 | showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers}, |
| 183 | showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, |
198 | showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints}, |
| 184 | showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, |
199 | showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions}, |
| 185 | recordAnswers => $submitAnswers, |
200 | recordAnswers => $submitAnswers, |
| 186 | checkAnswers => $checkAnswers, |
201 | checkAnswers => $checkAnswers, |
| 187 | ); |
202 | ); |
| 188 | |
203 | |
| 189 | # are certain options enforced? |
204 | # are certain options enforced? |
| … | |
… | |
| 206 | $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), |
221 | $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), |
| 207 | # attempts=num_correct+num_incorrect+1, as this happens before updating $problem |
222 | # attempts=num_correct+num_incorrect+1, as this happens before updating $problem |
| 208 | checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date), |
223 | checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date), |
| 209 | ); |
224 | ); |
| 210 | |
225 | |
|
|
226 | # more complicated logic for showing check answer button: |
|
|
227 | # checkAnswers button shows up after due date -- once a student can't record anymore |
|
|
228 | # checkAnswers button always shows up when an instructor or TA is acting |
|
|
229 | # as someone else (the $user and $effectiveUserName aren't the same). |
|
|
230 | $can{checkAnswers} = ( |
|
|
231 | # $can{recordAnswers} will be false if the due date has passed OR the |
|
|
232 | # student has used up all of her attempts |
|
|
233 | ($can{checkAnswers} and not $can{recordAnswers}) |
|
|
234 | or |
|
|
235 | ( |
|
|
236 | # FIXME: this is not the right way to check for this. |
|
|
237 | # also, canCheckAnswers() will show this button if the permission |
|
|
238 | # level is positive, which is always true when an instructor is |
|
|
239 | # acting as a student |
|
|
240 | defined($userName) |
|
|
241 | and |
|
|
242 | defined($effectiveUserName) |
|
|
243 | and |
|
|
244 | ($userName ne $effectiveUserName) |
|
|
245 | ) |
|
|
246 | ); |
|
|
247 | |
|
|
248 | # more complicated logif for showing "submit answer" button: |
|
|
249 | # We hide the submit answer button if someone is acting as a student |
|
|
250 | # This prevents errors where you accidently submit the answer for a student |
|
|
251 | # Not sure whether this a feature or a bug |
|
|
252 | $can{recordAnswers} = ( |
|
|
253 | $can{recordAnswers} |
|
|
254 | and not |
|
|
255 | ( |
|
|
256 | # FIXME: this is not the right way to check for this. |
|
|
257 | defined($userName) |
|
|
258 | and |
|
|
259 | defined($effectiveUserName) |
|
|
260 | and |
|
|
261 | ($userName ne $effectiveUserName) |
|
|
262 | ) |
|
|
263 | ); |
|
|
264 | |
| 211 | # final values for options |
265 | # final values for options |
| 212 | my %will; |
266 | my %will; |
| 213 | foreach (keys %must) { |
267 | foreach (keys %must) { |
| 214 | $will{$_} = $can{$_} && ($want{$_} || $must{$_}); |
268 | $will{$_} = $can{$_} && ($want{$_} || $must{$_}); |
| 215 | } |
269 | } |
| … | |
… | |
| 222 | $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; |
276 | $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; |
| 223 | } |
277 | } |
| 224 | |
278 | |
| 225 | ##### translation ##### |
279 | ##### translation ##### |
| 226 | |
280 | |
| 227 | $WeBWorK::timer0->continue("begin pg processing") if $timer0_ON; |
281 | $WeBWorK::timer->continue("begin pg processing") if defined($WeBWorK::timer); |
| 228 | my $pg = WeBWorK::PG->new( |
282 | my $pg = WeBWorK::PG->new( |
| 229 | $courseEnv, |
283 | $ce, |
| 230 | $effectiveUser, |
284 | $effectiveUser, |
| 231 | $key, |
285 | $key, |
| 232 | $set, |
286 | $set, |
| 233 | $problem, |
287 | $problem, |
| 234 | $set->psvn, # FIXME: this field should be removed |
288 | $set->psvn, # FIXME: this field should be removed |
| … | |
… | |
| 240 | refreshMath2img => $will{showHints} || $will{showSolutions}, |
294 | refreshMath2img => $will{showHints} || $will{showSolutions}, |
| 241 | processAnswers => 1, |
295 | processAnswers => 1, |
| 242 | }, |
296 | }, |
| 243 | ); |
297 | ); |
| 244 | |
298 | |
| 245 | $WeBWorK::timer0->continue("end pg processing") if $timer0_ON; |
299 | $WeBWorK::timer->continue("end pg processing") if defined($WeBWorK::timer); |
| 246 | ##### fix hint/solution options ##### |
300 | ##### fix hint/solution options ##### |
| 247 | |
301 | |
| 248 | $can{showHints} &&= $pg->{flags}->{hintExists}; |
302 | $can{showHints} &&= $pg->{flags}->{hintExists} |
|
|
303 | &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; |
| 249 | $can{showSolutions} &&= $pg->{flags}->{solutionExists}; |
304 | $can{showSolutions} &&= $pg->{flags}->{solutionExists}; |
| 250 | |
305 | |
| 251 | ##### store fields ##### |
306 | ##### store fields ##### |
| 252 | |
307 | |
| 253 | $self->{want} = \%want; |
308 | $self->{want} = \%want; |
| 254 | $self->{must} = \%must; |
309 | $self->{must} = \%must; |
| 255 | $self->{can} = \%can; |
310 | $self->{can} = \%can; |
| 256 | $self->{will} = \%will; |
311 | $self->{will} = \%will; |
| 257 | |
|
|
| 258 | $self->{pg} = $pg; |
312 | $self->{pg} = $pg; |
| 259 | } |
313 | } |
| 260 | |
|
|
| 261 | #sub if_warnings($$) { |
|
|
| 262 | # my ($self, $arg) = @_; |
|
|
| 263 | # return 0 unless $self->{isOpen}; |
|
|
| 264 | # return $self->{pg}->{warnings} ne ""; |
|
|
| 265 | #} |
|
|
| 266 | |
314 | |
| 267 | sub if_errors($$) { |
315 | sub if_errors($$) { |
| 268 | my ($self, $arg) = @_; |
316 | my ($self, $arg) = @_; |
| 269 | return 0 unless $self->{isOpen}; |
317 | |
|
|
318 | if ($self->{isOpen}) { |
| 270 | return $self->{pg}->{flags}->{error_flag}; |
319 | return $self->{pg}->{flags}->{error_flag} ? $arg : !$arg; |
|
|
320 | } else { |
|
|
321 | return !$arg; |
|
|
322 | } |
| 271 | } |
323 | } |
| 272 | |
324 | |
| 273 | sub head { |
325 | sub head { |
| 274 | my $self = shift; |
326 | my ($self) = @_; |
|
|
327 | |
| 275 | return "" unless $self->{isOpen}; |
328 | return "" unless $self->{isOpen}; |
| 276 | return $self->{pg}->{head_text} if $self->{pg}->{head_text}; |
329 | return $self->{pg}->{head_text} if $self->{pg}->{head_text}; |
| 277 | } |
330 | } |
| 278 | |
331 | |
| 279 | sub options { |
332 | sub options { |
| 280 | my $self = shift; |
333 | my ($self) = @_; |
|
|
334 | |
| 281 | return join("", |
335 | return join("", |
| 282 | CGI::start_form("POST", $self->{r}->uri), |
336 | CGI::start_form("POST", $self->{r}->uri), |
| 283 | $self->hidden_authen_fields, |
337 | $self->hidden_authen_fields, |
| 284 | CGI::hr(), |
338 | CGI::hr(), |
| 285 | CGI::start_div({class=>"viewOptions"}), |
339 | CGI::start_div({class=>"viewOptions"}), |
| … | |
… | |
| 287 | CGI::end_div(), |
341 | CGI::end_div(), |
| 288 | CGI::end_form() |
342 | CGI::end_form() |
| 289 | ); |
343 | ); |
| 290 | } |
344 | } |
| 291 | |
345 | |
| 292 | sub path { |
346 | #sub path { |
| 293 | my $self = shift; |
347 | # my $self = shift; |
| 294 | my $args = $_[-1]; |
348 | # my $args = $_[-1]; |
| 295 | my $setName = $self->{set}->set_id; |
349 | # my $setName = $self->{set}->set_id; |
| 296 | my $problemNumber = $self->{problem}->problem_id; |
350 | # my $problemNumber = $self->{problem}->problem_id; |
| 297 | |
351 | # |
| 298 | my $ce = $self->{ce}; |
352 | # my $ce = $self->{ce}; |
| 299 | my $root = $ce->{webworkURLs}->{root}; |
353 | # my $root = $ce->{webworkURLs}->{root}; |
| 300 | my $courseName = $ce->{courseName}; |
354 | # my $courseName = $ce->{courseName}; |
| 301 | return $self->pathMacro($args, |
355 | # return $self->pathMacro($args, |
| 302 | "Home" => "$root", |
356 | # "Home" => "$root", |
| 303 | $courseName => "$root/$courseName", |
357 | # $courseName => "$root/$courseName", |
| 304 | $setName => "$root/$courseName/$setName", |
358 | # $setName => "$root/$courseName/$setName", |
| 305 | "Problem $problemNumber" => "", |
359 | # "Problem $problemNumber" => "", |
| 306 | ); |
360 | # ); |
| 307 | } |
361 | #} |
| 308 | |
362 | |
| 309 | sub siblings { |
363 | sub siblings { |
| 310 | my $self = shift; |
364 | my ($self) = @_; |
|
|
365 | my $r = $self->r; |
|
|
366 | my $db = $r->db; |
|
|
367 | my $urlpath = $r->urlpath; |
|
|
368 | |
|
|
369 | my $courseID = $urlpath->arg("courseID"); |
| 311 | my $setName = $self->{set}->set_id; |
370 | my $setID = $self->{set}->set_id; |
| 312 | my $problemNumber = $self->{problem}->problem_id; |
|
|
| 313 | |
|
|
| 314 | my $ce = $self->{ce}; |
|
|
| 315 | my $db = $self->{db}; |
|
|
| 316 | my $root = $ce->{webworkURLs}->{root}; |
|
|
| 317 | my $courseName = $ce->{courseName}; |
|
|
| 318 | print CGI::strong("Problems"), CGI::br(); |
|
|
| 319 | |
|
|
| 320 | my $effectiveUser = $self->{r}->param("effectiveUser"); |
371 | my $eUserID = $r->param("effectiveUser"); |
| 321 | my @problemIDs = $db->listUserProblems($effectiveUser, $setName); |
372 | my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID); |
|
|
373 | |
|
|
374 | print CGI::start_ul({class=>"LinksMenu"}); |
|
|
375 | print CGI::start_li(); |
|
|
376 | print CGI::span({style=>"font-size:larger"}, "Problem Sets"); |
|
|
377 | print CGI::start_ul(); |
|
|
378 | |
| 322 | foreach my $problem (sort { $a <=> $b } @problemIDs) { |
379 | foreach my $problemID (@problemIDs) { |
| 323 | print ' '.CGI::a({-href=>"$root/$courseName/$setName/".$problem."/?" |
380 | my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", |
| 324 | . $self->url_authen_args . "&displayMode=" . $self->{displayMode}}, |
381 | courseID => $courseID, setID => $setID, problemID => $problemID); |
| 325 | "Problem ".$problem), CGI::br(); |
382 | print CGI::li(CGI::a({href=>$self->systemLink($problemPage)}, "Problem $problemID")); |
| 326 | } |
383 | } |
| 327 | |
384 | |
|
|
385 | print CGI::end_ul(); |
|
|
386 | print CGI::end_li(); |
|
|
387 | print CGI::end_ul(); |
|
|
388 | |
| 328 | return ""; |
389 | return ""; |
| 329 | } |
390 | } |
| 330 | |
391 | |
| 331 | sub nav { |
392 | sub nav { |
| 332 | $WeBWorK::timer0->continue("begin nav subroutine") if $timer0_ON; |
393 | my ($self, $args) = @_; |
| 333 | my $self = shift; |
394 | my $r = $self->r; |
| 334 | my $args = $_[-1]; |
395 | my $db = $r->db; |
|
|
396 | my $urlpath = $r->urlpath; |
|
|
397 | |
|
|
398 | my $courseID = $urlpath->arg("courseID"); |
| 335 | my $setName = $self->{set}->set_id; |
399 | my $setID = $self->{set}->set_id; |
| 336 | my $problemNumber = $self->{problem}->problem_id; |
400 | my $problemID = $self->{problem}->problem_id; |
| 337 | |
|
|
| 338 | my $ce = $self->{ce}; |
|
|
| 339 | my $db = $self->{db}; |
|
|
| 340 | my $root = $ce->{webworkURLs}->{root}; |
|
|
| 341 | my $courseName = $ce->{courseName}; |
|
|
| 342 | |
|
|
| 343 | my $wwdb = $self->{wwdb}; |
|
|
| 344 | my $effectiveUser = $self->{r}->param("effectiveUser"); |
401 | my $eUserID = $r->param("effectiveUser"); |
|
|
402 | |
|
|
403 | my ($prevID, $nextID); |
|
|
404 | |
|
|
405 | my @problemIDs = $db->listUserProblems($eUserID, $setID); |
|
|
406 | foreach my $id (@problemIDs) { |
|
|
407 | $prevID = $id if $id < $problemID |
|
|
408 | and (not defined $prevID or $id > $prevID); |
|
|
409 | $nextID = $id if $id > $problemID |
|
|
410 | and (not defined $nextID or $id < $nextID); |
|
|
411 | } |
|
|
412 | |
|
|
413 | my @links; |
|
|
414 | |
|
|
415 | if ($prevID) { |
|
|
416 | my $prevPage = $urlpath->newFromModule(__PACKAGE__, |
|
|
417 | courseID => $courseID, setID => $setID, problemID => $prevID); |
|
|
418 | push @links, "Previous Problem", $r->location . $prevPage->path, "navPrev"; |
|
|
419 | } else { |
|
|
420 | push @links, "Previous Problem", "", "navPrev"; |
|
|
421 | } |
|
|
422 | |
|
|
423 | push @links, "Problem List", $r->location . $urlpath->parent->path, "navProbList"; |
|
|
424 | |
|
|
425 | if ($nextID) { |
|
|
426 | my $nextPage = $urlpath->newFromModule(__PACKAGE__, |
|
|
427 | courseID => $courseID, setID => $setID, problemID => $nextID); |
|
|
428 | push @links, "Next Problem", $r->location . $nextPage->path, "navNext"; |
|
|
429 | } else { |
|
|
430 | push @links, "Next Problem", "", "navNext"; |
|
|
431 | } |
|
|
432 | |
| 345 | my $tail = "&displayMode=".$self->{displayMode}; |
433 | my $tail = "&displayMode=".$self->{displayMode}; |
| 346 | |
|
|
| 347 | my @links = ("Problem List" , "$root/$courseName/$setName", "navProbList"); |
|
|
| 348 | |
|
|
| 349 | my @problemIDs = $db->listUserProblems($effectiveUser, $setName); |
|
|
| 350 | my ($prevID, $nextID); |
|
|
| 351 | foreach my $id (@problemIDs) { |
|
|
| 352 | $prevID = $id if $id < $problemNumber |
|
|
| 353 | and (not defined $prevID or $id > $prevID); |
|
|
| 354 | $nextID = $id if $id > $problemNumber |
|
|
| 355 | and (not defined $nextID or $id < $nextID); |
|
|
| 356 | } |
|
|
| 357 | unshift @links, "Previous Problem" , ($prevID |
|
|
| 358 | ? "$root/$courseName/$setName/".$prevID |
|
|
| 359 | : "") , "navPrev"; |
|
|
| 360 | push @links, "Next Problem" , ($nextID |
|
|
| 361 | ? "$root/$courseName/$setName/".$nextID |
|
|
| 362 | : "") , "navNext"; |
|
|
| 363 | |
|
|
| 364 | my $result = $self->navMacro($args, $tail, @links); |
434 | return $self->navMacro($args, $tail, @links); |
| 365 | $WeBWorK::timer0->continue("end nav subroutine") if $timer0_ON; |
|
|
| 366 | return $result; |
|
|
| 367 | } |
435 | } |
| 368 | |
436 | |
| 369 | sub title { |
437 | sub title { |
| 370 | my $self = shift; |
438 | my ($self) = @_; |
|
|
439 | |
| 371 | my $setName = $self->{set}->set_id; |
440 | my $setID = $self->{set}->set_id; |
| 372 | my $problemNumber = $self->{problem}->problem_id; |
441 | my $problemID = $self->{problem}->problem_id; |
| 373 | |
442 | |
| 374 | return "$setName : Problem $problemNumber"; |
443 | return "$setID : $problemID"; |
| 375 | } |
444 | } |
| 376 | |
445 | |
| 377 | sub body { |
446 | sub body { |
| 378 | my $self = shift; |
447 | my $self = shift; |
|
|
448 | my $r = $self->r; |
|
|
449 | my $ce = $r->ce; |
|
|
450 | my $db = $r->db; |
|
|
451 | my $urlpath = $r->urlpath; |
| 379 | |
452 | |
| 380 | return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open.")) |
|
|
| 381 | unless $self->{isOpen}; |
453 | unless ($self->{isOpen}) { |
| 382 | |
454 | return CGI::div({class=>"ResultsWithError"}, |
|
|
455 | CGI::p("This problem is not available because the problem set that contains it is not yet open.")); |
|
|
456 | } |
| 383 | # unpack some useful variables |
457 | # unpack some useful variables |
| 384 | my $r = $self->{r}; |
|
|
| 385 | my $db = $self->{db}; |
|
|
| 386 | my $set = $self->{set}; |
458 | my $set = $self->{set}; |
| 387 | my $problem = $self->{problem}; |
459 | my $problem = $self->{problem}; |
| 388 | my $editMode = $self->{editMode}; |
460 | my $editMode = $self->{editMode}; |
| 389 | my $permissionLevel = $self->{permissionLevel}; |
461 | my $permissionLevel = $self->{permissionLevel}; |
| 390 | my $submitAnswers = $self->{submitAnswers}; |
462 | my $submitAnswers = $self->{submitAnswers}; |
| … | |
… | |
| 394 | my %can = %{ $self->{can} }; |
466 | my %can = %{ $self->{can} }; |
| 395 | my %must = %{ $self->{must} }; |
467 | my %must = %{ $self->{must} }; |
| 396 | my %will = %{ $self->{will} }; |
468 | my %will = %{ $self->{will} }; |
| 397 | my $pg = $self->{pg}; |
469 | my $pg = $self->{pg}; |
| 398 | |
470 | |
|
|
471 | #my $root = $ce->{webworkURLs}->{root}; |
|
|
472 | my $courseName = $urlpath->arg("courseID"); |
|
|
473 | |
|
|
474 | #####create Editor link ##### |
|
|
475 | ## print editor link if the user is an instructor AND the file is not in temporary editing mode |
|
|
476 | #my $editorLinkMessage = ''; |
|
|
477 | ## and ( (not defined($self->{editMode})) or $self->{editMode} eq 'savedFile') # FIXME is this needed? |
|
|
478 | #if ($self->{permissionLevel}>=10 ) { |
|
|
479 | # $editorLinkMessage = CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/". |
|
|
480 | # $set->set_id.'/'.$problem->problem_id.'?'.$self->url_authen_args},'Edit this problem'); |
|
|
481 | #} |
|
|
482 | |
|
|
483 | my $editorLink = ""; |
|
|
484 | if ($self->{permissionLevel}>=10) { |
|
|
485 | my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", |
|
|
486 | courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id); |
|
|
487 | my $editorURL = $self->systemLink($editorPage); |
|
|
488 | $editorLink = CGI::a({href=>$editorURL}, "Edit this problem"); |
|
|
489 | } |
|
|
490 | |
| 399 | ##### translation errors? ##### |
491 | ##### translation errors? ##### |
| 400 | |
492 | |
| 401 | if ($pg->{flags}->{error_flag}) { |
493 | if ($pg->{flags}->{error_flag}) { |
| 402 | return $self->errorOutput($pg->{errors}, $pg->{body_text}); |
494 | print $self->errorOutput($pg->{errors}, $pg->{body_text}); |
|
|
495 | print $editorLink; |
|
|
496 | return ""; |
| 403 | } |
497 | } |
| 404 | |
498 | |
| 405 | ##### answer processing ##### |
499 | ##### answer processing ##### |
| 406 | $WeBWorK::timer0->continue("begin answer processing") if $timer0_ON; |
500 | $WeBWorK::timer->continue("begin answer processing") if defined($WeBWorK::timer); |
| 407 | # if answers were submitted: |
501 | # if answers were submitted: |
| 408 | my $scoreRecordedMessage; |
502 | my $scoreRecordedMessage; |
| 409 | if ($submitAnswers) { |
503 | if ($submitAnswers) { |
| 410 | # get a "pure" (unmerged) UserProblem to modify |
504 | # get a "pure" (unmerged) UserProblem to modify |
| 411 | # this will be undefined if the problem has not been assigned to this user |
505 | # this will be undefined if the problem has not been assigned to this user |
| 412 | my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); |
506 | my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); # checked |
| 413 | if (defined $pureProblem) { |
507 | if (defined $pureProblem) { |
| 414 | # store answers in DB for sticky answers |
508 | # store answers in DB for sticky answers |
| 415 | my %answersToStore; |
509 | my %answersToStore; |
| 416 | my %answerHash = %{ $pg->{answers} }; |
510 | my %answerHash = %{ $pg->{answers} }; |
| 417 | $answersToStore{$_} = $answerHash{$_}->{original_student_ans} |
511 | $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!! |
| 418 | foreach (keys %answerHash); |
512 | foreach (keys %answerHash); |
|
|
513 | |
|
|
514 | # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating |
|
|
515 | # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs |
|
|
516 | # however we need to store them. Fortunately they are still in the input form. |
|
|
517 | my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}}; |
|
|
518 | $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names); |
|
|
519 | |
|
|
520 | # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order |
|
|
521 | my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names); |
| 419 | my $answerString = encodeAnswers(%answersToStore, |
522 | my $answerString = encodeAnswers(%answersToStore, |
| 420 | @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); |
523 | @answer_order); |
| 421 | |
524 | |
| 422 | # store last answer to database |
525 | # store last answer to database |
| 423 | $problem->last_answer($answerString); |
526 | $problem->last_answer($answerString); |
| 424 | $pureProblem->last_answer($answerString); |
527 | $pureProblem->last_answer($answerString); |
| 425 | $db->putUserProblem($pureProblem); |
528 | $db->putUserProblem($pureProblem); |
| … | |
… | |
| 465 | $scoreRecordedMessage = "Your score was not recorded because this problem has not been built for you."; |
568 | $scoreRecordedMessage = "Your score was not recorded because this problem has not been built for you."; |
| 466 | } |
569 | } |
| 467 | } |
570 | } |
| 468 | |
571 | |
| 469 | # logging student answers |
572 | # logging student answers |
| 470 | my $pastAnswerLog = undef; |
573 | |
| 471 | if (defined( $self->{ce}->{webworkFiles}->{logs}->{'pastAnswerList'} )) { |
574 | my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; |
| 472 | $pastAnswerLog = $self->{ce}->{webworkFiles}->{logs}->{'pastAnswerList'}; |
575 | if ( defined($answer_log )) { |
| 473 | if ($submitAnswers and defined $pastAnswerLog) { |
576 | if ($submitAnswers ) { |
| 474 | my $answerString = ""; |
577 | my $answerString = ""; |
| 475 | my %answerHash = %{ $pg->{answers} }; |
578 | my %answerHash = %{ $pg->{answers} }; |
| 476 | $answerString = $answerString . $answerHash{$_}->{original_student_ans}."\t" |
579 | # FIXME this is the line 552 error. make sure original student ans is defined. |
|
|
580 | # The fact that it is not defined is probably due to an error in some answer evaluator. |
|
|
581 | # But I think it is useful to suppress this error message in the log. |
| 477 | foreach (sort keys %answerHash); |
582 | foreach (sort keys %answerHash) { |
|
|
583 | my $student_ans = $answerHash{$_}->{original_student_ans} ||''; |
|
|
584 | $answerString .= $student_ans."\t" |
|
|
585 | } |
| 478 | $answerString = '' unless defined($answerString); # insure string is defined. |
586 | $answerString = '' unless defined($answerString); # insure string is defined. |
| 479 | writeLog($self->{ce}, "pastAnswerList", |
587 | writeCourseLog($self->{ce}, "answer_log", |
|
|
588 | join("", |
| 480 | '|'.$problem->user_id. |
589 | '|', $problem->user_id, |
| 481 | '|'.$problem->set_id. |
590 | '|', $problem->set_id, |
| 482 | '|'.$problem->problem_id.'|'."\t". |
591 | '|', $problem->problem_id, |
|
|
592 | '|',"\t", |
| 483 | time()."\t". |
593 | time(),"\t", |
| 484 | $answerString, |
594 | $answerString, |
|
|
595 | ), |
| 485 | ); |
596 | ); |
|
|
597 | |
| 486 | } |
598 | } |
| 487 | } |
599 | } |
| 488 | |
600 | |
| 489 | $WeBWorK::timer0->continue("end answer processing") if $timer0_ON; |
601 | $WeBWorK::timer->continue("end answer processing") if defined($WeBWorK::timer); |
| 490 | |
602 | |
| 491 | ##### output ##### |
603 | ##### output ##### |
| 492 | |
604 | |
| 493 | print CGI::start_div({class=>"problemHeader"}); |
605 | print CGI::start_div({class=>"problemHeader"}); |
| 494 | |
606 | |
| … | |
… | |
| 500 | print CGI::p(CGI::i("Problem saved to: ", $problem->source_file)); |
612 | print CGI::p(CGI::i("Problem saved to: ", $problem->source_file)); |
| 501 | } |
613 | } |
| 502 | } |
614 | } |
| 503 | |
615 | |
| 504 | # attempt summary |
616 | # attempt summary |
| 505 | if ($submitAnswers or $will{showCorrectAnswers}) { |
617 | #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. |
|
|
618 | # until after the due date |
|
|
619 | # do I need to check $wills{howCorrectAnswers} to make preflight work?? |
|
|
620 | if (($pg->{flags}->{showPartialCorrectAnswers}>= 0 and $submitAnswers) ) { |
| 506 | # print this if user submitted answers OR requested correct answers |
621 | # print this if user submitted answers OR requested correct answers |
|
|
622 | |
| 507 | print $self->attemptResults($pg, $submitAnswers, |
623 | print $self->attemptResults($pg, 1, |
| 508 | $will{showCorrectAnswers}, |
624 | $will{showCorrectAnswers}, |
| 509 | $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); |
625 | $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); |
| 510 | } elsif ($checkAnswers) { |
626 | } elsif ($checkAnswers) { |
| 511 | # print this if user previewed answers |
627 | # print this if user previewed answers |
|
|
628 | print "ANSWERS ONLY CHECKED -- ",CGI::br(),"ANSWERS NOT RECORDED", CGI::br(); |
| 512 | print $self->attemptResults($pg, 1, 0, 1, 1, 1); |
629 | print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); |
| 513 | # show attempt answers |
630 | # show attempt answers |
| 514 | # don't show correct answers |
631 | # show correct answers if asked |
| 515 | # show attempt results (correctness) |
632 | # show attempt results (correctness) |
| 516 | # don't show attempt previews |
633 | # show attempt previews |
| 517 | } elsif ($previewAnswers) { |
634 | } elsif ($previewAnswers) { |
| 518 | # print this if user previewed answers |
635 | # print this if user previewed answers |
| 519 | print $self->attemptResults($pg, 1, 0, 0, 0, 1); |
636 | print "PREVIEW ONLY -- NOT RECORDED",CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); |
| 520 | # show attempt answers |
637 | # show attempt answers |
| 521 | # don't show correct answers |
638 | # don't show correct answers |
| 522 | # don't show attempt results (correctness) |
639 | # don't show attempt results (correctness) |
| 523 | # show attempt previews |
640 | # show attempt previews |
| 524 | } |
641 | } |
| … | |
… | |
| 532 | CGI::startform("POST", $r->uri), |
649 | CGI::startform("POST", $r->uri), |
| 533 | $self->hidden_authen_fields, |
650 | $self->hidden_authen_fields, |
| 534 | CGI::p($pg->{body_text}), |
651 | CGI::p($pg->{body_text}), |
| 535 | CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})), |
652 | CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})), |
| 536 | CGI::p( |
653 | CGI::p( |
|
|
654 | ($can{showCorrectAnswers} |
|
|
655 | ? CGI::checkbox( |
|
|
656 | -name => "showCorrectAnswers", |
|
|
657 | -checked => $will{showCorrectAnswers}, |
|
|
658 | -label => "Show correct answers", |
|
|
659 | ) ." " |
|
|
660 | : "" ), |
|
|
661 | ($can{showHints} |
|
|
662 | ? '<div style="color:red">'. CGI::checkbox( |
|
|
663 | -name => "showHints", |
|
|
664 | -checked => $will{showHints}, |
|
|
665 | -label => "Show Hints", |
|
|
666 | ) . "</div> " |
|
|
667 | : " " ), |
|
|
668 | ($can{showSolutions} |
|
|
669 | ? CGI::checkbox( |
|
|
670 | -name => "showSolutions", |
|
|
671 | -checked => $will{showSolutions}, |
|
|
672 | -label => "Show Solutions", |
|
|
673 | ) . " " |
|
|
674 | : " " ),CGI::br(), |
|
|
675 | CGI::submit(-name=>"previewAnswers", |
|
|
676 | -label=>"Preview Answers"), |
| 537 | ($can{recordAnswers} |
677 | ($can{recordAnswers} |
| 538 | ? CGI::submit(-name=>"submitAnswers", |
678 | ? CGI::submit(-name=>"submitAnswers", |
| 539 | -label=>"Submit Answers") |
679 | -label=>"Submit Answers") |
| 540 | : ""), |
680 | : ""), |
| 541 | ($can{checkAnswers} |
681 | ( $can{checkAnswers} |
| 542 | ? CGI::submit(-name=>"checkAnswers", |
682 | ? CGI::submit(-name=>"checkAnswers", |
| 543 | -label=>"Check Answers") |
683 | -label=>"Check Answers") |
| 544 | : ""), |
684 | : ""), |
| 545 | CGI::submit(-name=>"previewAnswers", |
|
|
| 546 | -label=>"Preview Answers"), |
|
|
| 547 | ); |
685 | ); |
| 548 | print CGI::end_div(); |
686 | print CGI::end_div(); |
| 549 | |
687 | |
| 550 | print CGI::start_div({class=>"scoreSummary"}); |
688 | print CGI::start_div({class=>"scoreSummary"}); |
| 551 | |
689 | |
| … | |
… | |
| 583 | $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." |
721 | $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." |
| 584 | ); |
722 | ); |
| 585 | print CGI::end_div(); |
723 | print CGI::end_div(); |
| 586 | |
724 | |
| 587 | # save state for viewOptions |
725 | # save state for viewOptions |
| 588 | print CGI::hidden( |
726 | print CGI::hidden( |
| 589 | -name => "showOldAnswers", |
727 | -name => "showOldAnswers", |
| 590 | -value => $will{showOldAnswers} |
728 | -value => $will{showOldAnswers} |
| 591 | ), |
729 | ), |
|
|
730 | |
| 592 | CGI::hidden( |
731 | CGI::hidden( |
| 593 | -name => "showCorrectAnswers", |
|
|
| 594 | -value => $will{showCorrectAnswers} |
|
|
| 595 | ), |
|
|
| 596 | CGI::hidden( |
|
|
| 597 | -name => "showHints", |
|
|
| 598 | -value => $will{showHints}), |
|
|
| 599 | CGI::hidden( |
|
|
| 600 | -name => "showSolutions", |
|
|
| 601 | -value => $will{showSolutions}, |
|
|
| 602 | ), |
|
|
| 603 | CGI::hidden( |
|
|
| 604 | -name => "displayMode", |
732 | -name => "displayMode", |
| 605 | -value => $self->{displayMode} |
733 | -value => $self->{displayMode} |
| 606 | ); |
734 | ); |
| 607 | |
735 | print( CGI::hidden( |
|
|
736 | -name => 'editMode', |
|
|
737 | -value => $self->{editMode}, |
|
|
738 | ) |
|
|
739 | ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile'; |
|
|
740 | print( CGI::hidden( |
|
|
741 | -name => 'sourceFilePath', |
|
|
742 | -value => $self->{problem}->{source_file} |
|
|
743 | )) if defined($self->{problem}->{source_file}); |
|
|
744 | |
| 608 | # end of main form |
745 | # end of main form |
| 609 | print CGI::endform(); |
746 | print CGI::endform(); |
| 610 | |
747 | |
| 611 | # stuff we need below (pull these out at the beginning?) |
|
|
| 612 | my $ce = $self->{ce}; |
|
|
| 613 | my $root = $ce->{webworkURLs}->{root}; |
|
|
| 614 | my $courseName = $ce->{courseName}; |
|
|
| 615 | |
748 | |
| 616 | print CGI::start_div({class=>"problemFooter"}); |
749 | print CGI::start_div({class=>"problemFooter"}); |
| 617 | |
750 | |
| 618 | # arguments for answer inspection button |
751 | ## arguments for answer inspection button |
| 619 | my $prof_url = $ce->{webworkURLs}->{oldProf}; |
752 | #my $prof_url = $ce->{webworkURLs}->{oldProf}; |
|
|
753 | #my $webworkURL = $ce->{webworkURLs}->{root}; |
| 620 | my $cgi_url = $prof_url; |
754 | #my $cgi_url = $prof_url; |
| 621 | $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl |
755 | #$cgi_url=~ s|/[^/]*$||; # clip profLogin.pl |
| 622 | my $authen_args = $self->url_authen_args(); |
756 | #my $authen_args = $self->url_authen_args(); |
| 623 | my $showPastAnswersURL = "$cgi_url/showPastAnswers.pl"; |
757 | #my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/"; |
| 624 | |
758 | |
|
|
759 | my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", |
|
|
760 | courseID => $courseName); |
|
|
761 | my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action |
|
|
762 | |
| 625 | # print answer inspection button |
763 | # print answer inspection button |
| 626 | if ($self->{permissionLevel} > 0) { |
764 | if ($self->{permissionLevel} > 0) { |
| 627 | print "\n", |
765 | print "\n", |
| 628 | CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", |
766 | CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", |
| 629 | $self->hidden_authen_fields,"\n", |
767 | $self->hidden_authen_fields,"\n", |
| 630 | CGI::hidden(-name => 'course', -value=>$courseName), "\n", |
768 | CGI::hidden(-name => 'course', -value=>$courseName), "\n", |
| 631 | CGI::hidden(-name => 'probNum', -value=>$problem->problem_id), "\n", |
769 | CGI::hidden(-name => 'problemNumber', -value=>$problem->problem_id), "\n", |
| 632 | CGI::hidden(-name => 'setNum', -value=>$problem->set_id), "\n", |
770 | CGI::hidden(-name => 'setName', -value=>$problem->set_id), "\n", |
| 633 | CGI::hidden(-name => 'User', -value=>$problem->user_id), "\n", |
771 | CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", |
| 634 | CGI::p( {-align=>"left"}, |
772 | CGI::p( {-align=>"left"}, |
| 635 | CGI::submit(-name => 'action', -value=>'Show Past Answers') |
773 | CGI::submit(-name => 'action', -value=>'Show Past Answers') |
| 636 | ), "\n", |
774 | ), "\n", |
| 637 | CGI::endform(); |
775 | CGI::endform(); |
| 638 | } |
776 | } |
| 639 | |
777 | |
| 640 | #print CGI::end_div(); |
778 | ## arguments for feedback form |
|
|
779 | #my $feedbackURL = "$root/$courseName/feedback/"; |
| 641 | # |
780 | # |
| 642 | #print CGI::start_div(); |
781 | ##print feedback form |
| 643 | |
782 | #print |
| 644 | # arguments for feedback form |
783 | # CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", |
| 645 | my $feedbackURL = "$root/$courseName/feedback/"; |
784 | # $self->hidden_authen_fields,"\n", |
|
|
785 | # CGI::hidden("module", __PACKAGE__),"\n", |
|
|
786 | # CGI::hidden("set", $set->set_id),"\n", |
|
|
787 | # CGI::hidden("problem", $problem->problem_id),"\n", |
|
|
788 | # CGI::hidden("displayMode", $self->{displayMode}),"\n", |
|
|
789 | # CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", |
|
|
790 | # CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", |
|
|
791 | # CGI::hidden("showHints", $will{showHints}),"\n", |
|
|
792 | # CGI::hidden("showSolutions", $will{showSolutions}),"\n", |
|
|
793 | # CGI::p({-align=>"left"}, |
|
|
794 | # CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") |
|
|
795 | # ), |
|
|
796 | # CGI::endform(),"\n"; |
|
|
797 | |
|
|
798 | # feedback form url |
|
|
799 | my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback", |
|
|
800 | courseID => $courseName); |
|
|
801 | my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action |
| 646 | |
802 | |
| 647 | #print feedback form |
803 | #print feedback form |
| 648 | print |
804 | print |
| 649 | CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", |
805 | CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", |
| 650 | $self->hidden_authen_fields,"\n", |
806 | $self->hidden_authen_fields,"\n", |
| … | |
… | |
| 655 | CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", |
811 | CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", |
| 656 | CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", |
812 | CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", |
| 657 | CGI::hidden("showHints", $will{showHints}),"\n", |
813 | CGI::hidden("showHints", $will{showHints}),"\n", |
| 658 | CGI::hidden("showSolutions", $will{showSolutions}),"\n", |
814 | CGI::hidden("showSolutions", $will{showSolutions}),"\n", |
| 659 | CGI::p({-align=>"left"}, |
815 | CGI::p({-align=>"left"}, |
| 660 | CGI::submit(-name=>"feedbackForm", -label=>"Contact instructor") |
816 | CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") |
| 661 | ), |
817 | ), |
| 662 | CGI::endform(),"\n"; |
818 | CGI::endform(),"\n"; |
| 663 | |
819 | |
| 664 | # FIXME print editor link |
820 | # FIXME print editor link |
| 665 | # print editor link if the user is an instructor AND the file is not in temporary editing mode |
821 | print $editorLink; #empty unless it is appropriate to have an editor link. |
| 666 | if ($self->{permissionLevel}>=10 and ( (not defined($self->{edit_mode})) or $self->{edit_mode} eq 'savedFile') ) { |
|
|
| 667 | print CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/".$set->set_id. |
|
|
| 668 | '/'.$problem->problem_id.'?'.$self->url_authen_args},'Edit this problem'); |
|
|
| 669 | } |
|
|
| 670 | |
822 | |
| 671 | print CGI::end_div(); |
823 | print CGI::end_div(); |
| 672 | |
824 | |
| 673 | # warning output |
825 | # warning output |
| 674 | #if ($pg->{warnings} ne "") { |
826 | #if ($pg->{warnings} ne "") { |
| … | |
… | |
| 695 | return ""; |
847 | return ""; |
| 696 | } |
848 | } |
| 697 | |
849 | |
| 698 | ##### output utilities ##### |
850 | ##### output utilities ##### |
| 699 | |
851 | |
| 700 | sub attemptResults($$$$$$) { |
852 | sub attemptResults { |
| 701 | my $self = shift; |
853 | my $self = shift; |
| 702 | my $pg = shift; |
854 | my $pg = shift; |
| 703 | my $showAttemptAnswers = shift; |
855 | my $showAttemptAnswers = shift; |
| 704 | my $showCorrectAnswers = shift; |
856 | my $showCorrectAnswers = shift; |
| 705 | my $showAttemptResults = $showAttemptAnswers && shift; |
857 | my $showAttemptResults = $showAttemptAnswers && shift; |
| 706 | my $showSummary = shift; |
858 | my $showSummary = shift; |
| 707 | my $showAttemptPreview = shift || 0; |
859 | my $showAttemptPreview = shift || 0; |
|
|
860 | |
| 708 | my $ce = $self->{ce}; |
861 | my $ce = $self->r->ce; |
|
|
862 | |
| 709 | my $problemResult = $pg->{result}; # the overall result of the problem |
863 | my $problemResult = $pg->{result}; # the overall result of the problem |
| 710 | my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; |
864 | my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; |
| 711 | |
865 | |
| 712 | my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; |
866 | my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; |
| 713 | |
867 | |
| 714 | my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; |
868 | my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; |
| 715 | my $imgGen = WeBWorK::PG::ImageGenerator->new( |
869 | my $imgGen = WeBWorK::PG::ImageGenerator->new( |
| 716 | tempDir => $ce->{webworkDirs}->{tmp}, |
870 | tempDir => $ce->{webworkDirs}->{tmp}, |
| 717 | dir => $ce->{courseDirs}->{html_temp}, |
|
|
| 718 | url => $ce->{courseURLs}->{html_temp}, |
|
|
| 719 | basename => $basename, |
|
|
| 720 | latex => $ce->{externalPrograms}->{latex}, |
871 | latex => $ce->{externalPrograms}->{latex}, |
| 721 | dvipng => $ce->{externalPrograms}->{dvipng}, |
872 | dvipng => $ce->{externalPrograms}->{dvipng}, |
|
|
873 | useCache => 1, |
|
|
874 | cacheDir => $ce->{webworkDirs}->{equationCache}, |
|
|
875 | cacheURL => $ce->{webworkURLs}->{equationCache}, |
|
|
876 | cacheDB => $ce->{webworkFiles}->{equationCacheDB}, |
| 722 | ); |
877 | ); |
| 723 | |
878 | |
| 724 | my $header; |
879 | my $header; |
| 725 | #$header .= CGI::th("Part"); |
880 | #$header .= CGI::th("Part"); |
| 726 | $header .= $showAttemptAnswers ? CGI::th("Entered") : ""; |
881 | $header .= $showAttemptAnswers ? CGI::th("Entered") : ""; |
| … | |
… | |
| 737 | ? $self->previewAnswer($answerResult, $imgGen) |
892 | ? $self->previewAnswer($answerResult, $imgGen) |
| 738 | : ""); |
893 | : ""); |
| 739 | my $correctAnswer = $answerResult->{correct_ans}; |
894 | my $correctAnswer = $answerResult->{correct_ans}; |
| 740 | my $answerScore = $answerResult->{score}; |
895 | my $answerScore = $answerResult->{score}; |
| 741 | my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; |
896 | my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; |
| 742 | |
897 | #FIXME --Can we be sure that $answerScore is an integer-- could the problem give partial credit? |
| 743 | $numCorrect += $answerScore > 0; |
898 | $numCorrect += $answerScore > 0; |
| 744 | my $resultString = $answerScore ? "correct" : "incorrect"; |
899 | my $resultString = $answerScore == 1 ? "correct" : "incorrect"; |
| 745 | |
900 | |
| 746 | # get rid of the goofy prefix on the answer names (supposedly, the format |
901 | # get rid of the goofy prefix on the answer names (supposedly, the format |
| 747 | # of the answer names is changeable. this only fixes it for "AnSwEr" |
902 | # of the answer names is changeable. this only fixes it for "AnSwEr" |
| 748 | $name =~ s/^AnSwEr//; |
903 | #$name =~ s/^AnSwEr//; |
| 749 | |
904 | |
| 750 | my $row; |
905 | my $row; |
| 751 | #$row .= CGI::td($name); |
906 | #$row .= CGI::td($name); |
| 752 | $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : ""; |
907 | $row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : ""; |
| 753 | $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : ""; |
908 | $row .= $showAttemptPreview ? CGI::td($self->nbsp($preview)) : ""; |
| 754 | $row .= $showCorrectAnswers ? CGI::td(nbsp($correctAnswer)) : ""; |
909 | $row .= $showCorrectAnswers ? CGI::td($self->nbsp($correctAnswer)) : ""; |
| 755 | $row .= $showAttemptResults ? CGI::td(nbsp($resultString)) : ""; |
910 | $row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : ""; |
| 756 | $row .= $answerMessage ? CGI::td(nbsp($answerMessage)) : ""; |
911 | $row .= $showMessages ? CGI::td($self->nbsp($answerMessage)) : ""; |
| 757 | push @tableRows, $row; |
912 | push @tableRows, $row; |
| 758 | } |
913 | } |
| 759 | |
914 | |
| 760 | # render equation images |
915 | # render equation images |
| 761 | $imgGen->render(refresh => 1); |
916 | $imgGen->render(refresh => 1); |
| 762 | |
917 | |
| 763 | my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; |
918 | # my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; |
| 764 | my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); |
919 | my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); |
|
|
920 | # FIXME -- I left the old code in in case we have to back out. |
| 765 | my $summary = "On this attempt, you answered $numCorrect out of " |
921 | # my $summary = "On this attempt, you answered $numCorrect out of " |
| 766 | . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; |
922 | # . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; |
| 767 | return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); |
923 | my $summary = ""; |
|
|
924 | if (scalar @answerNames == 1) { |
|
|
925 | if ($numCorrect == scalar @answerNames) { |
|
|
926 | $summary .= "The above answer is correct."; |
|
|
927 | } else { |
|
|
928 | $summary .= "The above answer is NOT correct."; |
|
|
929 | } |
|
|
930 | } else { |
|
|
931 | if ($numCorrect == scalar @answerNames) { |
|
|
932 | $summary .= "All of the above answers are correct."; |
|
|
933 | } else { |
|
|
934 | $summary .= "At least one of the above answers is NOT correct."; |
|
|
935 | } |
|
|
936 | } |
|
|
937 | |
|
|
938 | return |
|
|
939 | CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) |
|
|
940 | . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); |
| 768 | } |
941 | } |
|
|
942 | |
| 769 | sub nbsp { |
943 | #sub nbsp { |
| 770 | my $str = shift; |
944 | # my $str = shift; |
| 771 | ($str =~/\S/) ? $str : ' ' ; # returns non-breaking space for empty strings |
945 | # ($str =~/\S/) ? $str : ' ' ; # returns non-breaking space for empty strings |
| 772 | # tricky cases: $str =0; |
946 | # # tricky cases: $str =0; |
| 773 | # $str is a complex number |
947 | # # $str is a complex number |
| 774 | } |
948 | #} |
|
|
949 | |
| 775 | sub viewOptions($) { |
950 | sub viewOptions { |
| 776 | my $self = shift; |
951 | my ($self) = @_; |
|
|
952 | |
| 777 | my $displayMode = $self->{displayMode}; |
953 | my $displayMode = $self->{displayMode}; |
| 778 | my %must = %{ $self->{must} }; |
954 | my %must = %{ $self->{must} }; |
| 779 | my %can = %{ $self->{can} }; |
955 | my %can = %{ $self->{can} }; |
| 780 | my %will = %{ $self->{will} }; |
956 | my %will = %{ $self->{will} }; |
| 781 | |
957 | |
| … | |
… | |
| 785 | CGI::checkbox( |
961 | CGI::checkbox( |
| 786 | -name => "showOldAnswers", |
962 | -name => "showOldAnswers", |
| 787 | -checked => $will{showOldAnswers}, |
963 | -checked => $will{showOldAnswers}, |
| 788 | -label => "Saved answers", |
964 | -label => "Saved answers", |
| 789 | ), " ".CGI::br(); |
965 | ), " ".CGI::br(); |
| 790 | $can{showCorrectAnswers} and $optionLine .= join "", |
966 | |
| 791 | CGI::checkbox( |
|
|
| 792 | -name => "showCorrectAnswers", |
|
|
| 793 | -checked => $will{showCorrectAnswers}, |
|
|
| 794 | -label => "Correct answers", |
|
|
| 795 | ), " ".CGI::br(); |
|
|
| 796 | $can{showHints} and $optionLine .= join "", |
|
|
| 797 | CGI::checkbox( |
|
|
| 798 | -name => "showHints", |
|
|
| 799 | -checked => $will{showHints}, |
|
|
| 800 | -label => "Hints", |
|
|
| 801 | ), " ".CGI::br(); |
|
|
| 802 | $can{showSolutions} and $optionLine .= join "", |
|
|
| 803 | CGI::checkbox( |
|
|
| 804 | -name => "showSolutions", |
|
|
| 805 | -checked => $will{showSolutions}, |
|
|
| 806 | -label => "Solutions", |
|
|
| 807 | ), " ".CGI::br(); |
|
|
| 808 | $optionLine and $optionLine .= join "", CGI::br(); |
967 | $optionLine and $optionLine .= join "", CGI::br(); |
| 809 | |
968 | |
| 810 | return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"}, |
969 | return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"}, |
| 811 | "View equations as: ".CGI::br(), |
970 | "View equations as: ".CGI::br(), |
| 812 | CGI::radio_group( |
971 | CGI::radio_group( |
| … | |
… | |
| 823 | $optionLine, |
982 | $optionLine, |
| 824 | CGI::submit(-name=>"redisplay", -label=>"Save Options"), |
983 | CGI::submit(-name=>"redisplay", -label=>"Save Options"), |
| 825 | ); |
984 | ); |
| 826 | } |
985 | } |
| 827 | |
986 | |
| 828 | sub previewAnswer($$) { |
987 | sub previewAnswer { |
| 829 | my ($self, $answerResult, $imgGen) = @_; |
988 | my ($self, $answerResult, $imgGen) = @_; |
| 830 | my $ce = $self->{ce}; |
989 | my $ce = $self->r->ce; |
| 831 | my $effectiveUser = $self->{effectiveUser}; |
990 | my $effectiveUser = $self->{effectiveUser}; |
| 832 | my $set = $self->{set}; |
991 | my $set = $self->{set}; |
| 833 | my $problem = $self->{problem}; |
992 | my $problem = $self->{problem}; |
| 834 | my $displayMode = $self->{displayMode}; |
993 | my $displayMode = $self->{displayMode}; |
| 835 | |
994 | |
| … | |
… | |
| 855 | if ($?) { |
1014 | if ($?) { |
| 856 | return "<b>[tth failed: $? $@]</b>"; |
1015 | return "<b>[tth failed: $? $@]</b>"; |
| 857 | } |
1016 | } |
| 858 | return $result; |
1017 | return $result; |
| 859 | } elsif ($displayMode eq "images") { |
1018 | } elsif ($displayMode eq "images") { |
| 860 | ## how are we going to name this? |
|
|
| 861 | #my $targetPathCommon = "/m2i/" |
|
|
| 862 | # . $effectiveUser->user_id . "." |
|
|
| 863 | # . $set->set_id . "." |
|
|
| 864 | # . $problem->problem_id . "." |
|
|
| 865 | # . $answerResult->{ans_name} . ".png"; |
|
|
| 866 | # |
|
|
| 867 | ## figure out where to put things |
|
|
| 868 | #my $wd = makeTempDirectory($ce->{courseDirs}->{html_temp}, "webwork-dvipng"); |
|
|
| 869 | #my $latex = $ce->{externalPrograms}->{latex}; |
|
|
| 870 | #my $dvipng = $ce->{externalPrograms}->{dvipng}; |
|
|
| 871 | #my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon; |
|
|
| 872 | # # should use surePathToTmpFile, but we have to |
|
|
| 873 | # # isolate it from the problem enivronment first |
|
|
| 874 | #my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon; |
|
|
| 875 | # |
|
|
| 876 | ## call dvipng to generate a preview |
|
|
| 877 | #dvipng($wd, $latex, $dvipng, $tex, $targetPath); |
|
|
| 878 | #rmtree($wd, 0, 0); |
|
|
| 879 | #if (-e $targetPath) { |
|
|
| 880 | # return "<img src=\"$targetURL\" alt=\"$tex\" />"; |
|
|
| 881 | #} else { |
|
|
| 882 | # return "<b>[math2img failed]</b>"; |
|
|
| 883 | #} |
|
|
| 884 | $imgGen->add($answerResult->{preview_latex_string}); |
1019 | $imgGen->add($answerResult->{preview_latex_string}); |
| 885 | |
|
|
| 886 | } |
1020 | } |
| 887 | } |
1021 | } |
| 888 | |
|
|
| 889 | ##### logging subroutine #### |
|
|
| 890 | |
|
|
| 891 | |
|
|
| 892 | |
1022 | |
| 893 | ##### permission queries ##### |
1023 | ##### permission queries ##### |
| 894 | |
1024 | |
| 895 | # this stuff should be abstracted out into the permissions system |
1025 | # this stuff should be abstracted out into the permissions system |
| 896 | # however, the permission system only knows about things in the |
1026 | # however, the permission system only knows about things in the |
| 897 | # course environment and the username. hmmm... |
1027 | # course environment and the username. hmmm... |
| 898 | |
1028 | |
| 899 | # also, i should fix these so that they have a consistent calling |
1029 | # also, i should fix these so that they have a consistent calling |
| 900 | # format -- perhaps: |
1030 | # format -- perhaps: |
| 901 | # canPERM($courseEnv, $user, $set, $problem, $permissionLevel) |
1031 | # canPERM($ce, $user, $set, $problem, $permissionLevel) |
| 902 | |
1032 | |
| 903 | sub canShowCorrectAnswers($$) { |
1033 | sub canShowCorrectAnswers($$) { |
| 904 | my ($permissionLevel, $answerDate) = @_; |
1034 | my ($permissionLevel, $answerDate) = @_; |
| 905 | return $permissionLevel > 0 || time > $answerDate; |
1035 | return $permissionLevel > 0 || time > $answerDate; |
| 906 | } |
1036 | } |