| 1 | ################################################################################ |
1 | ################################################################################ |
| 2 | # WeBWorK Online Homework Delivery System |
2 | # WeBWorK Online Homework Delivery System |
| 3 | # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ |
3 | # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ |
| 4 | # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.114 2004/02/04 13:22:56 gage Exp $ |
4 | # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.208 2007/08/09 17:24:33 sh002i Exp $ |
| 5 | # |
5 | # |
| 6 | # This program is free software; you can redistribute it and/or modify it under |
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 |
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 |
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. |
9 | # version, or (b) the "Artistic License" which comes with this package. |
| … | |
… | |
| 23 | |
23 | |
| 24 | =cut |
24 | =cut |
| 25 | |
25 | |
| 26 | use strict; |
26 | use strict; |
| 27 | use warnings; |
27 | use warnings; |
| 28 | use CGI qw(); |
28 | #use CGI qw(-nosticky ); |
|
|
29 | use WeBWorK::CGI; |
| 29 | use File::Path qw(rmtree); |
30 | use File::Path qw(rmtree); |
|
|
31 | use WeBWorK::Debug; |
| 30 | use WeBWorK::Form; |
32 | use WeBWorK::Form; |
| 31 | use WeBWorK::PG; |
33 | use WeBWorK::PG; |
| 32 | use WeBWorK::PG::ImageGenerator; |
34 | use WeBWorK::PG::ImageGenerator; |
| 33 | use WeBWorK::PG::IO; |
35 | use WeBWorK::PG::IO; |
| 34 | use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory); |
36 | use WeBWorK::Utils qw(readFile writeLog writeCourseLog encodeAnswers decodeAnswers |
|
|
37 | ref2string makeTempDirectory path_is_subdir sortByName before after between); |
| 35 | use WeBWorK::DB::Utils qw(global2user user2global findDefaults); |
38 | use WeBWorK::DB::Utils qw(global2user user2global); |
| 36 | use WeBWorK::Timing; |
39 | use URI::Escape; |
| 37 | |
40 | |
|
|
41 | use WeBWorK::Utils::Tasks qw(fake_set fake_problem); |
| 38 | |
42 | |
| 39 | ############################################################ |
43 | ################################################################################ |
|
|
44 | # CGI param interface to this module (up-to-date as of v1.153) |
|
|
45 | ################################################################################ |
|
|
46 | |
|
|
47 | # Standard params: |
| 40 | # |
48 | # |
| 41 | # user |
49 | # user - user ID of real user |
| 42 | # effectiveUser |
50 | # key - session key |
| 43 | # key |
51 | # effectiveUser - user ID of effective user |
| 44 | # |
52 | # |
| 45 | # displayMode |
53 | # Integration with PGProblemEditor: |
| 46 | # showOldAnswers |
|
|
| 47 | # showCorrectAnswers |
|
|
| 48 | # showHints |
|
|
| 49 | # showSolutions |
|
|
| 50 | # |
54 | # |
| 51 | # AnSwEr# - answer blanks in problem |
55 | # editMode - if set, indicates alternate problem source location. |
|
|
56 | # can be "temporaryFile" or "savedFile". |
| 52 | # |
57 | # |
| 53 | # redisplay - name of the "Redisplay Problem" button |
58 | # sourceFilePath - path to file to be edited |
| 54 | # submitAnswers - name of "Submit Answers" button |
59 | # problemSeed - force problem seed to value |
| 55 | # checkAnswers - name of the "Check Answers" button |
60 | # success - success message to display |
| 56 | # previewAnswers - name of the "Preview Answers" button |
61 | # failure - failure message to display |
| 57 | # |
62 | # |
| 58 | # FIXME: this table is heinously out of date |
63 | # Rendering options: |
| 59 | # |
64 | # |
|
|
65 | # displayMode - name of display mode to use |
|
|
66 | # |
|
|
67 | # showOldAnswers - request that last entered answer be shown (if allowed) |
|
|
68 | # showCorrectAnswers - request that correct answers be shown (if allowed) |
|
|
69 | # showHints - request that hints be shown (if allowed) |
|
|
70 | # showSolutions - request that solutions be shown (if allowed) |
|
|
71 | # |
|
|
72 | # Problem interaction: |
|
|
73 | # |
|
|
74 | # AnSwEr# - answer blanks in problem |
|
|
75 | # |
|
|
76 | # redisplay - name of the "Redisplay Problem" button |
|
|
77 | # submitAnswers - name of "Submit Answers" button |
|
|
78 | # checkAnswers - name of the "Check Answers" button |
|
|
79 | # previewAnswers - name of the "Preview Answers" button |
|
|
80 | |
| 60 | ############################################################ |
81 | ################################################################################ |
|
|
82 | # "can" methods |
|
|
83 | ################################################################################ |
| 61 | |
84 | |
| 62 | # FIXME: what is this? |
85 | # Subroutines to determine if a user "can" perform an action. Each subroutine is |
| 63 | sub templateName { |
86 | # called with the following arguments: |
| 64 | "problem"; |
87 | # |
|
|
88 | # ($self, $User, $EffectiveUser, $Set, $Problem) |
|
|
89 | |
|
|
90 | # Note that significant parts of the "can" methods are lifted into the |
|
|
91 | # GatewayQuiz module. It isn't direct, however, because of the necessity |
|
|
92 | # of dealing with versioning there. |
|
|
93 | |
|
|
94 | sub can_showOldAnswers { |
|
|
95 | #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; |
|
|
96 | |
|
|
97 | return 1; |
| 65 | } |
98 | } |
|
|
99 | |
|
|
100 | sub can_showCorrectAnswers { |
|
|
101 | my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; |
|
|
102 | my $authz = $self->r->authz; |
|
|
103 | |
|
|
104 | return |
|
|
105 | after($Set->answer_date) |
|
|
106 | || |
|
|
107 | $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date") |
|
|
108 | ; |
|
|
109 | } |
|
|
110 | |
|
|
111 | sub can_showHints { |
|
|
112 | #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; |
|
|
113 | |
|
|
114 | return 1; |
|
|
115 | } |
|
|
116 | |
|
|
117 | sub can_showSolutions { |
|
|
118 | my ($self, $User, $EffectiveUser, $Set, $Problem) = @_; |
|
|
119 | my $authz = $self->r->authz; |
|
|
120 | |
|
|
121 | return |
|
|
122 | after($Set->answer_date) |
|
|
123 | || |
|
|
124 | $authz->hasPermissions($User->user_id, "show_solutions_before_answer_date") |
|
|
125 | ; |
|
|
126 | } |
|
|
127 | |
|
|
128 | sub can_recordAnswers { |
|
|
129 | my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; |
|
|
130 | my $authz = $self->r->authz; |
|
|
131 | my $thisAttempt = $submitAnswers ? 1 : 0; |
|
|
132 | if ($User->user_id ne $EffectiveUser->user_id) { |
|
|
133 | return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student"); |
|
|
134 | } |
|
|
135 | if (before($Set->open_date)) { |
|
|
136 | return $authz->hasPermissions($User->user_id, "record_answers_before_open_date"); |
|
|
137 | } elsif (between($Set->open_date, $Set->due_date)) { |
|
|
138 | my $max_attempts = $Problem->max_attempts; |
|
|
139 | my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; |
|
|
140 | if ($max_attempts == -1 or $attempts_used < $max_attempts) { |
|
|
141 | return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts"); |
|
|
142 | } else { |
|
|
143 | return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts"); |
|
|
144 | } |
|
|
145 | } elsif (between($Set->due_date, $Set->answer_date)) { |
|
|
146 | return $authz->hasPermissions($User->user_id, "record_answers_after_due_date"); |
|
|
147 | } elsif (after($Set->answer_date)) { |
|
|
148 | return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date"); |
|
|
149 | } |
|
|
150 | } |
|
|
151 | |
|
|
152 | sub can_checkAnswers { |
|
|
153 | my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_; |
|
|
154 | my $authz = $self->r->authz; |
|
|
155 | my $thisAttempt = $submitAnswers ? 1 : 0; |
|
|
156 | |
|
|
157 | if (before($Set->open_date)) { |
|
|
158 | return $authz->hasPermissions($User->user_id, "check_answers_before_open_date"); |
|
|
159 | } elsif (between($Set->open_date, $Set->due_date)) { |
|
|
160 | my $max_attempts = $Problem->max_attempts; |
|
|
161 | my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt; |
|
|
162 | if ($max_attempts == -1 or $attempts_used < $max_attempts) { |
|
|
163 | return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts"); |
|
|
164 | } else { |
|
|
165 | return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts"); |
|
|
166 | } |
|
|
167 | } elsif (between($Set->due_date, $Set->answer_date)) { |
|
|
168 | return $authz->hasPermissions($User->user_id, "check_answers_after_due_date"); |
|
|
169 | } elsif (after($Set->answer_date)) { |
|
|
170 | return $authz->hasPermissions($User->user_id, "check_answers_after_answer_date"); |
|
|
171 | } |
|
|
172 | } |
|
|
173 | |
|
|
174 | # Reset the default in some cases |
|
|
175 | sub set_showOldAnswers_default { |
|
|
176 | my ($self, $ce, $userName, $authz, $set) = @_; |
|
|
177 | # these people always use the system/course default, so don't |
|
|
178 | # override the value of ...->{showOldAnswers} |
|
|
179 | return if $authz->hasPermissions($userName, "can_always_use_show_old_answers_default"); |
|
|
180 | # this person should always default to 0 |
|
|
181 | $ce->{pg}->{options}->{showOldAnswers} = 0 |
|
|
182 | unless ($authz->hasPermissions($userName, "can_show_old_answers_by_default")); |
|
|
183 | # we are after the due date, so default to not showing it |
|
|
184 | $ce->{pg}->{options}->{showOldAnswers} = 0 if $set->{due_date} && after($set->{due_date}); |
|
|
185 | } |
|
|
186 | |
|
|
187 | ################################################################################ |
|
|
188 | # output utilities |
|
|
189 | ################################################################################ |
|
|
190 | |
|
|
191 | # Note: the substance of attemptResults is lifted into GatewayQuiz.pm, |
|
|
192 | # with some changes to the output format |
|
|
193 | |
|
|
194 | sub attemptResults { |
|
|
195 | my $self = shift; |
|
|
196 | my $pg = shift; |
|
|
197 | my $showAttemptAnswers = shift; |
|
|
198 | my $showCorrectAnswers = shift; |
|
|
199 | my $showAttemptResults = $showAttemptAnswers && shift; |
|
|
200 | my $showSummary = shift; |
|
|
201 | my $showAttemptPreview = shift || 0; |
|
|
202 | |
|
|
203 | my $ce = $self->r->ce; |
|
|
204 | |
|
|
205 | my $problemResult = $pg->{result}; # the overall result of the problem |
|
|
206 | my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; |
|
|
207 | |
|
|
208 | my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; |
|
|
209 | |
|
|
210 | my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; |
|
|
211 | |
|
|
212 | # to make grabbing these options easier, we'll pull them out now... |
|
|
213 | my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}}; |
|
|
214 | |
|
|
215 | my $imgGen = WeBWorK::PG::ImageGenerator->new( |
|
|
216 | tempDir => $ce->{webworkDirs}->{tmp}, |
|
|
217 | latex => $ce->{externalPrograms}->{latex}, |
|
|
218 | dvipng => $ce->{externalPrograms}->{dvipng}, |
|
|
219 | useCache => 1, |
|
|
220 | cacheDir => $ce->{webworkDirs}->{equationCache}, |
|
|
221 | cacheURL => $ce->{webworkURLs}->{equationCache}, |
|
|
222 | cacheDB => $ce->{webworkFiles}->{equationCacheDB}, |
|
|
223 | dvipng_align => $imagesModeOptions{dvipng_align}, |
|
|
224 | dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, |
|
|
225 | ); |
|
|
226 | |
|
|
227 | my $header; |
|
|
228 | #$header .= CGI::th("Part"); |
|
|
229 | $header .= $showAttemptAnswers ? CGI::th("Entered") : ""; |
|
|
230 | $header .= $showAttemptPreview ? CGI::th("Answer Preview") : ""; |
|
|
231 | $header .= $showCorrectAnswers ? CGI::th("Correct") : ""; |
|
|
232 | $header .= $showAttemptResults ? CGI::th("Result") : ""; |
|
|
233 | $header .= $showMessages ? CGI::th("Messages") : ""; |
|
|
234 | my $fully = ''; |
|
|
235 | my @tableRows = ( $header ); |
|
|
236 | my $numCorrect = 0; |
|
|
237 | my $numBlanks =0; |
|
|
238 | my $tthPreambleCache; |
|
|
239 | foreach my $name (@answerNames) { |
|
|
240 | my $answerResult = $pg->{answers}->{$name}; |
|
|
241 | my $studentAnswer = $answerResult->{student_ans}; # original_student_ans |
|
|
242 | my $preview = ($showAttemptPreview |
|
|
243 | ? $self->previewAnswer($answerResult, $imgGen, \$tthPreambleCache) |
|
|
244 | : ""); |
|
|
245 | my $correctAnswer = $answerResult->{correct_ans}; |
|
|
246 | my $answerScore = $answerResult->{score}; |
|
|
247 | my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; |
|
|
248 | $answerMessage =~ s/\n/<BR>/g; |
|
|
249 | $numCorrect += $answerScore >= 1; |
|
|
250 | $numBlanks++ unless $studentAnswer =~/\S/ || $answerScore >= 1; # unless student answer contains entry |
|
|
251 | my $resultString = $answerScore >= 1 ? "correct" : |
|
|
252 | $answerScore > 0 ? int($answerScore*100)."% correct" : |
|
|
253 | "incorrect"; |
|
|
254 | $fully = 'completely ' if $answerScore >0 and $answerScore < 1; |
|
|
255 | |
|
|
256 | # get rid of the goofy prefix on the answer names (supposedly, the format |
|
|
257 | # of the answer names is changeable. this only fixes it for "AnSwEr" |
|
|
258 | #$name =~ s/^AnSwEr//; |
|
|
259 | |
|
|
260 | my $row; |
|
|
261 | #$row .= CGI::td($name); |
|
|
262 | $row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : ""; |
|
|
263 | $row .= $showAttemptPreview ? CGI::td($self->nbsp($preview)) : ""; |
|
|
264 | $row .= $showCorrectAnswers ? CGI::td($self->nbsp($correctAnswer)) : ""; |
|
|
265 | $row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : ""; |
|
|
266 | $row .= $showMessages ? CGI::td({-class=>"Message"},$self->nbsp($answerMessage)) : ""; |
|
|
267 | push @tableRows, $row; |
|
|
268 | } |
|
|
269 | |
|
|
270 | # render equation images |
|
|
271 | $imgGen->render(refresh => 1); |
|
|
272 | |
|
|
273 | # my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; |
|
|
274 | my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); |
|
|
275 | # FIXME -- I left the old code in in case we have to back out. |
|
|
276 | # my $summary = "On this attempt, you answered $numCorrect out of " |
|
|
277 | # . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; |
|
|
278 | my $summary = ""; |
|
|
279 | unless (defined($problemResult->{summary}) and $problemResult->{summary} =~ /\S/) { |
|
|
280 | if (scalar @answerNames == 1) { #default messages |
|
|
281 | if ($numCorrect == scalar @answerNames) { |
|
|
282 | $summary .= CGI::div({class=>"ResultsWithoutError"},"The answer above is correct."); |
|
|
283 | } else { |
|
|
284 | $summary .= CGI::div({class=>"ResultsWithError"},"The answer above is NOT ${fully}correct."); |
|
|
285 | } |
|
|
286 | } else { |
|
|
287 | if ($numCorrect == scalar @answerNames) { |
|
|
288 | $summary .= CGI::div({class=>"ResultsWithoutError"},"All of the answers above are correct."); |
|
|
289 | } |
|
|
290 | unless ($numCorrect + $numBlanks == scalar( @answerNames)) { |
|
|
291 | $summary .= CGI::div({class=>"ResultsWithError"},"At least one of the answers above is NOT ${fully}correct."); |
|
|
292 | } |
|
|
293 | if ($numBlanks) { |
|
|
294 | my $s = ($numBlanks>1)?'':'s'; |
|
|
295 | $summary .= CGI::div({class=>"ResultsAlert"},"$numBlanks of the questions remain$s unanswered."); |
|
|
296 | } |
|
|
297 | } |
|
|
298 | } else { |
|
|
299 | $summary = $problemResult->{summary}; # summary has been defined by grader |
|
|
300 | } |
|
|
301 | return |
|
|
302 | CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) |
|
|
303 | . ($showSummary ? CGI::p({class=>'attemptResultsSummary'},$summary) : ""); |
|
|
304 | } |
|
|
305 | |
|
|
306 | |
|
|
307 | # Note: previewAnswer is lifted into GatewayQuiz.pm |
|
|
308 | |
|
|
309 | sub previewAnswer { |
|
|
310 | my ($self, $answerResult, $imgGen, $tthPreambleCache) = @_; |
|
|
311 | my $ce = $self->r->ce; |
|
|
312 | my $effectiveUser = $self->{effectiveUser}; |
|
|
313 | my $set = $self->{set}; |
|
|
314 | my $problem = $self->{problem}; |
|
|
315 | my $displayMode = $self->{displayMode}; |
|
|
316 | |
|
|
317 | # note: right now, we have to do things completely differently when we are |
|
|
318 | # rendering math from INSIDE the translator and from OUTSIDE the translator. |
|
|
319 | # so we'll just deal with each case explicitly here. there's some code |
|
|
320 | # duplication that can be dealt with later by abstracting out tth/dvipng/etc. |
|
|
321 | |
|
|
322 | my $tex = $answerResult->{preview_latex_string}; |
|
|
323 | |
|
|
324 | return "" unless defined $tex and $tex ne ""; |
|
|
325 | |
|
|
326 | if ($displayMode eq "plainText") { |
|
|
327 | return $tex; |
|
|
328 | } elsif ($displayMode eq "formattedText") { |
|
|
329 | |
|
|
330 | # read the TTH preamble, or use the cached copy passed in from the caller |
|
|
331 | my $tthPreamble=''; |
|
|
332 | if (defined $$tthPreambleCache) { |
|
|
333 | $tthPreamble = $$tthPreambleCache; |
|
|
334 | } else { |
|
|
335 | my $tthPreambleFile = $ce->{courseDirs}->{templates} . "/tthPreamble.tex"; |
|
|
336 | if (-r $tthPreambleFile) { |
|
|
337 | $tthPreamble = readFile($tthPreambleFile); |
|
|
338 | # thanks to Jim Martino. each line in the definition file should end with |
|
|
339 | #a % to prevent adding supurious paragraphs to output: |
|
|
340 | $tthPreamble =~ s/(.)\n/$1%\n/g; |
|
|
341 | # solves the problem if the file doesn't end with a return: |
|
|
342 | $tthPreamble .="%\n"; |
|
|
343 | # store preamble in cache: |
|
|
344 | $$tthPreambleCache = $tthPreamble; |
|
|
345 | } else { |
|
|
346 | } |
|
|
347 | } |
|
|
348 | |
|
|
349 | # construct TTH command line |
|
|
350 | my $tthCommand = $ce->{externalPrograms}->{tth} |
|
|
351 | . " -L -f5 -u -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" |
|
|
352 | . $tthPreamble . "\\[" . $tex . "\\]\n" |
|
|
353 | . "END_OF_INPUT\n"; |
|
|
354 | |
|
|
355 | # call tth |
|
|
356 | my $result = `$tthCommand`; |
|
|
357 | if ($?) { |
|
|
358 | return "<b>[tth failed: $? $@]</b>"; |
|
|
359 | } else { |
|
|
360 | # avoid border problems in tables and remove unneeded initial <br> |
|
|
361 | $result =~ s/(<table [^>]*)>/$1 CLASS="ArrayLayout">/gi; |
|
|
362 | $result =~ s!\s*<br clear="all" />!!; |
|
|
363 | return $result; |
|
|
364 | } |
|
|
365 | |
|
|
366 | } elsif ($displayMode eq "images") { |
|
|
367 | $imgGen->add($tex); |
|
|
368 | } elsif ($displayMode eq "jsMath") { |
|
|
369 | $tex =~ s/</</g; $tex =~ s/>/>/g; |
|
|
370 | return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>'; |
|
|
371 | } |
|
|
372 | } |
|
|
373 | |
|
|
374 | ################################################################################ |
|
|
375 | # Template escape implementations |
|
|
376 | ################################################################################ |
| 66 | |
377 | |
| 67 | sub pre_header_initialize { |
378 | sub pre_header_initialize { |
| 68 | my ($self, $setName, $problemNumber) = @_; |
379 | my ($self) = @_; |
| 69 | my $r = $self->{r}; |
380 | my $r = $self->r; |
| 70 | my $courseEnv = $self->{ce}; |
381 | my $ce = $r->ce; |
| 71 | my $db = $self->{db}; |
382 | my $db = $r->db; |
|
|
383 | my $authz = $r->authz; |
|
|
384 | my $urlpath = $r->urlpath; |
|
|
385 | |
|
|
386 | my $setName = $urlpath->arg("setID"); |
|
|
387 | my $problemNumber = $r->urlpath->arg("problemID"); |
| 72 | my $userName = $r->param('user'); |
388 | my $userName = $r->param('user'); |
| 73 | my $effectiveUserName = $r->param('effectiveUser'); |
389 | my $effectiveUserName = $r->param('effectiveUser'); |
| 74 | my $key = $r->param('key'); |
390 | my $key = $r->param('key'); |
|
|
391 | my $editMode = $r->param("editMode"); |
| 75 | |
392 | |
| 76 | my $user = $db->getUser($userName); # checked |
393 | my $user = $db->getUser($userName); # checked |
| 77 | die "record for user $userName (real user) does not exist." |
394 | die "record for user $userName (real user) does not exist." |
| 78 | unless defined $user; |
395 | unless defined $user; |
| 79 | |
396 | |
| 80 | my $effectiveUser = $db->getUser($effectiveUserName); # checked |
397 | my $effectiveUser = $db->getUser($effectiveUserName); # checked |
| 81 | die "record for user $effectiveUserName (effective user) does not exist." |
398 | die "record for user $effectiveUserName (effective user) does not exist." |
| 82 | unless defined $effectiveUser; |
399 | unless defined $effectiveUser; |
| 83 | |
400 | |
| 84 | my $PermissionLevel = $db->getPermissionLevel($userName); # checked |
|
|
| 85 | die "permission level record for user $userName does not exist (but the user does? odd...)" |
|
|
| 86 | unless defined $PermissionLevel; |
|
|
| 87 | my $permissionLevel = $PermissionLevel->permission; |
|
|
| 88 | |
|
|
| 89 | # obtain the merged set for $effectiveUser |
401 | # obtain the merged set for $effectiveUser |
| 90 | my $set = $db->getMergedSet($effectiveUserName, $setName); # checked |
402 | my $set = $db->getMergedSet($effectiveUserName, $setName); # checked |
|
|
403 | |
|
|
404 | $self->set_showOldAnswers_default($ce, $userName, $authz, $set); |
|
|
405 | |
|
|
406 | # Database fix (in case of undefined published values) |
|
|
407 | # this is only necessary because some people keep holding to ww1.9 which did not have a published field |
|
|
408 | # make sure published is set to 0 or 1 |
|
|
409 | if ( $set and $set->published ne "0" and $set->published ne "1") { |
|
|
410 | my $globalSet = $db->getGlobalSet($set->set_id); |
|
|
411 | $globalSet->published("1"); # defaults to published |
|
|
412 | $db->putGlobalSet($globalSet); |
|
|
413 | $set = $db->getMergedSet($effectiveUserName, $setName); |
|
|
414 | } else { |
|
|
415 | # don't do anything just yet, maybe we're a professor and we're |
|
|
416 | # fabricating a set or haven't assigned it to ourselves just yet |
|
|
417 | } |
| 91 | |
418 | |
| 92 | # obtain the merged problem for $effectiveUser |
419 | # obtain the merged problem for $effectiveUser |
| 93 | my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked |
420 | my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked |
| 94 | |
421 | |
| 95 | my $editMode = $r->param("editMode"); |
422 | if ($authz->hasPermissions($userName, "modify_problem_sets")) { |
| 96 | |
|
|
| 97 | if ($permissionLevel > 0 and defined $editMode) { |
|
|
| 98 | # professors are allowed to fabricate sets and problems not |
423 | # professors are allowed to fabricate sets and problems not |
| 99 | # assigned to them (or anyone). this allows them to use the |
424 | # assigned to them (or anyone). this allows them to use the |
| 100 | # editor to |
425 | # editor to |
| 101 | |
426 | |
| 102 | # if that is not yet defined obtain the global set, convert |
427 | # if a User Set does not exist for this user and this set |
| 103 | # it to a user set, and add fake user data |
428 | # then we check the Global Set |
|
|
429 | # if that does not exist we create a fake set |
|
|
430 | # if it does, we add fake user data |
| 104 | unless (defined $set) { |
431 | unless (defined $set) { |
| 105 | my $userSetClass = $db->{set_user}->{record}; |
432 | my $userSetClass = $db->{set_user}->{record}; |
| 106 | my $globalSet = $db->getGlobalSet($setName); # checked |
433 | my $globalSet = $db->getGlobalSet($setName); # checked |
| 107 | # if the global set doesn't exist either, bail! |
434 | |
| 108 | die "Set $setName does not exist" |
435 | if (not defined $globalSet) { |
| 109 | unless defined $set; |
436 | $set = fake_set($db); |
|
|
437 | } else { |
| 110 | $set = global2user($userSetClass, $globalSet); |
438 | $set = global2user($userSetClass, $globalSet); |
| 111 | $set->psvn(0); |
439 | $set->psvn(0); |
|
|
440 | } |
| 112 | } |
441 | } |
| 113 | |
442 | |
| 114 | # if that is not yet defined obtain the global problem, |
443 | # if that is not yet defined obtain the global problem, |
| 115 | # convert it to a user problem, and add fake user data |
444 | # convert it to a user problem, and add fake user data |
| 116 | unless (defined $problem) { |
445 | unless (defined $problem) { |
| 117 | my $userProblemClass = $db->{problem_user}->{record}; |
446 | my $userProblemClass = $db->{problem_user}->{record}; |
| 118 | my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked |
447 | my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked |
| 119 | # if the global problem doesn't exist either, bail! |
448 | # if the global problem doesn't exist either, bail! |
|
|
449 | if(not defined $globalProblem) { |
|
|
450 | my $sourceFilePath = $r->param("sourceFilePath"); |
|
|
451 | die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir |
|
|
452 | # These are problems from setmaker. If declared invalid, they won't come up |
|
|
453 | $self->{invalidProblem} = $self->{invalidSet} = 1 unless defined $sourceFilePath; |
| 120 | die "Problem $problemNumber in set $setName does not exist" |
454 | # die "Problem $problemNumber in set $setName does not exist" unless defined $sourceFilePath; |
| 121 | unless defined $problem; |
455 | $problem = fake_problem($db); |
|
|
456 | $problem->problem_id(1); |
|
|
457 | $problem->source_file($sourceFilePath); |
|
|
458 | $problem->user_id($effectiveUserName); |
|
|
459 | } else { |
| 122 | $problem = global2user($userProblemClass, $globalProblem); |
460 | $problem = global2user($userProblemClass, $globalProblem); |
| 123 | $problem->user_id($effectiveUserName); |
461 | $problem->user_id($effectiveUserName); |
| 124 | $problem->problem_seed(0); |
462 | $problem->problem_seed(0); |
| 125 | $problem->status(0); |
463 | $problem->status(0); |
| 126 | $problem->attempted(0); |
464 | $problem->attempted(0); |
| 127 | $problem->last_answer(""); |
465 | $problem->last_answer(""); |
| 128 | $problem->num_correct(0); |
466 | $problem->num_correct(0); |
| 129 | $problem->num_incorrect(0); |
467 | $problem->num_incorrect(0); |
|
|
468 | } |
| 130 | } |
469 | } |
| 131 | |
470 | |
| 132 | # now we're sure we have valid UserSet and UserProblem objects |
471 | # now we're sure we have valid UserSet and UserProblem objects |
| 133 | # yay! |
472 | # yay! |
| 134 | |
473 | |
| 135 | # now deal with possible editor overrides: |
474 | # now deal with possible editor overrides: |
| 136 | |
475 | |
| 137 | # if the caller is asking to override the source file, and |
476 | # if the caller is asking to override the source file, and |
| 138 | # editMode calls for a temporary file, do so |
477 | # editMode calls for a temporary file, do so |
| 139 | my $sourceFilePath = $r->param("sourceFilePath"); |
478 | my $sourceFilePath = $r->param("sourceFilePath"); |
| 140 | if (defined $sourceFilePath and $editMode eq "temporaryFile") { |
479 | if (defined $editMode and $editMode eq "temporaryFile" and defined $sourceFilePath) { |
|
|
480 | die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir |
| 141 | $problem->source_file($sourceFilePath); |
481 | $problem->source_file($sourceFilePath); |
| 142 | } |
482 | } |
|
|
483 | |
|
|
484 | # if the problem does not have a source file or no source file has been passed in |
|
|
485 | # then this is really an invalid problem (probably from a bad URL) |
|
|
486 | $self->{invalidProblem} = not (defined $sourceFilePath or $problem->source_file); |
| 143 | |
487 | |
| 144 | # if the caller is asking to override the problem seed, do so |
488 | # if the caller is asking to override the problem seed, do so |
| 145 | my $problemSeed = $r->param("problemSeed"); |
489 | my $problemSeed = $r->param("problemSeed"); |
| 146 | if (defined $problemSeed) { |
490 | if (defined $problemSeed) { |
| 147 | $problem->problem_seed($problemSeed); |
491 | $problem->problem_seed($problemSeed); |
| 148 | } |
492 | } |
| 149 | } else { |
493 | |
| 150 | # students can't view problems not assigned to them |
494 | my $publishedClass = ($set->published) ? "Published" : "Unpublished"; |
| 151 | die "Set $setName is not assigned to $effectiveUserName" |
495 | my $publishedText = ($set->published) ? "visible to students." : "hidden from students."; |
| 152 | unless defined $set; |
496 | $self->addmessage(CGI::p("This set is " . CGI::font({class=>$publishedClass}, $publishedText))); |
| 153 | die "Problem $problemNumber in set $setName is not assigned to $effectiveUserName" |
497 | |
| 154 | unless defined $problem; |
498 | # test for additional problem validity if it's not already invalid |
|
|
499 | } else { |
|
|
500 | $self->{invalidProblem} = !(defined $problem and ($set->published || $authz->hasPermissions($userName, "view_unpublished_sets"))); |
|
|
501 | |
|
|
502 | $self->addbadmessage(CGI::p("This problem will not count towards your grade.")) if $problem and not $problem->value and not $self->{invalidProblem}; |
| 155 | } |
503 | } |
| 156 | |
504 | |
| 157 | $self->{userName} = $userName; |
505 | $self->{userName} = $userName; |
| 158 | $self->{effectiveUserName} = $effectiveUserName; |
506 | $self->{effectiveUserName} = $effectiveUserName; |
| 159 | $self->{user} = $user; |
507 | $self->{user} = $user; |
| 160 | $self->{effectiveUser} = $effectiveUser; |
508 | $self->{effectiveUser} = $effectiveUser; |
| 161 | $self->{permissionLevel} = $permissionLevel; |
|
|
| 162 | $self->{set} = $set; |
509 | $self->{set} = $set; |
| 163 | $self->{problem} = $problem; |
510 | $self->{problem} = $problem; |
| 164 | $self->{editMode} = $editMode; |
511 | $self->{editMode} = $editMode; |
| 165 | |
512 | |
| 166 | ##### form processing ##### |
513 | ##### form processing ##### |
| 167 | |
514 | |
| 168 | # set options from form fields (see comment at top of file for names) |
515 | # set options from form fields (see comment at top of file for names) |
| 169 | my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; |
516 | my $displayMode = $r->param("displayMode") || $ce->{pg}->{options}->{displayMode}; |
| 170 | my $redisplay = $r->param("redisplay"); |
517 | my $redisplay = $r->param("redisplay"); |
| 171 | my $submitAnswers = $r->param("submitAnswers"); |
518 | my $submitAnswers = $r->param("submitAnswers"); |
| 172 | my $checkAnswers = $r->param("checkAnswers"); |
519 | my $checkAnswers = $r->param("checkAnswers"); |
| 173 | my $previewAnswers = $r->param("previewAnswers"); |
520 | my $previewAnswers = $r->param("previewAnswers"); |
| 174 | |
521 | |
| 175 | |
|
|
| 176 | my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; |
522 | my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; |
| 177 | |
|
|
| 178 | |
523 | |
| 179 | $self->{displayMode} = $displayMode; |
524 | $self->{displayMode} = $displayMode; |
| 180 | $self->{redisplay} = $redisplay; |
525 | $self->{redisplay} = $redisplay; |
| 181 | $self->{submitAnswers} = $submitAnswers; |
526 | $self->{submitAnswers} = $submitAnswers; |
| 182 | $self->{checkAnswers} = $checkAnswers; |
527 | $self->{checkAnswers} = $checkAnswers; |
| 183 | $self->{previewAnswers} = $previewAnswers; |
528 | $self->{previewAnswers} = $previewAnswers; |
| 184 | $self->{formFields} = $formFields; |
529 | $self->{formFields} = $formFields; |
|
|
530 | |
|
|
531 | # get result and send to message |
|
|
532 | my $status_message = $r->param("status_message"); |
|
|
533 | $self->addmessage(CGI::p("$status_message")) if $status_message; |
|
|
534 | |
|
|
535 | # now that we've set all the necessary variables quit out if the set or problem is invalid |
|
|
536 | return if $self->{invalidSet} || $self->{invalidProblem}; |
| 185 | |
537 | |
| 186 | ##### permissions ##### |
538 | ##### permissions ##### |
| 187 | |
539 | |
| 188 | # are we allowed to view this problem? |
|
|
| 189 | $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0; |
|
|
| 190 | return unless $self->{isOpen}; |
|
|
| 191 | |
|
|
| 192 | # what does the user want to do? |
540 | # what does the user want to do? |
|
|
541 | #FIXME There is a problem with checkboxes -- if they are not checked they are invisible. Hence if the default mode in $ce is 1 |
|
|
542 | # there is no way to override this. Probably this is ok for the last three options, but it was definitely not ok for showing |
|
|
543 | # saved answers which is normally on, but you want to be able to turn it off! This section should be moved to ContentGenerator |
|
|
544 | # so that you can set these options anywhere. We also need mechanisms for making them sticky. |
|
|
545 | # Note: ProblemSet and ProblemSets might set showOldAnswers to '', which |
|
|
546 | # needs to be treated as if it is not set. |
| 193 | my %want = ( |
547 | my %want = ( |
| 194 | showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, |
548 | showOldAnswers => (defined($r->param("showOldAnswers")) and $r->param("showOldAnswers") ne '') ? $r->param("showOldAnswers") : $ce->{pg}->{options}->{showOldAnswers}, |
| 195 | showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, |
549 | showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers}, |
| 196 | showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, |
550 | showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints}, |
| 197 | showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, |
551 | showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions}, |
| 198 | recordAnswers => $submitAnswers, |
552 | recordAnswers => $submitAnswers, |
| 199 | checkAnswers => $checkAnswers, |
553 | checkAnswers => $checkAnswers, |
|
|
554 | getSubmitButton => 1, |
| 200 | ); |
555 | ); |
| 201 | |
556 | |
| 202 | # are certain options enforced? |
557 | # are certain options enforced? |
| 203 | my %must = ( |
558 | my %must = ( |
| 204 | showOldAnswers => 0, |
559 | showOldAnswers => 0, |
| 205 | showCorrectAnswers => 0, |
560 | showCorrectAnswers => 0, |
| 206 | showHints => 0, |
561 | showHints => 0, |
| 207 | showSolutions => 0, |
562 | showSolutions => 0, |
| 208 | recordAnswers => mustRecordAnswers($permissionLevel), |
563 | recordAnswers => ! $authz->hasPermissions($userName, "avoid_recording_answers"), |
| 209 | checkAnswers => 0, |
564 | checkAnswers => 0, |
|
|
565 | getSubmitButton => 0, |
| 210 | ); |
566 | ); |
| 211 | |
567 | |
| 212 | # does the user have permission to use certain options? |
568 | # does the user have permission to use certain options? |
|
|
569 | my @args = ($user, $effectiveUser, $set, $problem); |
| 213 | my %can = ( |
570 | my %can = ( |
| 214 | showOldAnswers => 1, |
571 | showOldAnswers => $self->can_showOldAnswers(@args), |
| 215 | showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date), |
572 | showCorrectAnswers => $self->can_showCorrectAnswers(@args), |
| 216 | showHints => 1, |
573 | showHints => $self->can_showHints(@args), |
| 217 | showSolutions => canShowSolutions($permissionLevel, $set->answer_date), |
574 | showSolutions => $self->can_showSolutions(@args), |
| 218 | recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, |
575 | recordAnswers => $self->can_recordAnswers(@args, 0), |
| 219 | $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), |
576 | checkAnswers => $self->can_checkAnswers(@args, $submitAnswers), |
| 220 | # attempts=num_correct+num_incorrect+1, as this happens before updating $problem |
577 | getSubmitButton => $self->can_recordAnswers(@args, $submitAnswers), |
| 221 | checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date), |
|
|
| 222 | ); |
578 | ); |
| 223 | ######################################################### |
|
|
| 224 | # more complicated logic for showing check answer button: |
|
|
| 225 | ######################################################### |
|
|
| 226 | # checkAnswers button shows up after due date -- once a student can't record anymore |
|
|
| 227 | # checkAnswers button always shows up when an instructor or TA is acting |
|
|
| 228 | # as someone else (the $user and $effectiveUserName aren't the same). |
|
|
| 229 | $can{checkAnswers} = ($can{checkAnswers} && not $can{recordAnswers} ) || |
|
|
| 230 | ( defined($userName) and defined($effectiveUserName) and |
|
|
| 231 | ($userName ne $effectiveUserName) |
|
|
| 232 | ); |
|
|
| 233 | ######################################################### |
|
|
| 234 | # more complicated logif for showing "submit answer" button |
|
|
| 235 | ######################################################### |
|
|
| 236 | # We hide the submit answer button if someone is acting as a student |
|
|
| 237 | # This prevents errors where you accidently submit the answer for a student |
|
|
| 238 | # Not sure whether this a feature or a bug |
|
|
| 239 | |
579 | |
| 240 | $can{recordAnswers} = ($can{recordAnswers} and not |
|
|
| 241 | ( defined($userName) and defined($effectiveUserName) and |
|
|
| 242 | ($userName ne $effectiveUserName) |
|
|
| 243 | ) |
|
|
| 244 | ); |
|
|
| 245 | # final values for options |
580 | # final values for options |
| 246 | my %will; |
581 | my %will; |
| 247 | foreach (keys %must) { |
582 | foreach (keys %must) { |
| 248 | $will{$_} = $can{$_} && ($want{$_} || $must{$_}); |
583 | $will{$_} = $can{$_} && ($want{$_} || $must{$_}); |
| 249 | } |
584 | } |
| … | |
… | |
| 256 | $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; |
591 | $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers; |
| 257 | } |
592 | } |
| 258 | |
593 | |
| 259 | ##### translation ##### |
594 | ##### translation ##### |
| 260 | |
595 | |
| 261 | $WeBWorK::timer->continue("begin pg processing") if defined($WeBWorK::timer); |
596 | debug("begin pg processing"); |
| 262 | my $pg = WeBWorK::PG->new( |
597 | my $pg = WeBWorK::PG->new( |
| 263 | $courseEnv, |
598 | $ce, |
| 264 | $effectiveUser, |
599 | $effectiveUser, |
| 265 | $key, |
600 | $key, |
| 266 | $set, |
601 | $set, |
| 267 | $problem, |
602 | $problem, |
| 268 | $set->psvn, # FIXME: this field should be removed |
603 | $set->psvn, # FIXME: this field should be removed |
| … | |
… | |
| 274 | refreshMath2img => $will{showHints} || $will{showSolutions}, |
609 | refreshMath2img => $will{showHints} || $will{showSolutions}, |
| 275 | processAnswers => 1, |
610 | processAnswers => 1, |
| 276 | }, |
611 | }, |
| 277 | ); |
612 | ); |
| 278 | |
613 | |
| 279 | $WeBWorK::timer->continue("end pg processing") if defined($WeBWorK::timer); |
614 | debug("end pg processing"); |
|
|
615 | |
| 280 | ##### fix hint/solution options ##### |
616 | ##### fix hint/solution options ##### |
| 281 | |
617 | |
| 282 | $can{showHints} &&= $pg->{flags}->{hintExists} |
618 | $can{showHints} &&= $pg->{flags}->{hintExists} |
| 283 | &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; |
619 | &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; |
| 284 | $can{showSolutions} &&= $pg->{flags}->{solutionExists}; |
620 | $can{showSolutions} &&= $pg->{flags}->{solutionExists}; |
| … | |
… | |
| 290 | $self->{can} = \%can; |
626 | $self->{can} = \%can; |
| 291 | $self->{will} = \%will; |
627 | $self->{will} = \%will; |
| 292 | $self->{pg} = $pg; |
628 | $self->{pg} = $pg; |
| 293 | } |
629 | } |
| 294 | |
630 | |
| 295 | #sub if_warnings($$) { |
|
|
| 296 | # my ($self, $arg) = @_; |
|
|
| 297 | # return 0 unless $self->{isOpen}; |
|
|
| 298 | # return $self->{pg}->{warnings} ne ""; |
|
|
| 299 | #} |
|
|
| 300 | |
|
|
| 301 | sub if_errors($$) { |
631 | sub if_errors($$) { |
| 302 | my ($self, $arg) = @_; |
632 | my ($self, $arg) = @_; |
| 303 | return 0 unless $self->{isOpen}; |
633 | |
|
|
634 | if ($self->{isOpen}) { |
| 304 | return $self->{pg}->{flags}->{error_flag}; |
635 | return $self->{pg}->{flags}->{error_flag} ? $arg : !$arg; |
|
|
636 | } else { |
|
|
637 | return !$arg; |
|
|
638 | } |
| 305 | } |
639 | } |
| 306 | |
640 | |
| 307 | sub head { |
641 | sub head { |
| 308 | my $self = shift; |
642 | my ($self) = @_; |
| 309 | return "" unless $self->{isOpen}; |
643 | |
|
|
644 | return "" if ( $self->{invalidSet} ); |
| 310 | return $self->{pg}->{head_text} if $self->{pg}->{head_text}; |
645 | return $self->{pg}->{head_text} if $self->{pg}->{head_text}; |
| 311 | } |
646 | } |
| 312 | |
647 | |
| 313 | sub options { |
648 | sub options { |
| 314 | my $self = shift; |
649 | my ($self) = @_; |
| 315 | return join("", |
650 | #warn "doing options in Problem"; |
| 316 | CGI::start_form("POST", $self->{r}->uri), |
651 | |
| 317 | $self->hidden_authen_fields, |
652 | # don't show options if we don't have anything to show |
| 318 | CGI::hr(), |
653 | return "" if $self->{invalidSet} or $self->{invalidProblem}; |
| 319 | CGI::start_div({class=>"viewOptions"}), |
654 | |
| 320 | $self->viewOptions(), |
655 | my $displayMode = $self->{displayMode}; |
| 321 | CGI::end_div(), |
656 | my %can = %{ $self->{can} }; |
| 322 | CGI::end_form() |
657 | |
|
|
658 | my @options_to_show = "displayMode"; |
|
|
659 | push @options_to_show, "showOldAnswers" if $can{showOldAnswers}; |
|
|
660 | push @options_to_show, "showHints" if $can{showHints}; |
|
|
661 | push @options_to_show, "showSolutions" if $can{showSolutions}; |
|
|
662 | |
|
|
663 | return $self->optionsMacro( |
|
|
664 | options_to_show => \@options_to_show, |
|
|
665 | extra_params => ["editMode", "sourceFilePath"], |
| 323 | ); |
666 | ); |
| 324 | } |
667 | } |
| 325 | |
668 | |
| 326 | sub path { |
|
|
| 327 | my $self = shift; |
|
|
| 328 | my $args = $_[-1]; |
|
|
| 329 | my $setName = $self->{set}->set_id; |
|
|
| 330 | my $problemNumber = $self->{problem}->problem_id; |
|
|
| 331 | |
|
|
| 332 | my $ce = $self->{ce}; |
|
|
| 333 | my $root = $ce->{webworkURLs}->{root}; |
|
|
| 334 | my $courseName = $ce->{courseName}; |
|
|
| 335 | return $self->pathMacro($args, |
|
|
| 336 | "Home" => "$root", |
|
|
| 337 | $courseName => "$root/$courseName", |
|
|
| 338 | $setName => "$root/$courseName/$setName", |
|
|
| 339 | "Problem $problemNumber" => "", |
|
|
| 340 | ); |
|
|
| 341 | } |
|
|
| 342 | |
|
|
| 343 | sub siblings { |
669 | sub siblings { |
| 344 | my $self = shift; |
670 | my ($self) = @_; |
|
|
671 | my $r = $self->r; |
|
|
672 | my $db = $r->db; |
|
|
673 | my $urlpath = $r->urlpath; |
|
|
674 | |
|
|
675 | # can't show sibling problems if the set is invalid |
|
|
676 | return "" if $self->{invalidSet}; |
|
|
677 | |
|
|
678 | my $courseID = $urlpath->arg("courseID"); |
| 345 | my $setName = $self->{set}->set_id; |
679 | my $setID = $self->{set}->set_id; |
| 346 | my $problemNumber = $self->{problem}->problem_id; |
|
|
| 347 | |
|
|
| 348 | my $ce = $self->{ce}; |
|
|
| 349 | my $db = $self->{db}; |
|
|
| 350 | my $root = $ce->{webworkURLs}->{root}; |
|
|
| 351 | my $courseName = $ce->{courseName}; |
|
|
| 352 | print CGI::strong("Problems"), CGI::br(); |
|
|
| 353 | |
|
|
| 354 | my $effectiveUser = $self->{r}->param("effectiveUser"); |
680 | my $eUserID = $r->param("effectiveUser"); |
| 355 | my @problemIDs = $db->listUserProblems($effectiveUser, $setName); |
681 | my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID); |
|
|
682 | |
|
|
683 | print CGI::start_div({class=>"info-box", id=>"fisheye"}); |
|
|
684 | print CGI::h2("Problems"); |
|
|
685 | #print CGI::start_ul({class=>"LinksMenu"}); |
|
|
686 | #print CGI::start_li(); |
|
|
687 | #print CGI::span({style=>"font-size:larger"}, "Problems"); |
|
|
688 | print CGI::start_ul(); |
|
|
689 | |
| 356 | foreach my $problem (sort { $a <=> $b } @problemIDs) { |
690 | foreach my $problemID (@problemIDs) { |
| 357 | print ' '.CGI::a({-href=>"$root/$courseName/$setName/".$problem."/?" |
691 | my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", |
| 358 | . $self->url_authen_args . "&displayMode=" . $self->{displayMode}}, |
692 | courseID => $courseID, setID => $setID, problemID => $problemID); |
| 359 | "Problem ".$problem), CGI::br(); |
693 | print CGI::li(CGI::a( {href=>$self->systemLink($problemPage, |
|
|
694 | params=>{ displayMode => $self->{displayMode}, |
|
|
695 | showOldAnswers => $self->{will}->{showOldAnswers} |
|
|
696 | })}, "Problem $problemID") |
|
|
697 | ); |
| 360 | } |
698 | } |
| 361 | |
699 | |
|
|
700 | print CGI::end_ul(); |
|
|
701 | #print CGI::end_li(); |
|
|
702 | #print CGI::end_ul(); |
|
|
703 | print CGI::end_div(); |
|
|
704 | |
| 362 | return ""; |
705 | return ""; |
| 363 | } |
706 | } |
| 364 | |
707 | |
| 365 | sub nav { |
708 | sub nav { |
| 366 | $WeBWorK::timer->continue("begin nav subroutine") if defined($WeBWorK::timer); |
709 | my ($self, $args) = @_; |
| 367 | my $self = shift; |
|
|
| 368 | my $args = $_[-1]; |
|
|
| 369 | my $setName = $self->{set}->set_id; |
|
|
| 370 | my $problemNumber = $self->{problem}->problem_id; |
|
|
| 371 | |
|
|
| 372 | my $ce = $self->{ce}; |
710 | my $r = $self->r; |
| 373 | my $db = $self->{db}; |
711 | my $db = $r->db; |
| 374 | my $root = $ce->{webworkURLs}->{root}; |
712 | my $urlpath = $r->urlpath; |
| 375 | my $courseName = $ce->{courseName}; |
|
|
| 376 | |
713 | |
| 377 | my $wwdb = $self->{wwdb}; |
714 | return "" if ( $self->{invalidSet} ); |
|
|
715 | |
|
|
716 | my $courseID = $urlpath->arg("courseID"); |
|
|
717 | my $setID = $self->{set}->set_id if !($self->{invalidSet}); |
|
|
718 | my $problemID = $self->{problem}->problem_id if !($self->{invalidProblem}); |
| 378 | my $effectiveUser = $self->{r}->param("effectiveUser"); |
719 | my $eUserID = $r->param("effectiveUser"); |
| 379 | my $tail = "&displayMode=".$self->{displayMode}; |
|
|
| 380 | |
720 | |
| 381 | my @links = ("Problem List" , "$root/$courseName/$setName", "navProbList"); |
|
|
| 382 | |
|
|
| 383 | my @problemIDs = $db->listUserProblems($effectiveUser, $setName); |
|
|
| 384 | my ($prevID, $nextID); |
721 | my ($prevID, $nextID); |
|
|
722 | |
|
|
723 | if (!$self->{invalidProblem}) { |
|
|
724 | my @problemIDs = $db->listUserProblems($eUserID, $setID); |
| 385 | foreach my $id (@problemIDs) { |
725 | foreach my $id (@problemIDs) { |
| 386 | $prevID = $id if $id < $problemNumber |
726 | $prevID = $id if $id < $problemID |
| 387 | and (not defined $prevID or $id > $prevID); |
727 | and (not defined $prevID or $id > $prevID); |
| 388 | $nextID = $id if $id > $problemNumber |
728 | $nextID = $id if $id > $problemID |
| 389 | and (not defined $nextID or $id < $nextID); |
729 | and (not defined $nextID or $id < $nextID); |
| 390 | } |
730 | } |
|
|
731 | } |
|
|
732 | |
|
|
733 | my @links; |
|
|
734 | |
|
|
735 | if ($prevID) { |
|
|
736 | my $prevPage = $urlpath->newFromModule(__PACKAGE__, |
|
|
737 | courseID => $courseID, setID => $setID, problemID => $prevID); |
|
|
738 | push @links, "Previous Problem", $r->location . $prevPage->path, "navPrev"; |
|
|
739 | } else { |
| 391 | unshift @links, "Previous Problem" , ($prevID |
740 | push @links, "Previous Problem", "", "navPrev"; |
| 392 | ? "$root/$courseName/$setName/".$prevID |
741 | } |
| 393 | : "") , "navPrev"; |
742 | |
|
|
743 | push @links, "Problem List", $r->location . $urlpath->parent->path, "navProbList"; |
|
|
744 | |
|
|
745 | if ($nextID) { |
|
|
746 | my $nextPage = $urlpath->newFromModule(__PACKAGE__, |
|
|
747 | courseID => $courseID, setID => $setID, problemID => $nextID); |
|
|
748 | push @links, "Next Problem", $r->location . $nextPage->path, "navNext"; |
|
|
749 | } else { |
| 394 | push @links, "Next Problem" , ($nextID |
750 | push @links, "Next Problem", "", "navNext"; |
| 395 | ? "$root/$courseName/$setName/".$nextID |
751 | } |
| 396 | : "") , "navNext"; |
|
|
| 397 | |
752 | |
|
|
753 | my $tail = ""; |
|
|
754 | |
|
|
755 | $tail .= "&displayMode=".$self->{displayMode} if defined $self->{displayMode}; |
|
|
756 | $tail .= "&showOldAnswers=".$self->{will}->{showOldAnswers} |
|
|
757 | if defined $self->{will}->{showOldAnswers}; |
| 398 | my $result = $self->navMacro($args, $tail, @links); |
758 | return $self->navMacro($args, $tail, @links); |
| 399 | $WeBWorK::timer->continue("end nav subroutine") if defined($WeBWorK::timer); |
|
|
| 400 | return $result; |
|
|
| 401 | } |
759 | } |
| 402 | |
760 | |
| 403 | sub title { |
761 | sub title { |
| 404 | my $self = shift; |
762 | my ($self) = @_; |
| 405 | my $setName = $self->{set}->set_id; |
763 | |
| 406 | my $problemNumber = $self->{problem}->problem_id; |
764 | # using the url arguments won't break if the set/problem are invalid |
|
|
765 | my $setID = WeBWorK::ContentGenerator::underscore2nbsp($self->r->urlpath->arg("setID")); |
|
|
766 | my $problemID = $self->r->urlpath->arg("problemID"); |
| 407 | |
767 | |
| 408 | return "$setName : Problem $problemNumber"; |
768 | return "$setID: Problem $problemID"; |
| 409 | } |
769 | } |
| 410 | |
770 | |
| 411 | sub body { |
771 | sub body { |
| 412 | my $self = shift; |
772 | my $self = shift; |
|
|
773 | my $r = $self->r; |
|
|
774 | my $ce = $r->ce; |
|
|
775 | my $db = $r->db; |
|
|
776 | my $authz = $r->authz; |
|
|
777 | my $urlpath = $r->urlpath; |
|
|
778 | my $user = $r->param('user'); |
|
|
779 | my $effectiveUser = $r->param('effectiveUser'); |
|
|
780 | |
|
|
781 | if ( $self->{invalidSet} ) { |
|
|
782 | return CGI::div({class=>"ResultsWithError"}, |
|
|
783 | CGI::p("The selected problem set (" . |
|
|
784 | $urlpath->arg("setID") . ") is not " . |
|
|
785 | "a valid set for $effectiveUser:"), |
|
|
786 | CGI::p($self->{invalidSet})); |
|
|
787 | } |
| 413 | |
788 | |
| 414 | return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open.")) |
789 | if ($self->{invalidProblem}) { |
| 415 | unless $self->{isOpen}; |
790 | return CGI::div({class=>"ResultsWithError"}, |
| 416 | |
791 | CGI::p("The selected problem (" . $urlpath->arg("problemID") . ") is not a valid problem for set " . $self->{set}->set_id . ".")); |
|
|
792 | } |
|
|
793 | |
| 417 | # unpack some useful variables |
794 | # unpack some useful variables |
| 418 | my $r = $self->{r}; |
|
|
| 419 | my $db = $self->{db}; |
|
|
| 420 | my $ce = $self->{ce}; |
|
|
| 421 | my $root = $ce->{webworkURLs}->{root}; |
|
|
| 422 | my $courseName = $ce->{courseName}; |
|
|
| 423 | my $set = $self->{set}; |
795 | my $set = $self->{set}; |
| 424 | my $problem = $self->{problem}; |
796 | my $problem = $self->{problem}; |
| 425 | my $editMode = $self->{editMode}; |
797 | my $editMode = $self->{editMode}; |
| 426 | my $permissionLevel = $self->{permissionLevel}; |
|
|
| 427 | my $submitAnswers = $self->{submitAnswers}; |
798 | my $submitAnswers = $self->{submitAnswers}; |
| 428 | my $checkAnswers = $self->{checkAnswers}; |
799 | my $checkAnswers = $self->{checkAnswers}; |
| 429 | my $previewAnswers = $self->{previewAnswers}; |
800 | my $previewAnswers = $self->{previewAnswers}; |
| 430 | my %want = %{ $self->{want} }; |
801 | my %want = %{ $self->{want} }; |
| 431 | my %can = %{ $self->{can} }; |
802 | my %can = %{ $self->{can} }; |
| 432 | my %must = %{ $self->{must} }; |
803 | my %must = %{ $self->{must} }; |
| 433 | my %will = %{ $self->{will} }; |
804 | my %will = %{ $self->{will} }; |
| 434 | my $pg = $self->{pg}; |
805 | my $pg = $self->{pg}; |
| 435 | |
806 | |
|
|
807 | my $courseName = $urlpath->arg("courseID"); |
| 436 | |
808 | |
| 437 | |
809 | # FIXME: move editor link to top, next to problem number. |
| 438 | #####create Editor link ##### |
810 | # format as "[edit]" like we're doing with course info file, etc. |
| 439 | # print editor link if the user is an instructor AND the file is not in temporary editing mode |
811 | # add edit link for set as well. |
| 440 | my $editorLinkMessage = ''; |
812 | my $editorLink = ""; |
| 441 | # and ( (not defined($self->{editMode})) or $self->{editMode} eq 'savedFile') # FIXME is this needed? |
813 | # if we are here without a real homework set, carry that through |
| 442 | if ($self->{permissionLevel}>=10 ) { |
814 | my $forced_field = []; |
| 443 | $editorLinkMessage = CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/". |
815 | $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if |
| 444 | $set->set_id.'/'.$problem->problem_id.'?'.$self->url_authen_args},'Edit this problem'); |
816 | ($set->set_id eq 'Undefined_Set'); |
|
|
817 | if ($authz->hasPermissions($user, "modify_problem_sets")) { |
|
|
818 | my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", |
|
|
819 | courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id); |
|
|
820 | my $editorURL = $self->systemLink($editorPage, params=>$forced_field); |
|
|
821 | $editorLink = CGI::p(CGI::a({href=>$editorURL,target =>'WW_Editor'}, "Edit this problem")); |
| 445 | } |
822 | } |
|
|
823 | |
| 446 | ##### translation errors? ##### |
824 | ##### translation errors? ##### |
| 447 | |
825 | |
| 448 | if ($pg->{flags}->{error_flag}) { |
826 | if ($pg->{flags}->{error_flag}) { |
|
|
827 | if ($authz->hasPermissions($user, "view_problem_debugging_info")) { |
| 449 | return $self->errorOutput($pg->{errors}, $pg->{body_text}.CGI::p($editorLinkMessage)); |
828 | print $self->errorOutput($pg->{errors}, $pg->{body_text}); |
|
|
829 | } else { |
|
|
830 | print $self->errorOutput($pg->{errors}, "You do not have permission to view the details of this error."); |
|
|
831 | } |
|
|
832 | print $editorLink; |
|
|
833 | return ""; |
| 450 | } |
834 | } |
| 451 | |
835 | |
| 452 | ##### answer processing ##### |
836 | ##### answer processing ##### |
| 453 | $WeBWorK::timer->continue("begin answer processing") if defined($WeBWorK::timer); |
837 | debug("begin answer processing"); |
| 454 | # if answers were submitted: |
838 | # if answers were submitted: |
| 455 | my $scoreRecordedMessage; |
839 | my $scoreRecordedMessage; |
|
|
840 | my $pureProblem; |
| 456 | if ($submitAnswers) { |
841 | if ($submitAnswers) { |
| 457 | # get a "pure" (unmerged) UserProblem to modify |
842 | # get a "pure" (unmerged) UserProblem to modify |
| 458 | # this will be undefined if the problem has not been assigned to this user |
843 | # this will be undefined if the problem has not been assigned to this user |
| 459 | my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); # checked |
844 | $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); # checked |
| 460 | if (defined $pureProblem) { |
845 | if (defined $pureProblem) { |
| 461 | # store answers in DB for sticky answers |
846 | # store answers in DB for sticky answers |
| 462 | my %answersToStore; |
847 | my %answersToStore; |
| 463 | my %answerHash = %{ $pg->{answers} }; |
848 | my %answerHash = %{ $pg->{answers} }; |
| 464 | $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!! |
849 | $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!! |
| 465 | foreach (keys %answerHash); |
850 | foreach (keys %answerHash); |
|
|
851 | |
| 466 | # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating |
852 | # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating |
| 467 | # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs |
853 | # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs |
| 468 | # however we need to store them. Fortunately they are still in the input form. |
854 | # however we need to store them. Fortunately they are still in the input form. |
| 469 | my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}}; |
855 | my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}}; |
| 470 | |
|
|
| 471 | $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names); |
856 | $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names); |
| 472 | |
857 | |
| 473 | # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order |
858 | # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order |
| 474 | my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names); |
859 | my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names); |
| 475 | my $answerString = encodeAnswers(%answersToStore, |
860 | my $answerString = encodeAnswers(%answersToStore, |
| … | |
… | |
| 509 | $pureProblem->last_answer."\t". |
894 | $pureProblem->last_answer."\t". |
| 510 | $pureProblem->num_correct."\t". |
895 | $pureProblem->num_correct."\t". |
| 511 | $pureProblem->num_incorrect |
896 | $pureProblem->num_incorrect |
| 512 | ); |
897 | ); |
| 513 | } else { |
898 | } else { |
| 514 | if (time < $set->open_date or time > $set->due_date) { |
899 | if (before($set->open_date) or after($set->due_date)) { |
| 515 | $scoreRecordedMessage = "Your score was not recorded because this problem set is closed."; |
900 | $scoreRecordedMessage = "Your score was not recorded because this homework set is closed."; |
| 516 | } else { |
901 | } else { |
| 517 | $scoreRecordedMessage = "Your score was not recorded."; |
902 | $scoreRecordedMessage = "Your score was not recorded."; |
| 518 | } |
903 | } |
| 519 | } |
904 | } |
| 520 | } else { |
905 | } else { |
| 521 | $scoreRecordedMessage = "Your score was not recorded because this problem has not been built for you."; |
906 | $scoreRecordedMessage = "Your score was not recorded because this problem has not been assigned to you."; |
| 522 | } |
907 | } |
| 523 | } |
908 | } |
| 524 | |
909 | |
| 525 | # logging student answers |
910 | # logging student answers |
| 526 | |
911 | |
| 527 | my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; |
912 | my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; |
| 528 | if ( defined($answer_log )) { |
913 | if ( defined($answer_log ) and defined($pureProblem)) { |
| 529 | if ($submitAnswers ) { |
914 | if ($submitAnswers && !$authz->hasPermissions($effectiveUser, "dont_log_past_answers")) { |
| 530 | my $answerString = ""; |
915 | my $answerString = ""; my $scores = ""; |
| 531 | my %answerHash = %{ $pg->{answers} }; |
916 | my %answerHash = %{ $pg->{answers} }; |
| 532 | # FIXME this is the line 552 error. make sure original student ans is defined. |
917 | # FIXME this is the line 552 error. make sure original student ans is defined. |
| 533 | # The fact that it is not defined is probably due to an error in some answer evaluator. |
918 | # The fact that it is not defined is probably due to an error in some answer evaluator. |
| 534 | # But I think it is useful to suppress this error message in the log. |
919 | # But I think it is useful to suppress this error message in the log. |
| 535 | foreach (sort keys %answerHash) { |
920 | foreach (sortByName(undef, keys %answerHash)) { |
| 536 | my $student_ans = $answerHash{$_}->{original_student_ans} ||''; |
921 | my $orig_ans = $answerHash{$_}->{original_student_ans}; |
|
|
922 | my $student_ans = defined $orig_ans ? $orig_ans : ''; |
| 537 | $answerString .= $student_ans."\t" |
923 | $answerString .= $student_ans."\t"; |
|
|
924 | $scores .= $answerHash{$_}->{score} >= 1 ? "1" : "0"; |
| 538 | } |
925 | } |
| 539 | $answerString = '' unless defined($answerString); # insure string is defined. |
926 | $answerString = '' unless defined($answerString); # insure string is defined. |
| 540 | writeCourseLog($self->{ce}, "answer_log", |
927 | writeCourseLog($self->{ce}, "answer_log", |
| 541 | join("", |
928 | join("", |
| 542 | '|', $problem->user_id, |
929 | '|', $problem->user_id, |
| 543 | '|', $problem->set_id, |
930 | '|', $problem->set_id, |
| 544 | '|', $problem->problem_id, |
931 | '|', $problem->problem_id, |
| 545 | '|',"\t", |
932 | '|', $scores, "\t", |
| 546 | time(),"\t", |
933 | time(),"\t", |
| 547 | $answerString, |
934 | $answerString, |
| 548 | ), |
935 | ), |
| 549 | ); |
936 | ); |
| 550 | |
937 | |
| 551 | } |
938 | } |
| 552 | } |
939 | } |
| 553 | |
940 | |
| 554 | $WeBWorK::timer->continue("end answer processing") if defined($WeBWorK::timer); |
941 | debug("end answer processing"); |
| 555 | |
942 | |
| 556 | ##### output ##### |
943 | ##### output ##### |
| 557 | |
944 | # custom message for editor |
|
|
945 | if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) { |
|
|
946 | if ($editMode eq "temporaryFile") { |
|
|
947 | print CGI::p(CGI::div({class=>'temporaryFile'}, "Viewing temporary file: ", $problem->source_file)); |
|
|
948 | } elsif ($editMode eq "savedFile") { |
|
|
949 | # taken care of in the initialization phase |
|
|
950 | } |
|
|
951 | } |
| 558 | print CGI::start_div({class=>"problemHeader"}); |
952 | print CGI::start_div({class=>"problemHeader"}); |
| 559 | |
953 | |
| 560 | # custom message for editor |
|
|
| 561 | if ($permissionLevel >= 10 and defined $editMode) { |
|
|
| 562 | if ($editMode eq "temporaryFile") { |
|
|
| 563 | print CGI::p(CGI::i("Editing temporary file: ", $problem->source_file)); |
|
|
| 564 | } elsif ($editMode eq "savedFile") { |
|
|
| 565 | print CGI::p(CGI::i("Problem saved to: ", $problem->source_file)); |
|
|
| 566 | } |
|
|
| 567 | } |
|
|
| 568 | |
954 | |
|
|
955 | |
| 569 | # attempt summary |
956 | # attempt summary |
| 570 | #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. |
957 | #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. |
| 571 | # until after the due date |
958 | # until after the due date |
| 572 | # do I need to check $wills{howCorrectAnswers} to make preflight work?? |
959 | # do I need to check $will{showCorrectAnswers} to make preflight work?? |
| 573 | if (($pg->{flags}->{showPartialCorrectAnswers}>= 0 and $submitAnswers) ) { |
960 | if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) { |
| 574 | # print this if user submitted answers OR requested correct answers |
961 | # print this if user submitted answers OR requested correct answers |
| 575 | |
962 | |
| 576 | print $self->attemptResults($pg, 1, |
963 | print $self->attemptResults($pg, 1, |
| 577 | $will{showCorrectAnswers}, |
964 | $will{showCorrectAnswers}, |
| 578 | $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); |
965 | $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); |
| 579 | } elsif ($checkAnswers) { |
966 | } elsif ($checkAnswers) { |
| 580 | # print this if user previewed answers |
967 | # print this if user previewed answers |
| 581 | print "ANSWERS ONLY CHECKED -- ",CGI::br(),"ANSWERS NOT RECORDED", CGI::br(); |
968 | print CGI::div({class=>'ResultsWithError'},"ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED"), CGI::br(); |
| 582 | print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); |
969 | print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); |
| 583 | # show attempt answers |
970 | # show attempt answers |
| 584 | # show correct answers if asked |
971 | # show correct answers if asked |
| 585 | # show attempt results (correctness) |
972 | # show attempt results (correctness) |
| 586 | # show attempt previews |
973 | # show attempt previews |
| 587 | } elsif ($previewAnswers) { |
974 | } elsif ($previewAnswers) { |
| 588 | # print this if user previewed answers |
975 | # print this if user previewed answers |
| 589 | print "PREVIEW ONLY -- NOT RECORDED",CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); |
976 | print CGI::div({class=>'ResultsWithError'},"PREVIEW ONLY -- ANSWERS NOT RECORDED"),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); |
| 590 | # show attempt answers |
977 | # show attempt answers |
| 591 | # don't show correct answers |
978 | # don't show correct answers |
| 592 | # don't show attempt results (correctness) |
979 | # don't show attempt results (correctness) |
| 593 | # show attempt previews |
980 | # show attempt previews |
| 594 | } |
981 | } |
| 595 | |
982 | |
| 596 | print CGI::end_div(); |
983 | print CGI::end_div(); |
| 597 | |
984 | |
|
|
985 | # main form |
|
|
986 | print "\n"; |
|
|
987 | print CGI::start_form(-method=>"POST", -action=> $r->uri,-name=>"problemMainForm", onSubmit=>"submitAction()"); |
|
|
988 | print $self->hidden_authen_fields; |
|
|
989 | print "\n"; |
| 598 | print CGI::start_div({class=>"problem"}); |
990 | print CGI::start_div({class=>"problem"}); |
| 599 | |
|
|
| 600 | # main form |
|
|
| 601 | print |
|
|
| 602 | CGI::startform("POST", $r->uri), |
|
|
| 603 | $self->hidden_authen_fields, |
|
|
| 604 | CGI::p($pg->{body_text}), |
991 | print CGI::p($pg->{body_text}); |
| 605 | CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})), |
992 | print CGI::p(CGI::b("Note: "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg}; |
| 606 | CGI::p( |
993 | print $editorLink; # this is empty unless it is appropriate to have an editor link. |
|
|
994 | print CGI::end_div(); |
|
|
995 | |
|
|
996 | print CGI::start_p(); |
|
|
997 | |
| 607 | ($can{showCorrectAnswers} |
998 | if ($can{showCorrectAnswers}) { |
| 608 | ? CGI::checkbox( |
999 | print CGI::checkbox( |
| 609 | -name => "showCorrectAnswers", |
1000 | -name => "showCorrectAnswers", |
| 610 | -checked => $will{showCorrectAnswers}, |
1001 | -checked => $will{showCorrectAnswers}, |
| 611 | -label => "Show correct answers", |
1002 | -label => "Show correct answers", |
| 612 | ) ." " |
|
|
| 613 | : "" ), |
|
|
| 614 | ($can{showHints} |
|
|
| 615 | ? '<div style="color:red">'. CGI::checkbox( |
|
|
| 616 | -name => "showHints", |
|
|
| 617 | -checked => $will{showHints}, |
|
|
| 618 | -label => "Show Hints", |
|
|
| 619 | ) . "</div> " |
|
|
| 620 | : " " ), |
|
|
| 621 | ($can{showSolutions} |
|
|
| 622 | ? CGI::checkbox( |
|
|
| 623 | -name => "showSolutions", |
|
|
| 624 | -checked => $will{showSolutions}, |
|
|
| 625 | -label => "Show Solutions", |
|
|
| 626 | ) . " " |
|
|
| 627 | : " " ),CGI::br(), |
|
|
| 628 | CGI::submit(-name=>"previewAnswers", |
|
|
| 629 | -label=>"Preview Answers"), |
|
|
| 630 | ($can{recordAnswers} |
|
|
| 631 | ? CGI::submit(-name=>"submitAnswers", |
|
|
| 632 | -label=>"Submit Answers") |
|
|
| 633 | : ""), |
|
|
| 634 | ( $can{checkAnswers} |
|
|
| 635 | ? CGI::submit(-name=>"checkAnswers", |
|
|
| 636 | -label=>"Check Answers") |
|
|
| 637 | : ""), |
|
|
| 638 | ); |
1003 | ); |
|
|
1004 | } |
|
|
1005 | if ($can{showHints}) { |
|
|
1006 | print CGI::div({style=>"color:red"}, |
|
|
1007 | CGI::checkbox( |
|
|
1008 | -name => "showHints", |
|
|
1009 | -checked => $will{showHints}, |
|
|
1010 | -label => "Show Hints", |
|
|
1011 | ) |
|
|
1012 | ); |
|
|
1013 | } |
|
|
1014 | if ($can{showSolutions}) { |
|
|
1015 | print CGI::checkbox( |
|
|
1016 | -name => "showSolutions", |
|
|
1017 | -checked => $will{showSolutions}, |
|
|
1018 | -label => "Show Solutions", |
|
|
1019 | ); |
|
|
1020 | } |
|
|
1021 | |
|
|
1022 | if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) { |
|
|
1023 | print CGI::br(); |
|
|
1024 | } |
|
|
1025 | |
|
|
1026 | print CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers"); |
|
|
1027 | if ($can{checkAnswers}) { |
|
|
1028 | print CGI::submit(-name=>"checkAnswers", -label=>"Check Answers"); |
|
|
1029 | } |
|
|
1030 | if ($can{getSubmitButton}) { |
|
|
1031 | if ($user ne $effectiveUser) { |
|
|
1032 | # if acting as a student, make it clear that answer submissions will |
|
|
1033 | # apply to the student's records, not the professor's. |
|
|
1034 | print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers for $effectiveUser"); |
|
|
1035 | } else { |
|
|
1036 | print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers"); |
|
|
1037 | } |
|
|
1038 | } |
|
|
1039 | |
| 639 | print CGI::end_div(); |
1040 | print CGI::end_p(); |
| 640 | |
1041 | |
| 641 | print CGI::start_div({class=>"scoreSummary"}); |
1042 | print CGI::start_div({class=>"scoreSummary"}); |
| 642 | |
1043 | |
| 643 | # score summary |
1044 | # score summary |
| 644 | my $attempts = $problem->num_correct + $problem->num_incorrect; |
1045 | my $attempts = $problem->num_correct + $problem->num_incorrect; |
| 645 | my $attemptsNoun = $attempts != 1 ? "times" : "time"; |
1046 | my $attemptsNoun = $attempts != 1 ? "times" : "time"; |
|
|
1047 | my $problem_status = $problem->status || 0; |
| 646 | my $lastScore = sprintf("%.0f%%", $problem->status * 100); # Round to whole number |
1048 | my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number |
| 647 | my ($attemptsLeft, $attemptsLeftNoun); |
1049 | my ($attemptsLeft, $attemptsLeftNoun); |
| 648 | if ($problem->max_attempts == -1) { |
1050 | if ($problem->max_attempts == -1) { |
| 649 | # unlimited attempts |
1051 | # unlimited attempts |
| 650 | $attemptsLeft = "unlimited"; |
1052 | $attemptsLeft = "unlimited"; |
| 651 | $attemptsLeftNoun = "attempts"; |
1053 | $attemptsLeftNoun = "attempts"; |
| … | |
… | |
| 654 | $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; |
1056 | $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; |
| 655 | } |
1057 | } |
| 656 | |
1058 | |
| 657 | my $setClosed = 0; |
1059 | my $setClosed = 0; |
| 658 | my $setClosedMessage; |
1060 | my $setClosedMessage; |
| 659 | if (time < $set->open_date or time > $set->due_date) { |
1061 | if (before($set->open_date) or after($set->due_date)) { |
| 660 | $setClosed = 1; |
1062 | $setClosed = 1; |
|
|
1063 | if (before($set->open_date)) { |
|
|
1064 | $setClosedMessage = "This homework set is not yet open."; |
|
|
1065 | } elsif (after($set->due_date)) { |
| 661 | $setClosedMessage = "This problem set is closed."; |
1066 | $setClosedMessage = "This homework set is closed."; |
| 662 | if ($permissionLevel > 0) { |
1067 | } |
|
|
1068 | } |
|
|
1069 | #if (before($set->open_date) or after($set->due_date)) { |
|
|
1070 | # $setClosed = 1; |
|
|
1071 | # $setClosedMessage = "This homework set is closed."; |
|
|
1072 | # if ($authz->hasPermissions($user, "view_answers")) { |
| 663 | $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; |
1073 | # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; |
| 664 | } else { |
1074 | # } else { |
| 665 | $setClosedMessage .= " Additional attempts will not be recorded."; |
1075 | # $setClosedMessage .= " Additional attempts will not be recorded."; |
| 666 | } |
1076 | # } |
| 667 | } |
1077 | #} |
|
|
1078 | unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) { |
|
|
1079 | my $notCountedMessage = ($problem->value) ? "" : "(This problem will not count towards your grade.)"; |
| 668 | print CGI::p( |
1080 | print CGI::p(join("", |
| 669 | $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", |
1081 | $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", |
| 670 | "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), |
1082 | "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), |
|
|
1083 | $submitAnswers ?"You received a score of ".sprintf("%.0f%%", $pg->{result}->{score} * 100)." for this attempt.".CGI::br():'', |
| 671 | $problem->attempted |
1084 | $problem->attempted |
| 672 | ? "Your recorded score is $lastScore." . CGI::br() |
1085 | ? "Your overall recorded score is $lastScore. $notCountedMessage" . CGI::br() |
| 673 | : "", |
1086 | : "", |
| 674 | $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." |
1087 | $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." |
| 675 | ); |
1088 | )); |
|
|
1089 | }else { |
|
|
1090 | print CGI::p($pg->{state}->{state_summary_msg}); |
|
|
1091 | } |
| 676 | print CGI::end_div(); |
1092 | print CGI::end_div(); |
| 677 | |
1093 | |
| 678 | # save state for viewOptions |
1094 | # save state for viewOptions |
| 679 | print CGI::hidden( |
1095 | print CGI::hidden( |
| 680 | -name => "showOldAnswers", |
1096 | -name => "showOldAnswers", |
| … | |
… | |
| 692 | ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile'; |
1108 | ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile'; |
| 693 | print( CGI::hidden( |
1109 | print( CGI::hidden( |
| 694 | -name => 'sourceFilePath', |
1110 | -name => 'sourceFilePath', |
| 695 | -value => $self->{problem}->{source_file} |
1111 | -value => $self->{problem}->{source_file} |
| 696 | )) if defined($self->{problem}->{source_file}); |
1112 | )) if defined($self->{problem}->{source_file}); |
|
|
1113 | |
|
|
1114 | print( CGI::hidden( |
|
|
1115 | -name => 'problemSeed', |
|
|
1116 | -value => $r->param("problemSeed") |
|
|
1117 | )) if defined($r->param("problemSeed")); |
| 697 | |
1118 | |
| 698 | # end of main form |
1119 | # end of main form |
| 699 | print CGI::endform(); |
1120 | print CGI::endform(); |
| 700 | |
1121 | |
| 701 | |
|
|
| 702 | print CGI::start_div({class=>"problemFooter"}); |
1122 | print CGI::start_div({class=>"problemFooter"}); |
| 703 | |
1123 | |
| 704 | # arguments for answer inspection button |
1124 | ## arguments for answer inspection button |
| 705 | my $prof_url = $ce->{webworkURLs}->{oldProf}; |
1125 | #my $prof_url = $ce->{webworkURLs}->{oldProf}; |
| 706 | my $webworkURL = $ce->{webworkURLs}->{root}; |
1126 | #my $webworkURL = $ce->{webworkURLs}->{root}; |
| 707 | my $cgi_url = $prof_url; |
1127 | #my $cgi_url = $prof_url; |
| 708 | $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl |
1128 | #$cgi_url=~ s|/[^/]*$||; # clip profLogin.pl |
| 709 | my $authen_args = $self->url_authen_args(); |
1129 | #my $authen_args = $self->url_authen_args(); |
| 710 | my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/"; |
1130 | #my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/"; |
| 711 | |
1131 | |
|
|
1132 | my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", |
|
|
1133 | courseID => $courseName); |
|
|
1134 | my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action |
|
|
1135 | |
| 712 | # print answer inspection button |
1136 | # print answer inspection button |
| 713 | if ($self->{permissionLevel} > 0) { |
1137 | if ($authz->hasPermissions($user, "view_answers")) { |
| 714 | print "\n", |
1138 | print "\n", |
| 715 | CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n", |
1139 | CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n", |
| 716 | $self->hidden_authen_fields,"\n", |
1140 | $self->hidden_authen_fields,"\n", |
| 717 | CGI::hidden(-name => 'course', -value=>$courseName), "\n", |
1141 | CGI::hidden(-name => 'courseID', -value=>$courseName), "\n", |
| 718 | CGI::hidden(-name => 'problemNumber', -value=>$problem->problem_id), "\n", |
1142 | CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n", |
| 719 | CGI::hidden(-name => 'setName', -value=>$problem->set_id), "\n", |
1143 | CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n", |
| 720 | CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", |
1144 | CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n", |
| 721 | CGI::p( {-align=>"left"}, |
1145 | CGI::p( {-align=>"left"}, |
| 722 | CGI::submit(-name => 'action', -value=>'Show Past Answers') |
1146 | CGI::submit(-name => 'action', -value=>'Show Past Answers') |
| 723 | ), "\n", |
1147 | ), "\n", |
| 724 | CGI::endform(); |
1148 | CGI::endform(); |
| 725 | } |
1149 | } |
| 726 | |
1150 | |
| 727 | #print CGI::end_div(); |
1151 | ## feedback form url |
|
|
1152 | #my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback", |
|
|
1153 | # courseID => $courseName); |
|
|
1154 | #my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action |
| 728 | # |
1155 | # |
| 729 | #print CGI::start_div(); |
|
|
| 730 | |
|
|
| 731 | # arguments for feedback form |
|
|
| 732 | my $feedbackURL = "$root/$courseName/feedback/"; |
|
|
| 733 | |
|
|
| 734 | #print feedback form |
1156 | ##print feedback form |
| 735 | print |
1157 | #print |
| 736 | CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", |
1158 | # CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n", |
| 737 | $self->hidden_authen_fields,"\n", |
1159 | # $self->hidden_authen_fields,"\n", |
| 738 | CGI::hidden("module", __PACKAGE__),"\n", |
1160 | # CGI::hidden("module", __PACKAGE__),"\n", |
| 739 | CGI::hidden("set", $set->set_id),"\n", |
1161 | # CGI::hidden("set", $set->set_id),"\n", |
| 740 | CGI::hidden("problem", $problem->problem_id),"\n", |
1162 | # CGI::hidden("problem", $problem->problem_id),"\n", |
| 741 | CGI::hidden("displayMode", $self->{displayMode}),"\n", |
1163 | # CGI::hidden("displayMode", $self->{displayMode}),"\n", |
| 742 | CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", |
1164 | # CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n", |
| 743 | CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", |
1165 | # CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n", |
| 744 | CGI::hidden("showHints", $will{showHints}),"\n", |
1166 | # CGI::hidden("showHints", $will{showHints}),"\n", |
| 745 | CGI::hidden("showSolutions", $will{showSolutions}),"\n", |
1167 | # CGI::hidden("showSolutions", $will{showSolutions}),"\n", |
| 746 | CGI::p({-align=>"left"}, |
1168 | # CGI::p({-align=>"left"}, |
| 747 | CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") |
1169 | # CGI::submit(-name=>"feedbackForm", -label=>"Email instructor") |
| 748 | ), |
1170 | # ), |
| 749 | CGI::endform(),"\n"; |
1171 | # CGI::endform(),"\n"; |
| 750 | |
1172 | |
| 751 | # FIXME print editor link |
1173 | print $self->feedbackMacro( |
| 752 | print $editorLinkMessage; #empty unless it is appropriate to have an editor link. |
1174 | module => __PACKAGE__, |
|
|
1175 | set => $self->{set}->set_id, |
|
|
1176 | problem => $problem->problem_id, |
|
|
1177 | displayMode => $self->{displayMode}, |
|
|
1178 | showOldAnswers => $will{showOldAnswers}, |
|
|
1179 | showCorrectAnswers => $will{showCorrectAnswers}, |
|
|
1180 | showHints => $will{showHints}, |
|
|
1181 | showSolutions => $will{showSolutions}, |
|
|
1182 | ); |
| 753 | |
1183 | |
| 754 | print CGI::end_div(); |
1184 | print CGI::end_div(); |
| 755 | |
|
|
| 756 | # warning output |
|
|
| 757 | #if ($pg->{warnings} ne "") { |
|
|
| 758 | # print CGI::hr(), $self->warningOutput($pg->{warnings}); |
|
|
| 759 | #} |
|
|
| 760 | |
1185 | |
| 761 | # debugging stuff |
1186 | # debugging stuff |
| 762 | if (0) { |
1187 | if (0) { |
| 763 | print |
1188 | print |
| 764 | CGI::hr(), |
1189 | CGI::hr(), |
| … | |
… | |
| 776 | } |
1201 | } |
| 777 | |
1202 | |
| 778 | return ""; |
1203 | return ""; |
| 779 | } |
1204 | } |
| 780 | |
1205 | |
| 781 | ##### output utilities ##### |
|
|
| 782 | |
|
|
| 783 | sub attemptResults($$$$$$) { |
|
|
| 784 | my $self = shift; |
|
|
| 785 | my $pg = shift; |
|
|
| 786 | my $showAttemptAnswers = shift; |
|
|
| 787 | my $showCorrectAnswers = shift; |
|
|
| 788 | my $showAttemptResults = $showAttemptAnswers && shift; |
|
|
| 789 | my $showSummary = shift; |
|
|
| 790 | my $showAttemptPreview = shift || 0; |
|
|
| 791 | my $ce = $self->{ce}; |
|
|
| 792 | my $problemResult = $pg->{result}; # the overall result of the problem |
|
|
| 793 | my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; |
|
|
| 794 | |
|
|
| 795 | my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames; |
|
|
| 796 | |
|
|
| 797 | my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview"; |
|
|
| 798 | my $imgGen = WeBWorK::PG::ImageGenerator->new( |
|
|
| 799 | tempDir => $ce->{webworkDirs}->{tmp}, |
|
|
| 800 | latex => $ce->{externalPrograms}->{latex}, |
|
|
| 801 | dvipng => $ce->{externalPrograms}->{dvipng}, |
|
|
| 802 | useCache => 1, |
|
|
| 803 | cacheDir => $ce->{webworkDirs}->{equationCache}, |
|
|
| 804 | cacheURL => $ce->{webworkURLs}->{equationCache}, |
|
|
| 805 | cacheDB => $ce->{webworkFiles}->{equationCacheDB}, |
|
|
| 806 | ); |
|
|
| 807 | |
|
|
| 808 | my $header; |
|
|
| 809 | #$header .= CGI::th("Part"); |
|
|
| 810 | $header .= $showAttemptAnswers ? CGI::th("Entered") : ""; |
|
|
| 811 | $header .= $showAttemptPreview ? CGI::th("Answer Preview") : ""; |
|
|
| 812 | $header .= $showCorrectAnswers ? CGI::th("Correct") : ""; |
|
|
| 813 | $header .= $showAttemptResults ? CGI::th("Result") : ""; |
|
|
| 814 | $header .= $showMessages ? CGI::th("messages") : ""; |
|
|
| 815 | my @tableRows = ( $header ); |
|
|
| 816 | my $numCorrect; |
|
|
| 817 | foreach my $name (@answerNames) { |
|
|
| 818 | my $answerResult = $pg->{answers}->{$name}; |
|
|
| 819 | my $studentAnswer = $answerResult->{student_ans}; # original_student_ans |
|
|
| 820 | my $preview = ($showAttemptPreview |
|
|
| 821 | ? $self->previewAnswer($answerResult, $imgGen) |
|
|
| 822 | : ""); |
|
|
| 823 | my $correctAnswer = $answerResult->{correct_ans}; |
|
|
| 824 | my $answerScore = $answerResult->{score}; |
|
|
| 825 | my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; |
|
|
| 826 | #FIXME --Can we be sure that $answerScore is an integer-- could the problem give partial credit? |
|
|
| 827 | $numCorrect += $answerScore > 0; |
|
|
| 828 | my $resultString = $answerScore == 1 ? "correct" : "incorrect"; |
|
|
| 829 | |
|
|
| 830 | # get rid of the goofy prefix on the answer names (supposedly, the format |
|
|
| 831 | # of the answer names is changeable. this only fixes it for "AnSwEr" |
|
|
| 832 | #$name =~ s/^AnSwEr//; |
|
|
| 833 | |
|
|
| 834 | my $row; |
|
|
| 835 | #$row .= CGI::td($name); |
|
|
| 836 | $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : ""; |
|
|
| 837 | $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : ""; |
|
|
| 838 | $row .= $showCorrectAnswers ? CGI::td(nbsp($correctAnswer)) : ""; |
|
|
| 839 | $row .= $showAttemptResults ? CGI::td(nbsp($resultString)) : ""; |
|
|
| 840 | $row .= $showMessages ? CGI::td(nbsp($answerMessage)) : ""; |
|
|
| 841 | push @tableRows, $row; |
|
|
| 842 | } |
|
|
| 843 | |
|
|
| 844 | # render equation images |
|
|
| 845 | $imgGen->render(refresh => 1); |
|
|
| 846 | |
|
|
| 847 | # my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions"; |
|
|
| 848 | my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100); |
|
|
| 849 | # FIXME -- I left the old code in in case we have to back out. |
|
|
| 850 | # my $summary = "On this attempt, you answered $numCorrect out of " |
|
|
| 851 | # . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent."; |
|
|
| 852 | my $summary = ""; |
|
|
| 853 | if (scalar @answerNames == 1) { |
|
|
| 854 | if ($numCorrect == scalar @answerNames) { |
|
|
| 855 | $summary .= "The above answer is correct."; |
|
|
| 856 | } else { |
|
|
| 857 | $summary .= "The above answer is NOT correct."; |
|
|
| 858 | } |
|
|
| 859 | } else { |
|
|
| 860 | if ($numCorrect == scalar @answerNames) { |
|
|
| 861 | $summary .= "All of the above answers are correct."; |
|
|
| 862 | } else { |
|
|
| 863 | $summary .= "At least one of the above answers is NOT correct."; |
|
|
| 864 | } |
|
|
| 865 | } |
|
|
| 866 | #FIXME there must be a better way to force refresh. |
|
|
| 867 | #my $refresh_warning = 'Hold down shift and click "refresh" or "reload" to update answer preview images.'; |
|
|
| 868 | #return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . |
|
|
| 869 | #CGI::div({style=>'color:red; font-size:10pt'},$refresh_warning) . |
|
|
| 870 | #($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); |
|
|
| 871 | # ... this has been fixed by equation caching. |
|
|
| 872 | return |
|
|
| 873 | CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) |
|
|
| 874 | . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : ""); |
|
|
| 875 | } |
|
|
| 876 | sub nbsp { |
|
|
| 877 | my $str = shift; |
|
|
| 878 | ($str =~/\S/) ? $str : ' ' ; # returns non-breaking space for empty strings |
|
|
| 879 | # tricky cases: $str =0; |
|
|
| 880 | # $str is a complex number |
|
|
| 881 | } |
|
|
| 882 | sub viewOptions($) { |
|
|
| 883 | my $self = shift; |
|
|
| 884 | my $displayMode = $self->{displayMode}; |
|
|
| 885 | my %must = %{ $self->{must} }; |
|
|
| 886 | my %can = %{ $self->{can} }; |
|
|
| 887 | my %will = %{ $self->{will} }; |
|
|
| 888 | |
|
|
| 889 | my $optionLine; |
|
|
| 890 | $can{showOldAnswers} and $optionLine .= join "", |
|
|
| 891 | "Show: ".CGI::br(), |
|
|
| 892 | CGI::checkbox( |
|
|
| 893 | -name => "showOldAnswers", |
|
|
| 894 | -checked => $will{showOldAnswers}, |
|
|
| 895 | -label => "Saved answers", |
|
|
| 896 | ), " ".CGI::br(); |
|
|
| 897 | |
|
|
| 898 | $optionLine and $optionLine .= join "", CGI::br(); |
|
|
| 899 | |
|
|
| 900 | return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"}, |
|
|
| 901 | "View equations as: ".CGI::br(), |
|
|
| 902 | CGI::radio_group( |
|
|
| 903 | -name => "displayMode", |
|
|
| 904 | -values => ['plainText', 'formattedText', 'images'], |
|
|
| 905 | -default => $displayMode, |
|
|
| 906 | -linebreak=>'true', |
|
|
| 907 | -labels => { |
|
|
| 908 | plainText => "plain", |
|
|
| 909 | formattedText => "formatted", |
|
|
| 910 | images => "images", |
|
|
| 911 | } |
|
|
| 912 | ), CGI::br(),CGI::hr(), |
|
|
| 913 | $optionLine, |
|
|
| 914 | CGI::submit(-name=>"redisplay", -label=>"Save Options"), |
|
|
| 915 | ); |
|
|
| 916 | } |
|
|
| 917 | |
|
|
| 918 | sub previewAnswer($$) { |
|
|
| 919 | my ($self, $answerResult, $imgGen) = @_; |
|
|
| 920 | my $ce = $self->{ce}; |
|
|
| 921 | my $effectiveUser = $self->{effectiveUser}; |
|
|
| 922 | my $set = $self->{set}; |
|
|
| 923 | my $problem = $self->{problem}; |
|
|
| 924 | my $displayMode = $self->{displayMode}; |
|
|
| 925 | |
|
|
| 926 | # note: right now, we have to do things completely differently when we are |
|
|
| 927 | # rendering math from INSIDE the translator and from OUTSIDE the translator. |
|
|
| 928 | # so we'll just deal with each case explicitly here. there's some code |
|
|
| 929 | # duplication that can be dealt with later by abstracting out tth/dvipng/etc. |
|
|
| 930 | |
|
|
| 931 | my $tex = $answerResult->{preview_latex_string}; |
|
|
| 932 | |
|
|
| 933 | return "" unless defined $tex and $tex ne ""; |
|
|
| 934 | |
|
|
| 935 | if ($displayMode eq "plainText") { |
|
|
| 936 | return $tex; |
|
|
| 937 | } elsif ($displayMode eq "formattedText") { |
|
|
| 938 | my $tthCommand = $ce->{externalPrograms}->{tth} |
|
|
| 939 | . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n" |
|
|
| 940 | . "\\(".$tex."\\)\n" |
|
|
| 941 | . "END_OF_INPUT\n"; |
|
|
| 942 | |
|
|
| 943 | # call tth |
|
|
| 944 | my $result = `$tthCommand`; |
|
|
| 945 | if ($?) { |
|
|
| 946 | return "<b>[tth failed: $? $@]</b>"; |
|
|
| 947 | } |
|
|
| 948 | return $result; |
|
|
| 949 | } elsif ($displayMode eq "images") { |
|
|
| 950 | ## how are we going to name this? |
|
|
| 951 | #my $targetPathCommon = "/m2i/" |
|
|
| 952 | # . $effectiveUser->user_id . "." |
|
|
| 953 | # . $set->set_id . "." |
|
|
| 954 | # . $problem->problem_id . "." |
|
|
| 955 | # . $answerResult->{ans_name} . ".png"; |
|
|
| 956 | # |
|
|
| 957 | ## figure out where to put things |
|
|
| 958 | #my $wd = makeTempDirectory($ce->{courseDirs}->{html_temp}, "webwork-dvipng"); |
|
|
| 959 | #my $latex = $ce->{externalPrograms}->{latex}; |
|
|
| 960 | #my $dvipng = $ce->{externalPrograms}->{dvipng}; |
|
|
| 961 | #my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon; |
|
|
| 962 | # # should use surePathToTmpFile, but we have to |
|
|
| 963 | # # isolate it from the problem enivronment first |
|
|
| 964 | #my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon; |
|
|
| 965 | # |
|
|
| 966 | ## call dvipng to generate a preview |
|
|
| 967 | #dvipng($wd, $latex, $dvipng, $tex, $targetPath); |
|
|
| 968 | #rmtree($wd, 0, 0); |
|
|
| 969 | #if (-e $targetPath) { |
|
|
| 970 | # return "<img src=\"$targetURL\" alt=\"$tex\" />"; |
|
|
| 971 | #} else { |
|
|
| 972 | # return "<b>[math2img failed]</b>"; |
|
|
| 973 | #} |
|
|
| 974 | $imgGen->add($answerResult->{preview_latex_string}); |
|
|
| 975 | |
|
|
| 976 | } |
|
|
| 977 | } |
|
|
| 978 | |
|
|
| 979 | ##### logging subroutine #### |
|
|
| 980 | |
|
|
| 981 | |
|
|
| 982 | |
|
|
| 983 | ##### permission queries ##### |
|
|
| 984 | |
|
|
| 985 | # this stuff should be abstracted out into the permissions system |
|
|
| 986 | # however, the permission system only knows about things in the |
|
|
| 987 | # course environment and the username. hmmm... |
|
|
| 988 | |
|
|
| 989 | # also, i should fix these so that they have a consistent calling |
|
|
| 990 | # format -- perhaps: |
|
|
| 991 | # canPERM($courseEnv, $user, $set, $problem, $permissionLevel) |
|
|
| 992 | |
|
|
| 993 | sub canShowCorrectAnswers($$) { |
|
|
| 994 | my ($permissionLevel, $answerDate) = @_; |
|
|
| 995 | return $permissionLevel > 0 || time > $answerDate; |
|
|
| 996 | } |
|
|
| 997 | |
|
|
| 998 | sub canShowSolutions($$) { |
|
|
| 999 | my ($permissionLevel, $answerDate) = @_; |
|
|
| 1000 | return canShowCorrectAnswers($permissionLevel, $answerDate); |
|
|
| 1001 | } |
|
|
| 1002 | |
|
|
| 1003 | sub canRecordAnswers($$$$$) { |
|
|
| 1004 | my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; |
|
|
| 1005 | my $permHigh = $permissionLevel > 0; |
|
|
| 1006 | my $timeOK = time >= $openDate && time <= $dueDate; |
|
|
| 1007 | my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts; |
|
|
| 1008 | my $recordAnswers = $permHigh || ($timeOK && $attemptsOK); |
|
|
| 1009 | return $recordAnswers; |
|
|
| 1010 | } |
|
|
| 1011 | |
|
|
| 1012 | sub canCheckAnswers($$) { |
|
|
| 1013 | my ($permissionLevel, $answerDate) = @_; |
|
|
| 1014 | my $permHigh = $permissionLevel > 0; |
|
|
| 1015 | my $timeOK = time >= $answerDate; |
|
|
| 1016 | my $recordAnswers = $permHigh || $timeOK; |
|
|
| 1017 | return $recordAnswers; |
|
|
| 1018 | } |
|
|
| 1019 | |
|
|
| 1020 | sub mustRecordAnswers($) { |
|
|
| 1021 | my ($permissionLevel) = @_; |
|
|
| 1022 | return $permissionLevel == 0; |
|
|
| 1023 | } |
|
|
| 1024 | |
|
|
| 1025 | 1; |
1206 | 1; |
Parent Directory
| 
Revision Log
| 
Patch