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