[system] / branches / gage_dev / webwork2 / lib / WeBWorK / ContentGenerator / Problem.pm Repository:
ViewVC logotype

Diff of /branches/gage_dev/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 2444 Revision 3391
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-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.151 2004/07/03 17:29:32 sh002i Exp $ 4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.176 2005/07/14 13:15:25 glarose 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.
… …
29use File::Path qw(rmtree); 29use File::Path qw(rmtree);
30use WeBWorK::Form; 30use WeBWorK::Form;
31use WeBWorK::PG; 31use WeBWorK::PG;
32use WeBWorK::PG::ImageGenerator; 32use WeBWorK::PG::ImageGenerator;
33use WeBWorK::PG::IO; 33use WeBWorK::PG::IO;
34use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory); 34use WeBWorK::Utils qw(readFile writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory);
35use WeBWorK::DB::Utils qw(global2user user2global findDefaults); 35use WeBWorK::DB::Utils qw(global2user user2global findDefaults);
36use WeBWorK::Timing; 36use WeBWorK::Timing;
37use URI::Escape;
37 38
38use WeBWorK::Utils::Tasks qw(fake_set fake_problem); 39use WeBWorK::Utils::Tasks qw(fake_set fake_problem);
39 40
40############################################################ 41################################################################################
42# CGI param interface to this module (up-to-date as of v1.153)
43################################################################################
44
45# Standard params:
41# 46#
42# user 47# user - user ID of real user
43# effectiveUser 48# key - session key
44# key 49# effectiveUser - user ID of effective user
45# 50#
46# editMode 51# Integration with PGProblemEditor:
47# sourceFilePath - path to file to be editted
48# problemSeed - problem seed for editted problem
49#
50# displayMode - type of display (ie formatted, images, asciimath, etc)
51#
52# showOldAnswers
53# showCorrectAnswers
54# showHints
55# showSolutions
56# 52#
57# AnSwEr# - answer blanks in problem 53# editMode - if set, indicates alternate problem source location.
54# can be "temporaryFile" or "savedFile".
58# 55#
59# redisplay - name of the "Redisplay Problem" button 56# sourceFilePath - path to file to be edited
60# submitAnswers - name of "Submit Answers" button 57# problemSeed - force problem seed to value
61# checkAnswers - name of the "Check Answers" button 58# success - success message to display
62# previewAnswers - name of the "Preview Answers" button 59# failure - failure message to display
63#
64# success - success message (from PGProblemEditor)
65# failure - failure message (from PGProblemEditor)
66# 60#
61# Rendering options:
62#
63# displayMode - name of display mode to use
64#
65# showOldAnswers - request that last entered answer be shown (if allowed)
66# showCorrectAnswers - request that correct answers be shown (if allowed)
67# showHints - request that hints be shown (if allowed)
68# showSolutions - request that solutions be shown (if allowed)
69#
70# Problem interaction:
71#
72# AnSwEr# - answer blanks in problem
73#
74# redisplay - name of the "Redisplay Problem" button
75# submitAnswers - name of "Submit Answers" button
76# checkAnswers - name of the "Check Answers" button
77# previewAnswers - name of the "Preview Answers" button
78
67############################################################ 79################################################################################
80# "can" methods
81################################################################################
68 82
83# Subroutines to determine if a user "can" perform an action. Each subroutine is
84# called with the following arguments:
85#
86# ($self, $User, $EffectiveUser, $Set, $Problem)
87
88# Note that significant parts of the "can" methods are lifted into the
89# GatewayQuiz module. It isn't direct, however, because of the necessity
90# of dealing with versioning there.
91
92sub can_showOldAnswers {
93 #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
94
95 return 1;
96}
97
98sub can_showCorrectAnswers {
99 my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
100 my $authz = $self->r->authz;
101
102 return
103 after($Set->answer_date)
104 ||
105 $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date")
106 ;
107}
108
109sub can_showHints {
110 #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
111
112 return 1;
113}
114
115sub can_showSolutions {
116 my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
117 my $authz = $self->r->authz;
118
119 return
120 after($Set->answer_date)
121 ||
122 $authz->hasPermissions($User->user_id, "show_solutions_before_answer_date")
123 ;
124}
125
126sub can_recordAnswers {
127 my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_;
128 my $authz = $self->r->authz;
129 my $thisAttempt = $submitAnswers ? 1 : 0;
130 if ($User->user_id ne $EffectiveUser->user_id) {
131 return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student");
132 }
133 if (before($Set->open_date)) {
134 return $authz->hasPermissions($User->user_id, "record_answers_before_open_date");
135 } elsif (between($Set->open_date, $Set->due_date)) {
136 my $max_attempts = $Problem->max_attempts;
137 my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt;
138 if ($max_attempts == -1 or $attempts_used < $max_attempts) {
139 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts");
140 } else {
141 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts");
142 }
143 } elsif (between($Set->due_date, $Set->answer_date)) {
144 return $authz->hasPermissions($User->user_id, "record_answers_after_due_date");
145 } elsif (after($Set->answer_date)) {
146 return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date");
147 }
148}
149
150sub can_checkAnswers {
151 my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_;
152 my $authz = $self->r->authz;
153 my $thisAttempt = $submitAnswers ? 1 : 0;
154
155 if (before($Set->open_date)) {
156 return $authz->hasPermissions($User->user_id, "check_answers_before_open_date");
157 } elsif (between($Set->open_date, $Set->due_date)) {
158 my $max_attempts = $Problem->max_attempts;
159 my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt;
160 if ($max_attempts == -1 or $attempts_used < $max_attempts) {
161 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts");
162 } else {
163 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts");
164 }
165 } elsif (between($Set->due_date, $Set->answer_date)) {
166 return $authz->hasPermissions($User->user_id, "check_answers_after_due_date");
167 } elsif (after($Set->answer_date)) {
168 return $authz->hasPermissions($User->user_id, "check_answers_after_answer_date");
169 }
170}
171
172# Helper functions for calculating times
173sub before { return time <= $_[0] }
174sub after { return time >= $_[0] }
175sub between { my $t = time; return $t > $_[0] && $t < $_[1] }
176
177################################################################################
178# output utilities
179################################################################################
180
181# Note: the substance of attemptResults is lifted into GatewayQuiz.pm,
182# with some changes to the output format
183
184sub attemptResults {
185 my $self = shift;
186 my $pg = shift;
187 my $showAttemptAnswers = shift;
188 my $showCorrectAnswers = shift;
189 my $showAttemptResults = $showAttemptAnswers && shift;
190 my $showSummary = shift;
191 my $showAttemptPreview = shift || 0;
192
193 my $ce = $self->r->ce;
194
195 my $problemResult = $pg->{result}; # the overall result of the problem
196 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
197
198 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
199
200 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview";
201
202 # to make grabbing these options easier, we'll pull them out now...
203 my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}};
204
205 my $imgGen = WeBWorK::PG::ImageGenerator->new(
206 tempDir => $ce->{webworkDirs}->{tmp},
207 latex => $ce->{externalPrograms}->{latex},
208 dvipng => $ce->{externalPrograms}->{dvipng},
209 useCache => 1,
210 cacheDir => $ce->{webworkDirs}->{equationCache},
211 cacheURL => $ce->{webworkURLs}->{equationCache},
212 cacheDB => $ce->{webworkFiles}->{equationCacheDB},
213 dvipng_align => $imagesModeOptions{dvipng_align},
214 dvipng_depth_db => $imagesModeOptions{dvipng_depth_db},
215 );
216
217 my $header;
218 #$header .= CGI::th("Part");
219 $header .= $showAttemptAnswers ? CGI::th("Entered") : "";
220 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : "";
221 $header .= $showCorrectAnswers ? CGI::th("Correct") : "";
222 $header .= $showAttemptResults ? CGI::th("Result") : "";
223 $header .= $showMessages ? CGI::th("Messages") : "";
224 my $fully = '';
225 my @tableRows = ( $header );
226 my $numCorrect = 0;
227 my $numBlanks =0;
228 my $tthPreambleCache;
229 foreach my $name (@answerNames) {
230 my $answerResult = $pg->{answers}->{$name};
231 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
232 my $preview = ($showAttemptPreview
233 ? $self->previewAnswer($answerResult, $imgGen, \$tthPreambleCache)
234 : "");
235 my $correctAnswer = $answerResult->{correct_ans};
236 my $answerScore = $answerResult->{score};
237 my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
238 $answerMessage =~ s/\n/<BR>/g;
239 $numCorrect += $answerScore >= 1;
240 $numBlanks++ unless $studentAnswer =~/\S/; # unless student answer contains entry
241 my $resultString = $answerScore >= 1 ? "correct" :
242 $answerScore > 0 ? int($answerScore*100)."% correct" :
243 "incorrect";
244 $fully = 'completely ' if $answerScore >0 and $answerScore < 1;
245
246 # get rid of the goofy prefix on the answer names (supposedly, the format
247 # of the answer names is changeable. this only fixes it for "AnSwEr"
248 #$name =~ s/^AnSwEr//;
249
250 my $row;
251 #$row .= CGI::td($name);
252 $row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : "";
253 $row .= $showAttemptPreview ? CGI::td($self->nbsp($preview)) : "";
254 $row .= $showCorrectAnswers ? CGI::td($self->nbsp($correctAnswer)) : "";
255 $row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : "";
256 $row .= $showMessages ? CGI::td({-class=>"Message"},$self->nbsp($answerMessage)) : "";
257 push @tableRows, $row;
258 }
259
260 # render equation images
261 $imgGen->render(refresh => 1);
262
263# my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
264 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100);
265# FIXME -- I left the old code in in case we have to back out.
266# my $summary = "On this attempt, you answered $numCorrect out of "
267# . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
268 my $summary = "";
269 unless (defined($problemResult->{summary}) and $problemResult->{summary} =~ /\S/) {
270 if (scalar @answerNames == 1) { #default messages
271 if ($numCorrect == scalar @answerNames) {
272 $summary .= CGI::div({class=>"ResultsWithoutError"},"The above answer is correct.");
273 } else {
274 $summary .= CGI::div({class=>"ResultsWithError"},"The above answer is NOT ${fully}correct.");
275 }
276 } else {
277 if ($numCorrect == scalar @answerNames) {
278 $summary .= CGI::div({class=>"ResultsWithoutError"},"All of the above answers are correct.");
279 }
280 unless ($numCorrect + $numBlanks == scalar( @answerNames)) {
281 $summary .= CGI::div({class=>"ResultsWithError"},"At least one of the above answers is NOT ${fully}correct.");
282 }
283 if ($numBlanks) {
284 my $s = ($numBlanks>1)?'':'s';
285 $summary .= CGI::div({class=>"ResultsAlert"},"$numBlanks of the questions remain$s unanswered.");
286 }
287 }
288 } else {
289 $summary = $problemResult->{summary}; # summary has been defined by grader
290 }
291 return
292 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows))
293 . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
294}
295
296
297# Note: previewAnswer is lifted into GatewayQuiz.pm
298
299sub previewAnswer {
300 my ($self, $answerResult, $imgGen, $tthPreambleCache) = @_;
301 my $ce = $self->r->ce;
302 my $effectiveUser = $self->{effectiveUser};
303 my $set = $self->{set};
304 my $problem = $self->{problem};
305 my $displayMode = $self->{displayMode};
306
307 # note: right now, we have to do things completely differently when we are
308 # rendering math from INSIDE the translator and from OUTSIDE the translator.
309 # so we'll just deal with each case explicitly here. there's some code
310 # duplication that can be dealt with later by abstracting out tth/dvipng/etc.
311
312 my $tex = $answerResult->{preview_latex_string};
313
314 return "" unless defined $tex and $tex ne "";
315
316 if ($displayMode eq "plainText") {
317 return $tex;
318 } elsif ($displayMode eq "formattedText") {
319
320 # read the TTH preamble, or use the cached copy passed in from the caller
321 my $tthPreamble;
322 if (defined $$tthPreambleCache) {
323 $tthPreamble = $$tthPreambleCache;
324 } else {
325 my $tthPreambleFile = $ce->{courseDirs}->{templates} . "/tthPreamble.tex";
326 if (-r $tthPreambleFile) {
327 $tthPreamble = readFile($tthPreambleFile);
328 # thanks to Jim Martino. each line in the definition file should end with
329 #a % to prevent adding supurious paragraphs to output:
330 $tthPreamble =~ s/(.)\n/$1%\n/g;
331 # solves the problem if the file doesn't end with a return:
332 $tthPreamble .="%\n";
333 # store preamble in cache:
334 $$tthPreambleCache = $tthPreamble;
335 } else {
336 }
337 }
338
339 # construct TTH command line
340 my $tthCommand = $ce->{externalPrograms}->{tth}
341 . " -L -f5 -u -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
342 . $tthPreamble . "\\[" . $tex . "\\]\n"
343 . "END_OF_INPUT\n";
344
345 # call tth
346 my $result = `$tthCommand`;
347 if ($?) {
348 return "<b>[tth failed: $? $@]</b>";
349 } else {
350 # avoid border problems in tables and remove unneeded initial <br>
351 $result =~ s/(<table [^>]*)>/$1 CLASS="ArrayLayout">/gi;
352 $result =~ s!\s*<br clear="all" />!!;
353 return $result;
354 }
355
356 } elsif ($displayMode eq "images") {
357 $imgGen->add($tex);
358 } elsif ($displayMode eq "jsMath") {
359 return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>';
360 }
361}
362
363################################################################################
364# Template escape implementations
365################################################################################
69 366
70sub pre_header_initialize { 367sub pre_header_initialize {
71 my ($self) = @_; 368 my ($self) = @_;
72 my $r = $self->r; 369 my $r = $self->r;
73 my $ce = $r->ce; 370 my $ce = $r->ce;
… …
87 384
88 my $effectiveUser = $db->getUser($effectiveUserName); # checked 385 my $effectiveUser = $db->getUser($effectiveUserName); # checked
89 die "record for user $effectiveUserName (effective user) does not exist." 386 die "record for user $effectiveUserName (effective user) does not exist."
90 unless defined $effectiveUser; 387 unless defined $effectiveUser;
91 388
92 my $PermissionLevel = $db->getPermissionLevel($userName); # checked
93 die "permission level record for user $userName does not exist (but the user does? odd...)"
94 unless defined $PermissionLevel;
95 my $permissionLevel = $PermissionLevel->permission;
96
97 # obtain the merged set for $effectiveUser 389 # obtain the merged set for $effectiveUser
98 my $set = $db->getMergedSet($effectiveUserName, $setName); # checked 390 my $set = $db->getMergedSet($effectiveUserName, $setName); # checked
391
392# gateway check here: we want to be sure that someone isn't trying to take
393# a GatewayQuiz through the regular problem/homework mechanism, thereby
394# circumventing the versioning, time limits, etc.
395 die('Invalid access attempt: the Problem ContentGenerator was called ' .
396 'for a GatewayQuiz assignment.')
397 if ( defined($set) && defined( $set->assignment_type() ) &&
398 $set->assignment_type() =~ /gateway/ );
399
400 # Database fix (in case of undefined published values)
401 # this is only necessary because some people keep holding to ww1.9 which did not have a published field
402 # make sure published is set to 0 or 1
403 if ( $set and $set->published ne "0" and $set->published ne "1") {
404 my $globalSet = $db->getGlobalSet($set->set_id);
405 $globalSet->published("1"); # defaults to published
406 $db->putGlobalSet($globalSet);
407 $set = $db->getMergedSet($effectiveUserName, $setName);
408 } else {
409 # don't do anything just yet, maybe we're a professor and we're
410 # fabricating a set or haven't assigned it to ourselves just yet
411 }
99 412
100 # obtain the merged problem for $effectiveUser 413 # obtain the merged problem for $effectiveUser
101 my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked 414 my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked
102 415
103 my $editMode = $r->param("editMode"); 416 my $editMode = $r->param("editMode");
104 417
105 if ($authz->hasPermissions($userName, "modify_problem_sets")) { 418 if ($authz->hasPermissions($userName, "modify_problem_sets")) {
106 # professors are allowed to fabricate sets and problems not 419 # professors are allowed to fabricate sets and problems not
107 # assigned to them (or anyone). this allows them to use the 420 # assigned to them (or anyone). this allows them to use the
108 # editor to 421 # editor to
109 422
110 # if that is not yet defined obtain the global set, convert 423 # if a User Set does not exist for this user and this set
111 # it to a user set, and add fake user data 424 # then we check the Global Set
425 # if that does not exist we create a fake set
426 # if it does, we add fake user data
112 unless (defined $set) { 427 unless (defined $set) {
113 my $userSetClass = $db->{set_user}->{record}; 428 my $userSetClass = $db->{set_user}->{record};
114 my $globalSet = $db->getGlobalSet($setName); # checked 429 my $globalSet = $db->getGlobalSet($setName); # checked
115 # if the global set doesn't exist either, bail! 430
116 if(not defined $globalSet) { 431 if (not defined $globalSet) {
117 $set = fake_set($db); 432 $set = fake_set($db);
118 } else { 433 } else {
119 $set = global2user($userSetClass, $globalSet); 434 $set = global2user($userSetClass, $globalSet);
120 $set->psvn(0); 435 $set->psvn(0);
121
122 # FIXME: This is a temporary fix to fill in the database
123 # We want the published field to contain either 1 or 0 so if it has not been set to 0, default to 1
124 # this will fill in all the empty fields but not change anything that has been specifically set to 1 or 0
125 $globalSet->published("1") unless $globalSet->published eq "0";
126 $db->putGlobalSet($globalSet);
127 } 436 }
128 } 437 }
129 438
130 # if that is not yet defined obtain the global problem, 439 # if that is not yet defined obtain the global problem,
131 # convert it to a user problem, and add fake user data 440 # convert it to a user problem, and add fake user data
… …
178 } 487 }
179 488
180 my $publishedClass = ($set->published) ? "Published" : "Unpublished"; 489 my $publishedClass = ($set->published) ? "Published" : "Unpublished";
181 my $publishedText = ($set->published) ? "visible to students." : "hidden from students."; 490 my $publishedText = ($set->published) ? "visible to students." : "hidden from students.";
182 $self->addmessage(CGI::p("This set is " . CGI::font({class=>$publishedClass}, $publishedText))); 491 $self->addmessage(CGI::p("This set is " . CGI::font({class=>$publishedClass}, $publishedText)));
183 } else {
184
185 # students can't view problems not assigned to them
186 492
493 # test for additional set validity if it's not already invalid
494 } else {
187 # A set is valid if it exists and if it is either published or the user is privileged. 495 # A set is valid if it exists and if it is either published or the user is privileged.
188 $self->{invalidSet} = ((grep /^$setName/, $db->listUserSets($effectiveUserName)) == 0)
189 || not defined $set
190 || !($set->published || $authz->hasPermissions($userName, "view_unpublished_sets")); 496 $self->{invalidSet} = !(defined $set and ($set->published || $authz->hasPermissions($userName, "view_unpublished_sets")));
191 $self->{invalidProblem} = ((grep /^$problemNumber/, $db->listUserProblems($effectiveUserName, $setName)) == 0)
192 || not defined $problem
193 || !($set->published || $authz->hasPermissions($userName, "view_unpublished_sets")); 497 $self->{invalidProblem} = !(defined $problem and ($set->published || $authz->hasPermissions($userName, "view_unpublished_sets")));
194 498
195 $self->addbadmessage(CGI::p("This problem will not count towards your grade.")) if $problem and not $problem->value and not $self->{invalidProblem}; 499 $self->addbadmessage(CGI::p("This problem will not count towards your grade.")) if $problem and not $problem->value and not $self->{invalidProblem};
196 } 500 }
197 501
198 $self->{userName} = $userName; 502 $self->{userName} = $userName;
199 $self->{effectiveUserName} = $effectiveUserName; 503 $self->{effectiveUserName} = $effectiveUserName;
200 $self->{user} = $user; 504 $self->{user} = $user;
201 $self->{effectiveUser} = $effectiveUser; 505 $self->{effectiveUser} = $effectiveUser;
202 $self->{permissionLevel} = $permissionLevel;
203 $self->{set} = $set; 506 $self->{set} = $set;
204 $self->{problem} = $problem; 507 $self->{problem} = $problem;
205 $self->{editMode} = $editMode; 508 $self->{editMode} = $editMode;
206 509
207 ##### form processing ##### 510 ##### form processing #####
… …
221 $self->{checkAnswers} = $checkAnswers; 524 $self->{checkAnswers} = $checkAnswers;
222 $self->{previewAnswers} = $previewAnswers; 525 $self->{previewAnswers} = $previewAnswers;
223 $self->{formFields} = $formFields; 526 $self->{formFields} = $formFields;
224 527
225 # get result and send to message 528 # get result and send to message
226 my $success = $r->param("sucess"); 529 my $status_message = $r->param("status_message");
227 my $failure = $r->param("failure");
228 $self->addbadmessage(CGI::p($failure)) if $failure;
229 $self->addgoodmessage(CGI::p($success)) if $success; 530 $self->addmessage(CGI::p("$status_message")) if $status_message;
230 531
231 # now that we've set all the necessary variables quit out if the set or problem is invalid 532 # now that we've set all the necessary variables quit out if the set or problem is invalid
232 return if $self->{invalidSet} || $self->{invalidProblem}; 533 return if $self->{invalidSet} || $self->{invalidProblem};
233 534
234 ##### permissions ##### 535 ##### permissions #####
235 536
236 # are we allowed to view this problem? 537 # are we allowed to view this problem?
237 $self->{isOpen} = time >= $set->open_date || $authz->hasPermissions($user, "view_unopened_sets"); 538 $self->{isOpen} = after($set->open_date) || $authz->hasPermissions($userName, "view_unopened_sets");
238 return unless $self->{isOpen}; 539 return unless $self->{isOpen};
239 540
240 # what does the user want to do? 541 # what does the user want to do?
542 #FIXME There is a problem with checkboxes -- if they are not checked they are invisible. Hence if the default mode in $ce is 1
543 # there is no way to override this. Probably this is ok for the last three options, but it was definitely not ok for showing
544 # saved answers which is normally on, but you want to be able to turn it off! This section should be moved to ContentGenerator
545 # so that you can set these options anywhere. We also need mechanisms for making them sticky.
241 my %want = ( 546 my %want = (
242 showOldAnswers => $r->param("showOldAnswers") || $ce->{pg}->{options}->{showOldAnswers}, 547 showOldAnswers => defined($r->param("showOldAnswers")) ? $r->param("showOldAnswers") : $ce->{pg}->{options}->{showOldAnswers},
243 showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers}, 548 showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers},
244 showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints}, 549 showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints},
245 showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions}, 550 showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions},
246 recordAnswers => $submitAnswers, 551 recordAnswers => $submitAnswers,
247 checkAnswers => $checkAnswers, 552 checkAnswers => $checkAnswers,
553 getSubmitButton => 1,
248 ); 554 );
249 555
250 # are certain options enforced? 556 # are certain options enforced?
251 my %must = ( 557 my %must = (
252 showOldAnswers => 0, 558 showOldAnswers => 0,
253 showCorrectAnswers => 0, 559 showCorrectAnswers => 0,
254 showHints => 0, 560 showHints => 0,
255 showSolutions => 0, 561 showSolutions => 0,
256 recordAnswers => mustRecordAnswers($permissionLevel), 562 recordAnswers => ! $authz->hasPermissions($userName, "avoid_recording_answers"),
257 checkAnswers => 0, 563 checkAnswers => 0,
564 getSubmitButton => 0,
258 ); 565 );
259 566
260 # does the user have permission to use certain options? 567 # does the user have permission to use certain options?
568 my @args = ($user, $effectiveUser, $set, $problem);
261 my %can = ( 569 my %can = (
262 showOldAnswers => 1, 570 showOldAnswers => $self->can_showOldAnswers(@args),
263 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date), 571 showCorrectAnswers => $self->can_showCorrectAnswers(@args),
264 showHints => 1, 572 showHints => $self->can_showHints(@args),
265 showSolutions => canShowSolutions($permissionLevel, $set->answer_date), 573 showSolutions => $self->can_showSolutions(@args),
266 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, 574 recordAnswers => $self->can_recordAnswers(@args, 0),
267 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), 575 checkAnswers => $self->can_checkAnswers(@args, $submitAnswers),
268 # attempts=num_correct+num_incorrect+1, as this happens before updating $problem 576 getSubmitButton => $self->can_recordAnswers(@args, $submitAnswers),
269 checkAnswers => canCheckAnswers($permissionLevel, $set->due_date),
270 );
271
272 # more complicated logic for showing check answer button:
273 # checkAnswers button shows up after due date -- once a student can't record anymore
274 # checkAnswers button always shows up when an instructor or TA is acting
275 # as someone else (the $user and $effectiveUserName aren't the same).
276 $can{checkAnswers} = (
277 # $can{recordAnswers} will be false if the due date has passed OR the
278 # student has used up all of her attempts
279 ($can{checkAnswers} and not $can{recordAnswers})
280 or
281 (
282 # FIXME: this is not the right way to check for this.
283 # also, canCheckAnswers() will show this button if the permission
284 # level is positive, which is always true when an instructor is
285 # acting as a student
286 defined($userName)
287 and
288 defined($effectiveUserName)
289 and
290 ($userName ne $effectiveUserName)
291 )
292 );
293
294 # more complicated logic for showing "submit answer" button:
295 # We hide the submit answer button if someone is acting as a student
296 # This prevents errors where you accidently submit the answer for a student
297 # Not sure whether this a feature or a bug
298 $can{recordAnswers} = (
299 $can{recordAnswers}
300 and not
301 (
302 # FIXME: this is not the right way to check for this.
303 defined($userName)
304 and
305 defined($effectiveUserName)
306 and
307 ($userName ne $effectiveUserName)
308 )
309 ); 577 );
310 578
311 # final values for options 579 # final values for options
312 my %will; 580 my %will;
313 foreach (keys %must) { 581 foreach (keys %must) {
… …
341 processAnswers => 1, 609 processAnswers => 1,
342 }, 610 },
343 ); 611 );
344 612
345 $WeBWorK::timer->continue("end pg processing") if defined($WeBWorK::timer); 613 $WeBWorK::timer->continue("end pg processing") if defined($WeBWorK::timer);
614
346 ##### fix hint/solution options ##### 615 ##### fix hint/solution options #####
347 616
348 $can{showHints} &&= $pg->{flags}->{hintExists} 617 $can{showHints} &&= $pg->{flags}->{hintExists}
349 &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans}; 618 &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans};
350 $can{showSolutions} &&= $pg->{flags}->{solutionExists}; 619 $can{showSolutions} &&= $pg->{flags}->{solutionExists};
… …
373 642
374 return "" unless $self->{isOpen}; 643 return "" unless $self->{isOpen};
375 return $self->{pg}->{head_text} if $self->{pg}->{head_text}; 644 return $self->{pg}->{head_text} if $self->{pg}->{head_text};
376} 645}
377 646
378sub options { 647# sub options {
379 my ($self) = @_; 648# my ($self) = @_;
380 649# warn "doing options in Problem";
381 return "" if $self->{invalidProblem}; 650# return "" if $self->{invalidProblem};
382 my $sourceFilePathfield = ''; 651# my $sourceFilePathfield = '';
383 if($self->r->param("sourceFilePath")) { 652# if($self->r->param("sourceFilePath")) {
384 $sourceFilePathfield = CGI::hidden(-name => "sourceFilePath", 653# $sourceFilePathfield = CGI::hidden(-name => "sourceFilePath",
385 -value => $self->r->param("sourceFilePath")); 654# -value => $self->r->param("sourceFilePath"));
386 } 655# }
387 656#
388 return join("", 657# return join("",
389 CGI::start_form("POST", $self->{r}->uri), 658# CGI::start_form("POST", $self->{r}->uri),
390 $self->hidden_authen_fields, 659# $self->hidden_authen_fields,
391 $sourceFilePathfield, 660# $sourceFilePathfield,
392 CGI::hr(), 661# CGI::hr(),
393 CGI::start_div({class=>"viewOptions"}), 662# CGI::start_div({class=>"viewOptions"}),
394 $self->viewOptions(), 663# $self->viewOptions(),
395 CGI::end_div(), 664# CGI::end_div(),
396 CGI::end_form() 665# CGI::end_form()
397 ); 666# );
398} 667# }
399 668
400sub siblings { 669sub siblings {
401 my ($self) = @_; 670 my ($self) = @_;
402 my $r = $self->r; 671 my $r = $self->r;
403 my $db = $r->db; 672 my $db = $r->db;
… …
417 print CGI::start_ul(); 686 print CGI::start_ul();
418 687
419 foreach my $problemID (@problemIDs) { 688 foreach my $problemID (@problemIDs) {
420 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", 689 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem",
421 courseID => $courseID, setID => $setID, problemID => $problemID); 690 courseID => $courseID, setID => $setID, problemID => $problemID);
422 print CGI::li(CGI::a({href=>$self->systemLink($problemPage, params=>{displayMode => $self->{displayMode}})}, "Problem $problemID")); 691 print CGI::li(CGI::a( {href=>$self->systemLink($problemPage,
692 params=>{ displayMode => $self->{displayMode},
693 showOldAnswers => $self->{will}->{showOldAnswers}
694 })}, "Problem $problemID")
695 );
423 } 696 }
424 697
425 print CGI::end_ul(); 698 print CGI::end_ul();
426 print CGI::end_li(); 699 print CGI::end_li();
427 print CGI::end_ul(); 700 print CGI::end_ul();
… …
470 push @links, "Next Problem", $r->location . $nextPage->path, "navNext"; 743 push @links, "Next Problem", $r->location . $nextPage->path, "navNext";
471 } else { 744 } else {
472 push @links, "Next Problem", "", "navNext"; 745 push @links, "Next Problem", "", "navNext";
473 } 746 }
474 747
475 my $tail = "&displayMode=".$self->{displayMode}; 748 my $tail = "&displayMode=".$self->{displayMode}."&showOldAnswers=".$self->{will}->{showOldAnswers};
476 return $self->navMacro($args, $tail, @links); 749 return $self->navMacro($args, $tail, @links);
477} 750}
478 751
479sub title { 752sub title {
480 my ($self) = @_; 753 my ($self) = @_;
481 754
482 # using the url arguments won't break if the set/problem are invalid 755 # using the url arguments won't break if the set/problem are invalid
483 my $setID = $self->r->urlpath->arg("setID"); 756 my $setID = $self->r->urlpath->arg("setID");
484 my $problemID = $self->r->urlpath->arg("problemID"); 757 my $problemID = $self->r->urlpath->arg("problemID");
485 758
486 return "$setID : $problemID"; 759 return "$setID: Problem $problemID";
487} 760}
488 761
489sub body { 762sub body {
490 my $self = shift; 763 my $self = shift;
491 my $r = $self->r; 764 my $r = $self->r;
492 my $ce = $r->ce; 765 my $ce = $r->ce;
493 my $db = $r->db; 766 my $db = $r->db;
494 my $authz = $r->authz; 767 my $authz = $r->authz;
495 my $urlpath = $r->urlpath; 768 my $urlpath = $r->urlpath;
496 my $user = $r->param('user'); 769 my $user = $r->param('user');
770 my $effectiveUser = $r->param('effectiveUser');
497 771
498 if ($self->{invalidSet}) { 772 if ($self->{invalidSet}) {
499 return CGI::div({class=>"ResultsWithError"}, 773 return CGI::div({class=>"ResultsWithError"},
500 CGI::p("The selected problem set (" . $urlpath->arg("setID") . ") is not a valid set for " . $r->param("effectiveUser") . ".")); 774 CGI::p("The selected homework set (" . $urlpath->arg("setID") . ") is not a valid set for " . $r->param("effectiveUser") . "."));
501 } 775 }
502 776
503 if ($self->{invalidProblem}) { 777 if ($self->{invalidProblem}) {
504 return CGI::div({class=>"ResultsWithError"}, 778 return CGI::div({class=>"ResultsWithError"},
505 CGI::p("The selected problem (" . $urlpath->arg("problemID") . ") is not a valid problem for set " . $self->{set}->set_id . ".")); 779 CGI::p("The selected problem (" . $urlpath->arg("problemID") . ") is not a valid problem for set " . $self->{set}->set_id . "."));
506 } 780 }
507 781
508 unless ($self->{isOpen}) { 782 unless ($self->{isOpen}) {
509 return CGI::div({class=>"ResultsWithError"}, 783 return CGI::div({class=>"ResultsWithError"},
510 CGI::p("This problem is not available because the problem set that contains it is not yet open.")); 784 CGI::p("This problem is not available because the homework set that contains it is not yet open."));
511 } 785 }
512 # unpack some useful variables 786 # unpack some useful variables
513 my $set = $self->{set}; 787 my $set = $self->{set};
514 my $problem = $self->{problem}; 788 my $problem = $self->{problem};
515 my $editMode = $self->{editMode}; 789 my $editMode = $self->{editMode};
516 my $permissionLevel = $self->{permissionLevel};
517 my $submitAnswers = $self->{submitAnswers}; 790 my $submitAnswers = $self->{submitAnswers};
518 my $checkAnswers = $self->{checkAnswers}; 791 my $checkAnswers = $self->{checkAnswers};
519 my $previewAnswers = $self->{previewAnswers}; 792 my $previewAnswers = $self->{previewAnswers};
520 my %want = %{ $self->{want} }; 793 my %want = %{ $self->{want} };
521 my %can = %{ $self->{can} }; 794 my %can = %{ $self->{can} };
… …
523 my %will = %{ $self->{will} }; 796 my %will = %{ $self->{will} };
524 my $pg = $self->{pg}; 797 my $pg = $self->{pg};
525 798
526 my $courseName = $urlpath->arg("courseID"); 799 my $courseName = $urlpath->arg("courseID");
527 800
801 # FIXME: move editor link to top, next to problem number.
802 # format as "[edit]" like we're doing with course info file, etc.
803 # add edit link for set as well.
528 my $editorLink = ""; 804 my $editorLink = "";
529 # if we are here without a real problem set, carry that through 805 # if we are here without a real problem set, carry that through
530 my $forced_field = []; 806 my $forced_field = [];
531 $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if 807 $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if
532 ($set->set_id eq 'Undefined_Set'); 808 ($set->set_id eq 'Undefined_Set');
… …
536 my $editorURL = $self->systemLink($editorPage, params=>$forced_field); 812 my $editorURL = $self->systemLink($editorPage, params=>$forced_field);
537 $editorLink = CGI::a({href=>$editorURL}, "Edit this problem"); 813 $editorLink = CGI::a({href=>$editorURL}, "Edit this problem");
538 } 814 }
539 815
540 ##### translation errors? ##### 816 ##### translation errors? #####
541 817
542 if ($pg->{flags}->{error_flag}) { 818 if ($pg->{flags}->{error_flag}) {
543 print $self->errorOutput($pg->{errors}, $pg->{body_text}); 819 print $self->errorOutput($pg->{errors}, $pg->{body_text});
544 print $editorLink; 820 print $editorLink;
545 return ""; 821 return "";
546 } 822 }
… …
606 $pureProblem->last_answer."\t". 882 $pureProblem->last_answer."\t".
607 $pureProblem->num_correct."\t". 883 $pureProblem->num_correct."\t".
608 $pureProblem->num_incorrect 884 $pureProblem->num_incorrect
609 ); 885 );
610 } else { 886 } else {
611 if (time < $set->open_date or time > $set->due_date) { 887 if (before($set->open_date) or after($set->due_date)) {
612 $scoreRecordedMessage = "Your score was not recorded because this problem set is closed."; 888 $scoreRecordedMessage = "Your score was not recorded because this homework set is closed.";
613 } else { 889 } else {
614 $scoreRecordedMessage = "Your score was not recorded."; 890 $scoreRecordedMessage = "Your score was not recorded.";
615 } 891 }
616 } 892 }
617 } else { 893 } else {
618 $scoreRecordedMessage = "Your score was not recorded because this problem has not been built for you."; 894 $scoreRecordedMessage = "Your score was not recorded because this problem has not been assigned to you.";
619 } 895 }
620 } 896 }
621 897
622 # logging student answers 898 # logging student answers
623 899
624 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'}; 900 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'};
625 if ( defined($answer_log ) and defined($pureProblem)) { 901 if ( defined($answer_log ) and defined($pureProblem)) {
626 if ($submitAnswers ) { 902 if ($submitAnswers && !$authz->hasPermissions($effectiveUser, "dont_log_past_answers")) {
627 my $answerString = ""; 903 my $answerString = ""; my $scores = "";
628 my %answerHash = %{ $pg->{answers} }; 904 my %answerHash = %{ $pg->{answers} };
629 # FIXME this is the line 552 error. make sure original student ans is defined. 905 # FIXME this is the line 552 error. make sure original student ans is defined.
630 # The fact that it is not defined is probably due to an error in some answer evaluator. 906 # The fact that it is not defined is probably due to an error in some answer evaluator.
631 # But I think it is useful to suppress this error message in the log. 907 # But I think it is useful to suppress this error message in the log.
632 foreach (sort keys %answerHash) { 908 foreach (sort keys %answerHash) {
633 my $student_ans = $answerHash{$_}->{original_student_ans} ||''; 909 my $orig_ans = $answerHash{$_}->{original_student_ans};
910 my $student_ans = defined $orig_ans ? $orig_ans : '';
634 $answerString .= $student_ans."\t" 911 $answerString .= $student_ans."\t";
912 $scores .= $answerHash{$_}->{score} >= 1 ? "1" : "0";
635 } 913 }
636 $answerString = '' unless defined($answerString); # insure string is defined. 914 $answerString = '' unless defined($answerString); # insure string is defined.
637 writeCourseLog($self->{ce}, "answer_log", 915 writeCourseLog($self->{ce}, "answer_log",
638 join("", 916 join("",
639 '|', $problem->user_id, 917 '|', $problem->user_id,
640 '|', $problem->set_id, 918 '|', $problem->set_id,
641 '|', $problem->problem_id, 919 '|', $problem->problem_id,
642 '|',"\t", 920 '|', $scores, "\t",
643 time(),"\t", 921 time(),"\t",
644 $answerString, 922 $answerString,
645 ), 923 ),
646 ); 924 );
647 925
… …
649 } 927 }
650 928
651 $WeBWorK::timer->continue("end answer processing") if defined($WeBWorK::timer); 929 $WeBWorK::timer->continue("end answer processing") if defined($WeBWorK::timer);
652 930
653 ##### output ##### 931 ##### output #####
654
655 print CGI::start_div({class=>"problemHeader"});
656
657 # custom message for editor 932 # custom message for editor
658 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) { 933 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) {
659 if ($editMode eq "temporaryFile") { 934 if ($editMode eq "temporaryFile") {
660 print CGI::p(CGI::i("Editing temporary file: ", $problem->source_file)); 935 print CGI::p(CGI::div({class=>'temporaryFile'}, "Viewing temporary file: ", $problem->source_file));
661 } elsif ($editMode eq "savedFile") { 936 } elsif ($editMode eq "savedFile") {
662 # taken care of in the initialization phase 937 # taken care of in the initialization phase
663 } 938 }
664 } 939 }
940 print CGI::start_div({class=>"problemHeader"});
941
942
665 943
666 # attempt summary 944 # attempt summary
667 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything. 945 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything.
668 # until after the due date 946 # until after the due date
669 # do I need to check $will{showCorrectAnswers} to make preflight work?? 947 # do I need to check $will{showCorrectAnswers} to make preflight work??
670 if (($pg->{flags}->{showPartialCorrectAnswers}>= 0 and $submitAnswers) ) { 948 if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) {
671 # print this if user submitted answers OR requested correct answers 949 # print this if user submitted answers OR requested correct answers
672 950
673 print $self->attemptResults($pg, 1, 951 print $self->attemptResults($pg, 1,
674 $will{showCorrectAnswers}, 952 $will{showCorrectAnswers},
675 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1); 953 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1);
676 } elsif ($checkAnswers) { 954 } elsif ($checkAnswers) {
677 # print this if user previewed answers 955 # print this if user previewed answers
678 print CGI::div({class=>'ResultsWithError'},"ANSWERS ONLY CHECKED -- ",CGI::br(),"ANSWERS NOT RECORDED", CGI::br() ); 956 print CGI::div({class=>'ResultsWithError'},"ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED"), CGI::br();
679 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1); 957 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1);
680 # show attempt answers 958 # show attempt answers
681 # show correct answers if asked 959 # show correct answers if asked
682 # show attempt results (correctness) 960 # show attempt results (correctness)
683 # show attempt previews 961 # show attempt previews
684 } elsif ($previewAnswers) { 962 } elsif ($previewAnswers) {
685 # print this if user previewed answers 963 # print this if user previewed answers
686 print CGI::div({class=>'ResultsWithError'},"PREVIEW ONLY -- NOT RECORDED"),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1); 964 print CGI::div({class=>'ResultsWithError'},"PREVIEW ONLY -- ANSWERS NOT RECORDED"),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1);
687 # show attempt answers 965 # show attempt answers
688 # don't show correct answers 966 # don't show correct answers
689 # don't show attempt results (correctness) 967 # don't show attempt results (correctness)
690 # show attempt previews 968 # show attempt previews
691 } 969 }
692 970
693 print CGI::end_div(); 971 print CGI::end_div();
694 972
973 # main form
974 print CGI::startform("POST", $r->uri);
975 print $self->hidden_authen_fields;
976
695 print CGI::start_div({class=>"problem"}); 977 print CGI::start_div({class=>"problem"});
696
697 # main form
698 print
699 CGI::startform("POST", $r->uri),
700 $self->hidden_authen_fields,
701 CGI::p($pg->{body_text}), 978 print CGI::p($pg->{body_text});
702 CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})), 979 print CGI::p(CGI::b("Note: "), CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg};
703 CGI::p( 980 print CGI::end_div();
981
982 print CGI::start_p();
983
704 ($can{showCorrectAnswers} 984 if ($can{showCorrectAnswers}) {
705 ? CGI::checkbox( 985 print CGI::checkbox(
706 -name => "showCorrectAnswers", 986 -name => "showCorrectAnswers",
707 -checked => $will{showCorrectAnswers}, 987 -checked => $will{showCorrectAnswers},
708 -label => "Show correct answers", 988 -label => "Show correct answers",
709 ) ." "
710 : "" ),
711 ($can{showHints}
712 ? '<div style="color:red">'. CGI::checkbox(
713 -name => "showHints",
714 -checked => $will{showHints},
715 -label => "Show Hints",
716 ) . "</div> "
717 : " " ),
718 ($can{showSolutions}
719 ? CGI::checkbox(
720 -name => "showSolutions",
721 -checked => $will{showSolutions},
722 -label => "Show Solutions",
723 ) . " "
724 : " " ),CGI::br(),
725 CGI::submit(-name=>"previewAnswers",
726 -label=>"Preview Answers"),
727 ($can{recordAnswers}
728 ? CGI::submit(-name=>"submitAnswers",
729 -label=>"Submit Answers")
730 : ""),
731 ( $can{checkAnswers}
732 ? CGI::submit(-name=>"checkAnswers",
733 -label=>"Check Answers")
734 : ""),
735 ); 989 );
990 }
991 if ($can{showHints}) {
992 print CGI::div({style=>"color:red"},
993 CGI::checkbox(
994 -name => "showHints",
995 -checked => $will{showHints},
996 -label => "Show Hints",
997 )
998 );
999 }
1000 if ($can{showSolutions}) {
1001 print CGI::checkbox(
1002 -name => "showSolutions",
1003 -checked => $will{showSolutions},
1004 -label => "Show Solutions",
1005 );
1006 }
1007
1008 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) {
1009 print CGI::br();
1010 }
1011
1012 print CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers");
1013 if ($can{checkAnswers}) {
1014 print CGI::submit(-name=>"checkAnswers", -label=>"Check Answers");
1015 }
1016 if ($can{getSubmitButton}) {
1017 if ($user ne $effectiveUser) {
1018 # if acting as a student, make it clear that answer submissions will
1019 # apply to the student's records, not the professor's.
1020 print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers for $effectiveUser");
1021 } else {
1022 print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers");
1023 }
1024 }
1025
736 print CGI::end_div(); 1026 print CGI::end_p();
737 1027
738 print CGI::start_div({class=>"scoreSummary"}); 1028 print CGI::start_div({class=>"scoreSummary"});
739 1029
740 # score summary 1030 # score summary
741 my $attempts = $problem->num_correct + $problem->num_incorrect; 1031 my $attempts = $problem->num_correct + $problem->num_incorrect;
742 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 1032 my $attemptsNoun = $attempts != 1 ? "times" : "time";
1033 my $problem_status = $problem->status || 0;
743 my $lastScore = sprintf("%.0f%%", $problem->status * 100); # Round to whole number 1034 my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number
744 my ($attemptsLeft, $attemptsLeftNoun); 1035 my ($attemptsLeft, $attemptsLeftNoun);
745 if ($problem->max_attempts == -1) { 1036 if ($problem->max_attempts == -1) {
746 # unlimited attempts 1037 # unlimited attempts
747 $attemptsLeft = "unlimited"; 1038 $attemptsLeft = "unlimited";
748 $attemptsLeftNoun = "attempts"; 1039 $attemptsLeftNoun = "attempts";
… …
751 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 1042 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
752 } 1043 }
753 1044
754 my $setClosed = 0; 1045 my $setClosed = 0;
755 my $setClosedMessage; 1046 my $setClosedMessage;
756 if (time < $set->open_date or time > $set->due_date) { 1047 if (before($set->open_date) or after($set->due_date)) {
757 $setClosed = 1; 1048 $setClosed = 1;
1049 if (before($set->open_date)) {
1050 $setClosedMessage = "This homework set is not yet open.";
1051 } elsif (after($set->due_date)) {
758 $setClosedMessage = "This problem set is closed."; 1052 $setClosedMessage = "This homework set is closed.";
1053 }
1054 }
1055 #if (before($set->open_date) or after($set->due_date)) {
1056 # $setClosed = 1;
1057 # $setClosedMessage = "This homework set is closed.";
759 if ($authz->hasPermissions($user, "view_answers")) { 1058 # if ($authz->hasPermissions($user, "view_answers")) {
760 $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded."; 1059 # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded.";
761 } else { 1060 # } else {
762 $setClosedMessage .= " Additional attempts will not be recorded."; 1061 # $setClosedMessage .= " Additional attempts will not be recorded.";
763 } 1062 # }
764 } 1063 #}
765 1064 unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) {
766 my $notCountedMessage = ($problem->value) ? "" : "(This problem will not count towards your grade.)"; 1065 my $notCountedMessage = ($problem->value) ? "" : "(This problem will not count towards your grade.)";
767 print CGI::p( 1066 print CGI::p(
768 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "", 1067 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "",
769 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(), 1068 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
1069 $submitAnswers ?"You received a score of ".sprintf("%.0f%%", $pg->{result}->{score} * 100)." for this attempt.".CGI::br():'',
770 $problem->attempted 1070 $problem->attempted
771 ? "Your recorded score is $lastScore. $notCountedMessage" . CGI::br() 1071 ? "Your overall recorded score is $lastScore. $notCountedMessage" . CGI::br()
772 : "", 1072 : "",
773 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining." 1073 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
774 ); 1074 );
1075 }else {
1076 print CGI::p($pg->{state}->{state_summary_msg});
1077 }
775 print CGI::end_div(); 1078 print CGI::end_div();
776 1079
777 # save state for viewOptions 1080 # save state for viewOptions
778 print CGI::hidden( 1081 print CGI::hidden(
779 -name => "showOldAnswers", 1082 -name => "showOldAnswers",
… …
876 } 1179 }
877 1180
878 return ""; 1181 return "";
879} 1182}
880 1183
881##### output utilities #####
882
883sub attemptResults {
884 my $self = shift;
885 my $pg = shift;
886 my $showAttemptAnswers = shift;
887 my $showCorrectAnswers = shift;
888 my $showAttemptResults = $showAttemptAnswers && shift;
889 my $showSummary = shift;
890 my $showAttemptPreview = shift || 0;
891
892 my $ce = $self->r->ce;
893
894 my $problemResult = $pg->{result}; # the overall result of the problem
895 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
896
897 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
898
899 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview";
900
901 # to make grabbing these options easier, we'll pull them out now...
902 my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}};
903
904 my $imgGen = WeBWorK::PG::ImageGenerator->new(
905 tempDir => $ce->{webworkDirs}->{tmp},
906 latex => $ce->{externalPrograms}->{latex},
907 dvipng => $ce->{externalPrograms}->{dvipng},
908 useCache => 1,
909 cacheDir => $ce->{webworkDirs}->{equationCache},
910 cacheURL => $ce->{webworkURLs}->{equationCache},
911 cacheDB => $ce->{webworkFiles}->{equationCacheDB},
912 dvipng_align => $imagesModeOptions{dvipng_align},
913 dvipng_depth_db => $imagesModeOptions{dvipng_depth_db},
914 );
915
916 my $header;
917 #$header .= CGI::th("Part");
918 $header .= $showAttemptAnswers ? CGI::th("Entered") : "";
919 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : "";
920 $header .= $showCorrectAnswers ? CGI::th("Correct") : "";
921 $header .= $showAttemptResults ? CGI::th("Result") : "";
922 $header .= $showMessages ? CGI::th("Messages") : "";
923 my @tableRows = ( $header );
924 my $numCorrect = 0;
925 foreach my $name (@answerNames) {
926 my $answerResult = $pg->{answers}->{$name};
927 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
928 my $preview = ($showAttemptPreview
929 ? $self->previewAnswer($answerResult, $imgGen)
930 : "");
931 my $correctAnswer = $answerResult->{correct_ans};
932 my $answerScore = $answerResult->{score};
933 my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
934 #FIXME --Can we be sure that $answerScore is an integer-- could the problem give partial credit?
935 $numCorrect += $answerScore > 0;
936 my $resultString = $answerScore == 1 ? "correct" : "incorrect";
937
938 # get rid of the goofy prefix on the answer names (supposedly, the format
939 # of the answer names is changeable. this only fixes it for "AnSwEr"
940 #$name =~ s/^AnSwEr//;
941
942 my $row;
943 #$row .= CGI::td($name);
944 $row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : "";
945 $row .= $showAttemptPreview ? CGI::td($self->nbsp($preview)) : "";
946 $row .= $showCorrectAnswers ? CGI::td($self->nbsp($correctAnswer)) : "";
947 $row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : "";
948 $row .= $showMessages ? CGI::td($self->nbsp($answerMessage)) : "";
949 push @tableRows, $row;
950 }
951
952 # render equation images
953 $imgGen->render(refresh => 1);
954
955# my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
956 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100);
957# FIXME -- I left the old code in in case we have to back out.
958# my $summary = "On this attempt, you answered $numCorrect out of "
959# . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
960 my $summary = "";
961 if (scalar @answerNames == 1) {
962 if ($numCorrect == scalar @answerNames) {
963 $summary .= CGI::div({class=>"ResultsWithoutError"},"The above answer is correct.");
964 } else {
965 $summary .= CGI::div({class=>"ResultsWithError"},"The above answer is NOT correct.");
966 }
967 } else {
968 if ($numCorrect == scalar @answerNames) {
969 $summary .= CGI::div({class=>"ResultsWithoutError"},"All of the above answers are correct.");
970 } else {
971 $summary .= CGI::div({class=>"ResultsWithError"},"At least one of the above answers is NOT correct.");
972 }
973 }
974
975 return
976 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows))
977 . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
978}
979
980#sub nbsp {
981# my $str = shift;
982# ($str =~/\S/) ? $str : '&nbsp;' ; # returns non-breaking space for empty strings
983# # tricky cases: $str =0;
984# # $str is a complex number
985#}
986
987sub viewOptions {
988 my ($self) = @_;
989 my $ce = $self->r->ce;
990
991 # don't show options if we don't have anything to show
992 return if $self->{invalidSet} or $self->{invalidProblem};
993 return unless $self->{isOpen};
994
995 my $displayMode = $self->{displayMode};
996 my %must = %{ $self->{must} };
997 my %can = %{ $self->{can} };
998 my %will = %{ $self->{will} };
999
1000 my $optionLine;
1001 $can{showOldAnswers} and $optionLine .= join "",
1002 "Show: &nbsp;".CGI::br(),
1003 CGI::checkbox(
1004 -name => "showOldAnswers",
1005 -checked => $will{showOldAnswers},
1006 -label => "Saved answers",
1007 ), "&nbsp;&nbsp;".CGI::br();
1008
1009 $optionLine and $optionLine .= join "", CGI::br();
1010
1011 my %display_modes = %{WeBWorK::PG::DISPLAY_MODES()};
1012 my @active_modes = grep { exists $display_modes{$_} }
1013 @{$ce->{pg}->{displayModes}};
1014 my $modeLine = (scalar(@active_modes)>1) ?
1015 "View&nbsp;equations&nbsp;as:&nbsp;&nbsp;&nbsp;&nbsp;".CGI::br().
1016 CGI::radio_group(
1017 -name => "displayMode",
1018 -values => \@active_modes,
1019 -default => $displayMode,
1020 -linebreak=>'true',
1021 -labels => {
1022 plainText => "plain",
1023 formattedText => "formatted",
1024 images => "images",
1025 jsMath => "jsMath",
1026 asciimath => "asciimath",
1027 },
1028 ). CGI::br().CGI::hr() : '';
1029
1030 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"},
1031 $modeLine,
1032 $optionLine,
1033 CGI::submit(-name=>"redisplay", -label=>"Apply Options"),
1034 );
1035}
1036
1037sub previewAnswer {
1038 my ($self, $answerResult, $imgGen) = @_;
1039 my $ce = $self->r->ce;
1040 my $effectiveUser = $self->{effectiveUser};
1041 my $set = $self->{set};
1042 my $problem = $self->{problem};
1043 my $displayMode = $self->{displayMode};
1044
1045 # note: right now, we have to do things completely differently when we are
1046 # rendering math from INSIDE the translator and from OUTSIDE the translator.
1047 # so we'll just deal with each case explicitly here. there's some code
1048 # duplication that can be dealt with later by abstracting out tth/dvipng/etc.
1049
1050 my $tex = $answerResult->{preview_latex_string};
1051
1052 return "" unless defined $tex and $tex ne "";
1053
1054 if ($displayMode eq "plainText") {
1055 return $tex;
1056 } elsif ($displayMode eq "formattedText") {
1057 my $tthCommand = $ce->{externalPrograms}->{tth}
1058 . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
1059 . "\\(".$tex."\\)\n"
1060 . "END_OF_INPUT\n";
1061
1062 # call tth
1063 my $result = `$tthCommand`;
1064 if ($?) {
1065 return "<b>[tth failed: $? $@]</b>";
1066 }
1067 return $result;
1068 } elsif ($displayMode eq "images") {
1069 $imgGen->add($tex);
1070 } elsif ($displayMode eq "jsMath") {
1071
1072 return '<DIV CLASS="math">'.$tex.'</DIV>' ;
1073
1074
1075
1076
1077 }
1078}
1079
1080##### permission queries #####
1081
1082# this stuff should be abstracted out into the permissions system
1083# however, the permission system only knows about things in the
1084# course environment and the username. hmmm...
1085
1086# also, i should fix these so that they have a consistent calling
1087# format -- perhaps:
1088# canPERM($ce, $user, $set, $problem, $permissionLevel)
1089
1090sub canShowCorrectAnswers($$) {
1091 my ($permissionLevel, $answerDate) = @_;
1092 return $permissionLevel > 0 || time > $answerDate;
1093}
1094
1095sub canShowSolutions($$) {
1096 my ($permissionLevel, $answerDate) = @_;
1097 return canShowCorrectAnswers($permissionLevel, $answerDate);
1098}
1099
1100sub canRecordAnswers($$$$$) {
1101 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
1102 my $permHigh = $permissionLevel > 0;
1103 my $timeOK = time >= $openDate && time <= $dueDate;
1104 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
1105 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK);
1106 return $recordAnswers;
1107}
1108
1109sub canCheckAnswers($$) {
1110 my ($permissionLevel, $dueDate) = @_;
1111 my $permHigh = $permissionLevel > 0;
1112 my $timeOK = time >= $dueDate;
1113 my $recordAnswers = $permHigh || $timeOK;
1114 return $recordAnswers;
1115}
1116
1117sub mustRecordAnswers($) {
1118 my ($permissionLevel) = @_;
1119 return $permissionLevel == 0;
1120}
11211; 11841;
Legend:
Removed from v.2444  
changed lines
  Added in v.3391
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9