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

Diff of /trunk/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm

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

Revision 435 Revision 939
1################################################################################
2# WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
3# $Id$
4################################################################################
5
1package WeBWorK::ContentGenerator::Problem; 6package WeBWorK::ContentGenerator::Problem;
2use base qw(WeBWorK::ContentGenerator); 7use base qw(WeBWorK::ContentGenerator);
3 8
9=head1 NAME
10
11WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem.
12
13=cut
14
4use strict; 15use strict;
5use warnings; 16use warnings;
6use CGI qw(:html :form); 17use CGI qw();
7use WeBWorK::Utils qw(ref2string encodeAnswers decodeAnswers); 18use File::Path qw(rmtree);
19use File::Temp qw(tempdir);
20use WeBWorK::Form;
8use WeBWorK::PG; 21use WeBWorK::PG;
9use WeBWorK::Form; 22use WeBWorK::PG::IO;
23use WeBWorK::Utils qw(writeLog encodeAnswers decodeAnswers ref2string);
10 24
25############################################################
26#
11# user 27# user
28# effectiveUser
12# key 29# key
13# 30#
14# displayMode 31# displayMode
15# showOldAnswers 32# showOldAnswers
16# showCorrectAnswers 33# showCorrectAnswers
… …
19# 36#
20# AnSwEr# - answer blanks in problem 37# AnSwEr# - answer blanks in problem
21# 38#
22# redisplay - name of the "Redisplay Problem" button 39# redisplay - name of the "Redisplay Problem" button
23# submitAnswers - name of "Submit Answers" button 40# submitAnswers - name of "Submit Answers" button
41# checkAnswers - name of the "Check Answers" button
42# previewAnswers - name of the "Preview Answers" button
43#
44############################################################
24 45
25sub title { 46sub pre_header_initialize {
26 my ($self, $setName, $problemNumber) = @_; 47 my ($self, $setName, $problemNumber) = @_;
27 my $userName = $self->{r}->param('user');
28 return "Problem $problemNumber of problem set $setName for $userName";
29}
30
31# TODO:
32# :) enforce permissions for showCorrectAnswers and showSolutions
33# (use $PRIV = $mustPRIV || ($canPRIV && $wantPRIV) -- cool syntax!)
34# :) if answers were not submitted and there are student answers in the DB,
35# decode them and put them into $formFields for the translator
36# :) store submitted answers hash in database for sticky answers
37# :) deal with the results of answer evaluation and grading :p
38# :) introduce a recordAnswers option, which works on the same principle as
39# the other permission-based options
40# 7. make warnings work
41
42sub body {
43 my ($self, $setName, $problemNumber) = @_;
44 my $courseEnv = $self->{courseEnvironment};
45 my $r = $self->{r}; 48 my $r = $self->{r};
49 my $courseEnv = $self->{ce};
50 my $db = $self->{db};
46 my $userName = $r->param('user'); 51 my $userName = $r->param('user');
52 my $effectiveUserName = $r->param('effectiveUser');
47 53
48 # fix format of setName and problem
49 $setName =~ s/^set//;
50 $problemNumber =~ s/^prob//;
51
52 ##### database setup #####
53 # this should probably go in initialize() or whatever it's called
54
55 my $classlist = WeBWorK::DB::Classlist->new($courseEnv);
56 my $wwdb = WeBWorK::DB::WW->new($courseEnv);
57 my $authdb = WeBWorK::DB::Auth->new($courseEnv);
58
59 my $user = $classlist->getUser($userName); 54 my $user = $db->getUser($userName);
60 my $set = $wwdb->getSet($userName, $setName); 55 my $effectiveUser = $db->getUser($effectiveUserName);
56 my $set = $db->getGlobalUserSet($effectiveUserName, $setName);
61 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 57 my $problem = $db->getGlobalUserProblem($effectiveUserName, $setName, $problemNumber);
58 my $psvn = $set->psvn();
62 my $permissionLevel = $authdb->getPermissions($userName); 59 my $permissionLevel = $db->getPermissionLevel($userName)->permission();
60
61 $self->{userName} = $userName;
62 $self->{user} = $user;
63 $self->{effectiveUser} = $effectiveUser;
64 $self->{set} = $set;
65 $self->{problem} = $problem;
66 $self->{permissionLevel} = $permissionLevel;
63 67
64 ##### form processing ##### 68 ##### form processing #####
65 69
66 # set options from form fields (see comment at top of file for names) 70 # set options from form fields (see comment at top of file for names)
67 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 71 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
68 my $redisplay = $r->param("redisplay"); 72 my $redisplay = $r->param("redisplay");
69 my $submitAnswers = $r->param("submitAnswers"); 73 my $submitAnswers = $r->param("submitAnswers");
74 my $checkAnswers = $r->param("checkAnswers");
75 my $previewAnswers = $r->param("previewAnswers");
70 76
77 # fields which may be defined when using Problem Editor
78 my $override_seed = ($permissionLevel>=10) ? $r->param('problemSeed') : undef;
79 my $override_problem_source = ($permissionLevel>=10) ? $r->param('sourceFilePath') : undef;
80 my $editMode = undef;
81 my $submit_button = $r->param('submit_button');
82 if ( defined($submit_button ) ) {
83 $editMode = "temporaryFile" if $submit_button eq 'Refresh';
84 $editMode = 'savedFile' if $submit_button eq 'Save';
85 }
86 # coerce form fields into CGI::Vars format
87 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
88
89 $self->{displayMode} = $displayMode;
90 $self->{redisplay} = $redisplay;
91 $self->{submitAnswers} = $submitAnswers;
92 $self->{checkAnswers} = $checkAnswers;
93 $self->{previewAnswers} = $previewAnswers;
94 $self->{formFields} = $formFields;
95
96 $self->{current_problem_source} = (defined($override_problem_source) ) ?
97 $override_problem_source :
98 $problem->source_file;
99 $self->{edit_mode} = $editMode;
100 ##### permissions #####
101
102 # are we allowed to view this problem?
103 $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0;
104 return unless $self->{isOpen};
105
106 # what does the user want to do?
71 my %want = ( 107 my %want = (
72 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers}, 108 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
73 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers}, 109 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
74 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints}, 110 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
75 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions}, 111 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
76 recordAnswers => $r->param("recordAnswers") || 1, 112 recordAnswers => $submitAnswers,
113 checkAnswers => $checkAnswers,
77 ); 114 );
78
79 # coerce form fields into CGI::Vars format
80 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
81
82 ##### permissions #####
83 115
84 # are certain options enforced? 116 # are certain options enforced?
85 my %must = ( 117 my %must = (
86 showOldAnswers => 0, 118 showOldAnswers => 0,
87 showCorrectAnswers => 0, 119 showCorrectAnswers => 0,
88 showHints => 0, 120 showHints => 0,
89 showSolutions => 0, 121 showSolutions => 0,
90 recordAnswers => mustRecordAnswers($permissionLevel), 122 recordAnswers => mustRecordAnswers($permissionLevel),
123 checkAnswers => 0,
91 ); 124 );
92 125
93 # does the user have permission to use certain options? 126 # does the user have permission to use certain options?
94 my %can = ( 127 my %can = (
95 showOldAnswers => 1, 128 showOldAnswers => 1,
96 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date), 129 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),
97 showHints => 1, 130 showHints => 1,
98 showSolutions => canShowSolutions($permissionLevel, $set->answer_date), 131 showSolutions => canShowSolutions($permissionLevel, $set->answer_date),
99 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date, 132 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
100 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1), 133 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
101 # num_correct+num_incorrect+1 -- as this happens before updating $problem 134 # attempts=num_correct+num_incorrect+1, as this happens before updating $problem
135 checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date),
102 ); 136 );
103 137
104 # final values for options 138 # final values for options
105 my %will; 139 my %will;
106 foreach(keys %must) { 140 foreach (keys %must) {
107 $will{$_} = $can{$_} && ($want{$_} || $must{$_}); 141 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
108 } 142 }
109 143
110 ##### sticky answers ##### 144 ##### sticky answers #####
111 145
… …
117 151
118 ##### translation ##### 152 ##### translation #####
119 153
120 my $pg = WeBWorK::PG->new( 154 my $pg = WeBWorK::PG->new(
121 $courseEnv, 155 $courseEnv,
122 $r->param('user'), 156 $effectiveUser,
123 $r->param('key'), 157 $r->param('key'),
124 $setName, 158 $set,
125 $problemNumber, 159 $problem,
160 $psvn,
161 $formFields,
126 { # translation options 162 { # translation options
127 displayMode => $displayMode, 163 displayMode => $displayMode,
164 override_seed => $override_seed,
165 override_problem_source =>$override_problem_source,
128 showHints => $will{showHints}, 166 showHints => $will{showHints},
129 showSolutions => $will{showSolutions}, 167 showSolutions => $will{showSolutions},
130 refreshMath2img => $will{showHints} || $will{showSolutions}, 168 refreshMath2img => $will{showHints} || $will{showSolutions},
131 # try leaving processAnswers on all the time? 169 processAnswers => 1,
132 processAnswers => 1, #$submitAnswers ? 1 : 0,
133 }, 170 },
134 $formFields
135 ); 171 );
136 172
137 # handle any errors in translation 173 ##### fix hint/solution options #####
174
175 $can{showHints} &&= $pg->{flags}->{hintExists};
176 $can{showSolutions} &&= $pg->{flags}->{solutionExists};
177
178 ##### store fields #####
179
180 $self->{want} = \%want;
181 $self->{must} = \%must;
182 $self->{can} = \%can;
183 $self->{will} = \%will;
184
185 $self->{pg} = $pg;
186}
187
188sub if_warnings($$) {
189 my ($self, $arg) = @_;
190 return 0 unless $self->{isOpen};
191 return $self->{pg}->{warnings} ne "";
192}
193
194sub if_errors($$) {
195 my ($self, $arg) = @_;
196 return 0 unless $self->{isOpen};
197 return $self->{pg}->{flags}->{error_flag};
198}
199
200sub head {
201 my $self = shift;
202 return "" unless $self->{isOpen};
203 return $self->{pg}->{head_text} if $self->{pg}->{head_text};
204}
205
206sub path {
207 my $self = shift;
208 my $args = $_[-1];
209 my $setName = $self->{set}->set_id;
210 my $problemNumber = $self->{problem}->problem_id;
211
212 my $ce = $self->{ce};
213 my $root = $ce->{webworkURLs}->{root};
214 my $courseName = $ce->{courseName};
215 return $self->pathMacro($args,
216 "Home" => "$root",
217 $courseName => "$root/$courseName",
218 $setName => "$root/$courseName/$setName",
219 "Problem $problemNumber" => "",
220 );
221}
222
223sub siblings {
224 my $self = shift;
225 my $setName = $self->{set}->set_id;
226 my $problemNumber = $self->{problem}->problem_id;
227
228 my $ce = $self->{ce};
229 my $db = $self->{db};
230 my $root = $ce->{webworkURLs}->{root};
231 my $courseName = $ce->{courseName};
232
233 print CGI::strong("Problems"), CGI::br();
234
235 my $effectiveUser = $self->{r}->param("effectiveUser");
236 my @problems;
237 push @problems, $db->getGlobalUserProblem($effectiveUser, $setName, $_)
238 foreach ($db->listUserProblems($effectiveUser, $setName));
239 foreach my $problem (sort { $a->problem_id <=> $b->problem_id } @problems) {
240 print CGI::a({-href=>"$root/$courseName/$setName/".$problem->problem_id."/?"
241 . $self->url_authen_args . "&displayMode=" . $self->{displayMode}},
242 "Problem ".$problem->problem_id), CGI::br();
243 }
244}
245
246sub nav {
247 my $self = shift;
248 my $args = $_[-1];
249 my $setName = $self->{set}->set_id;
250 my $problemNumber = $self->{problem}->problem_id;
251
252 my $ce = $self->{ce};
253 my $db = $self->{db};
254 my $root = $ce->{webworkURLs}->{root};
255 my $courseName = $ce->{courseName};
256
257 my $wwdb = $self->{wwdb};
258 my $effectiveUser = $self->{r}->param("effectiveUser");
259 my $tail = "&displayMode=".$self->{displayMode};
260
261 my @links = ("Problem List" , "$root/$courseName/$setName", "navProbList");
262
263 my $prevProblem = $db->getGlobalUserProblem($effectiveUser, $setName, $problemNumber-1);
264 my $nextProblem = $db->getGlobalUserProblem($effectiveUser, $setName, $problemNumber+1);
265 unshift @links, "Previous Problem" , ($prevProblem
266 ? "$root/$courseName/$setName/".$prevProblem->problem_id
267 : "") , "navPrev";
268 push @links, "Next Problem" , ($nextProblem
269 ? "$root/$courseName/$setName/".$nextProblem->problem_id
270 : "") , "navNext";
271
272 return $self->navMacro($args, $tail, @links);
273}
274
275sub title {
276 my $self = shift;
277 my $setName = $self->{set}->set_id;
278
279 my $file_action;
280 my $edit_mode = $self->{edit_mode};
281 if ( not defined($edit_mode) ) {
282 $file_action = '';
283 } elsif ( $edit_mode eq 'temporaryFile') {
284 $file_action .= 'Editing temporary file : '. CGI::br() . $self->{current_problem_source};
285 } elsif ( $edit_mode eq 'savedFile' ){
286 $file_action .= 'Problem saved to : '. CGI::br() . $self->{current_problem_source};
287 }
288 my $problemNumber = $self->{problem}->problem_id . " : " . $file_action;
289
290 return "$setName : Problem $problemNumber";
291}
292
293sub body {
294 my $self = shift;
295
296 return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open."))
297 unless $self->{isOpen};
298
299 # unpack some useful variables
300 my $r = $self->{r};
301 my $db = $self->{db};
302 my $set = $self->{set};
303 my $problem = $self->{problem};
304 my $permissionLevel = $self->{permissionLevel};
305 my $submitAnswers = $self->{submitAnswers};
306 my $checkAnswers = $self->{checkAnswers};
307 my $previewAnswers = $self->{previewAnswers};
308 my %want = %{ $self->{want} };
309 my %can = %{ $self->{can} };
310 my %must = %{ $self->{must} };
311 my %will = %{ $self->{will} };
312 my $pg = $self->{pg};
313
314 ##### translation errors? #####
315
138 if ($pg->{flags}->{error_flag}) { 316 if ($pg->{flags}->{error_flag}) {
139 # there was an error in translation
140 print
141 h2("Software Error"),
142 translationError($pg->{errors}, $pg->{body_text}); 317 return $self->errorOutput($pg->{errors}, $pg->{body_text});
143
144 return "";
145 } 318 }
146 319
147 ##### answer processing ##### 320 ##### answer processing #####
148 321
149 # if answers were submitted: 322 # if answers were submitted:
150 if ($submitAnswers) { 323 if ($submitAnswers) {
324 # get a "pure" (unmerged) UserProblem to modify
325 my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id);
151 # store answers in DB for sticky answers 326 # store answers in DB for sticky answers
152 my %answersToStore; 327 my %answersToStore;
153 my %answerHash = %{ $pg->{answers} }; 328 my %answerHash = %{ $pg->{answers} };
154 $answersToStore{$_} = $answerHash{$_}->{original_student_ans} 329 $answersToStore{$_} = $answerHash{$_}->{original_student_ans}
155 foreach (keys %answerHash); 330 foreach (keys %answerHash);
156 my $answerString = encodeAnswers(%answersToStore, 331 my $answerString = encodeAnswers(%answersToStore,
157 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }); 332 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
333 $pureProblem->last_answer($answerString);
158 $problem->last_answer($answerString); 334 $problem->last_answer($answerString);
159 $wwdb->setProblem($problem); 335 $db->putUserProblem($pureProblem);
160 336
161 # store score in DB if it makes sense 337 # store state in DB if it makes sense
162 if ($will{recordAnswers}) { 338 if ($will{recordAnswers}) {
163 # the grader makes a lot of decisions for us... 339 $problem->status($pg->{state}->{recorded_score});
164 # all we have to do is update information from
165 # the 'state' hash in the $pg hash.
166 $problem->attempted(1); 340 $problem->attempted(1);
167 $problem->status($pg->{state}->{recorded_score});
168 $problem->num_correct($pg->{state}->{num_of_correct_ans}); 341 $problem->num_correct($pg->{state}->{num_of_correct_ans});
169 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans}); 342 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
170 #warn "Would have stored the following:\n", 343 $pureProblem->status($pg->{state}->{recorded_score});
171 # $problem->toString, "\n"; 344 $pureProblem->attempted(1);
345 $pureProblem->num_correct($pg->{state}->{num_of_correct_ans});
346 $pureProblem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
172 $wwdb->setProblem($problem); 347 $db->putUserProblem($pureProblem);
173 } else { 348 # write to the transaction log, just to make sure
174 print p("Your score was not recorded for some reason. ;)"); 349 writeLog($self->{ce}, "transaction",
350 $problem->problem_id."\t".
351 $problem->set_id."\t".
352 $problem->user_id."\t".
353 $problem->source_file."\t".
354 $problem->value."\t".
355 $problem->max_attempts."\t".
356 $problem->problem_seed."\t".
357 $pureProblem->status."\t".
358 $pureProblem->attempted."\t".
359 $pureProblem->last_answer."\t".
360 $pureProblem->num_correct."\t".
361 $pureProblem->num_incorrect
362 );
175 } 363 }
176 } 364 }
365 # logging student answers
366 my $pastAnswerLog = undef;
367 if (defined( $self->{ce}->{webworkFiles}->{logs}->{'pastAnswerList'} )) {
368
369 $pastAnswerLog = $self->{ce}->{webworkFiles}->{logs}->{'pastAnswerList'};
370
371 if ($submitAnswers and defined($pastAnswerLog) ) {
372 my $answerString = "";
373 my %answerHash = %{ $pg->{answers} };
374 $answerString = $answerString . $answerHash{$_}->{original_student_ans}."\t"
375 foreach (sort keys %answerHash);
376 writeLog($self->{ce}, "pastAnswerList",
377 '|'.$problem->user_id.
378 '|'.$problem->set_id.
379 '|'.$problem->problem_id.'|'."\t".
380 time()."\t".
381 $answerString,
382
383 );
384
385 }
386
387 }
388 # end logging student answers
177 389
178 ##### output ##### 390 ##### output #####
179 391 print CGI::start_div({class=>"problemHeader"});
180 # attempt summary 392 # attempt summary
181 if ($submitAnswers or $will{showCorrectAnswers}) { 393 if ($submitAnswers or $will{showCorrectAnswers}) {
182 # print this if user submitted answers OR requested correct answers 394 # print this if user submitted answers OR requested correct answers
183 print attemptResults($pg, $submitAnswers, $will{showCorrectAnswers}, 395 print $self->attemptResults($pg, $submitAnswers,
396 $will{showCorrectAnswers},
184 $pg->{flags}->{showPartialCorrectAnswers}); 397 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1);
398 } elsif ($checkAnswers) {
399 # print this if user previewed answers
400 print $self->attemptResults($pg, 1, 0, 1, 1, 1);
401 # show attempt answers
402 # don't show correct answers
403 # show attempt results (correctness)
404 # don't show attempt previews
405 } elsif ($previewAnswers) {
406 # print this if user previewed answers
407 print $self->attemptResults($pg, 1, 0, 0, 0, 1);
408 # show attempt answers
409 # don't show correct answers
410 # don't show attempt results (correctness)
411 # show attempt previews
185 } 412 }
186 413
414 print CGI::end_div();
415
416 print CGI::start_div({class=>"problem"});
417 #print CGI::hr();
418 # main form
419 print
420 CGI::startform("POST", $r->uri),
421 $self->hidden_authen_fields,
422 CGI::p($pg->{body_text}),
423 CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})),
424 CGI::p(
425 ($can{recordAnswers}
426 ? CGI::submit(-name=>"submitAnswers",
427 -label=>"Submit Answers")
428 : ""),
429 ($can{checkAnswers}
430 ? CGI::submit(-name=>"checkAnswers",
431 -label=>"Check Answers")
432 : ""),
433 CGI::submit(-name=>"previewAnswers",
434 -label=>"Preview Answers"),
435 );
436 print CGI::end_div();
437
438 print CGI::start_div({class=>"scoreSummary"});
187 # score summary 439 # score summary
188 my $attempts = $problem->num_correct + $problem->num_incorrect; 440 my $attempts = $problem->num_correct + $problem->num_incorrect;
189 my $attemptsNoun = $attempts != 1 ? "times" : "time"; 441 my $attemptsNoun = $attempts != 1 ? "times" : "time";
190 my $lastScore = int ($problem->status * 100) . "%"; 442 my $lastScore = int ($problem->status * 100) . "%";
191 my ($attemptsLeft, $attemptsLeftNoun); 443 my ($attemptsLeft, $attemptsLeftNoun);
… …
195 $attemptsLeftNoun = "attempts"; 447 $attemptsLeftNoun = "attempts";
196 } else { 448 } else {
197 $attemptsLeft = $problem->max_attempts - $attempts; 449 $attemptsLeft = $problem->max_attempts - $attempts;
198 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts"; 450 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
199 } 451 }
452
453 my $setClosed = 0;
454 my $setClosedMessage;
455 if (time < $set->open_date or time > $set->due_date) {
456 $setClosed = 1;
457 $setClosedMessage = "This problem set is closed.";
458 if ($permissionLevel > 0) {
459 $setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded.";
460 } else {
461 $setClosedMessage .= " Additional attempts will not be recorded.";
462 }
463 }
200 print p( 464 print CGI::p(
201 "You have attempted this problem $attempts $attemptsNoun.", br(), 465 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
202 $problem->attempted 466 $problem->attempted
203 ? "Your recorded score is $lastScore." . br() 467 ? "Your recorded score is $lastScore." . CGI::br()
204 : "", 468 : "",
205 "You have $attemptsLeft $attemptsLeftNoun remaining." 469 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
206 ); 470 );
207 471 print CGI::end_div();
208 # BY THE WAY.......... 472 print CGI::hr(), CGI::start_div({class=>"viewOptions"});
209 # we have to figure out some way to tell the student if their NEW answer,
210 # on THIS attempt, has been recorded. however, this is decided in part by
211 # the grader, so is there any way for us to know? we can rule out several
212 # cases where the answer is NOT being recorded, because of things decided
213 # in &canRecordAnswers...
214
215 print hr();
216
217 # main form
218 print 473 print
219 startform("POST", $r->uri), 474 $self->viewOptions(),CGI::end_div(),
475 CGI::endform();
476
477 print CGI::start_div({class=>"problemFooter"});
478 # feedback form
479 my $ce = $self->{ce};
480 my $root = $ce->{webworkURLs}->{root};
481 my $courseName = $ce->{courseName};
482 my $feedbackURL = "$root/$courseName/feedback/";
483
484 # arguments for answer inspection button
485 my $prof_url = $ce->{webworkURLs}->{oldProf};
486 my $cgi_url = $prof_url;
487 $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl
488 my $authen_args = $self->url_authen_args();
489 my $showPastAnswersURL = "$cgi_url/showPastAnswers.pl";
490
491 #print feedback form
492 print
493 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n",
220 $self->hidden_authen_fields, 494 $self->hidden_authen_fields,"\n",
221 p(i($pg->{result}->{msg})), 495 CGI::hidden("module", __PACKAGE__),"\n",
222 p($pg->{body_text}), 496 CGI::hidden("set", $set->set_id),"\n",
223 p(submit(-name=>"submitAnswers", -label=>"Submit Answers")), 497 CGI::hidden("problem", $problem->problem_id),"\n",
224 viewOptions($displayMode, \%must, \%can, \%will), 498 CGI::hidden("displayMode", $self->{displayMode}),"\n",
499 CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n",
500 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n",
501 CGI::hidden("showHints", $will{showHints}),"\n",
502 CGI::hidden("showSolutions", $will{showSolutions}),"\n",
503 CGI::p({-align=>"right"},
504 CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback")
505 ),
506 CGI::endform(),"\n";
507 # print answer inspection button
508 if ($self->{permissionLevel} >0) {
509
510
511 print "\n",
512 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n",
513 $self->hidden_authen_fields,"\n",
514 CGI::hidden(-name => 'course', -value=>$courseName), "\n",
515 CGI::hidden(-name => 'probNum', -value=>$problem->problem_id), "\n",
516 CGI::hidden(-name => 'setNum', -value=>$problem->set_id), "\n",
517 CGI::hidden(-name => 'User', -value=>$problem->user_id), "\n",
518 CGI::submit(-name => 'action', -value=>'Show Past Answers'), "\n",
225 endform(); 519 CGI::endform();
520
521
522
523 }
524 # FIXME print editor link
525 # print editor link if the user is an instructor AND the file is not in temporary editing mode
526 if ($self->{permissionLevel}>=10 and ( (not defined($self->{edit_mode})) or $self->{edit_mode} eq 'savedFile') ) {
527 print CGI::a({-href=>"/webwork/$courseName/instructor/pgProblemEditor/".$set->set_id.
528 '/'.$problem->problem_id.'?'.$self->url_authen_args},'Edit this problem');
529 }
530 print CGI::end_div();
531
532 # end answer inspection button
533 # warning output
534 if ($pg->{warnings} ne "") {
535 print CGI::hr(), $self->warningOutput($pg->{warnings});
536 }
226 537
227 # debugging stuff 538 # debugging stuff
539 if (0) {
228 #print 540 print
229 # hr(), 541 CGI::hr(),
230 # h2("debugging information"), 542 CGI::h2("debugging information"),
231 # h3("form fields"), 543 CGI::h3("form fields"),
232 # ref2string($formFields), 544 ref2string($self->{formFields}),
233 # h3("user object"), 545 CGI::h3("user object"),
234 # ref2string($user), 546 ref2string($self->{user}),
235 # h3("set object"), 547 CGI::h3("set object"),
236 # ref2string($set), 548 ref2string($set),
237 # h3("problem object"), 549 CGI::h3("problem object"),
238 # ref2string($problem), 550 ref2string($problem),
239 # h3("PG object"), 551 CGI::h3("PG object"),
240 # ref2string($pg, {'WeBWorK::PG::Translator' => 1}); 552 ref2string($pg, {'WeBWorK::PG::Translator' => 1});
553 }
241 554
242 return ""; 555 return "";
243} 556}
244 557
245##### output utilities ##### 558##### output utilities #####
246 559
247sub translationError($$) {
248 my ($error, $details) = @_;
249 return
250 p(<<EOF),
251WeBWorK has encountered a software error while attempting to process this problem.
252It is likely that there is an error in the problem itself.
253If you are a student, contact your professor to have the error corrected.
254If you are a professor, please consut the error output below for more informaiton.
255EOF
256 h3("Error messages"), blockquote(pre($error)),
257 h3("Error context"), blockquote(pre($details));
258}
259
260sub attemptResults($$$) { 560sub attemptResults($$$$$$) {
561 my $self = shift;
261 my $pg = shift; 562 my $pg = shift;
262 my $showAttemptAnswers = shift; 563 my $showAttemptAnswers = shift;
263 my $showCorrectAnswers = shift; 564 my $showCorrectAnswers = shift;
264 my $showAttemptResults = $showAttemptAnswers && shift; 565 my $showAttemptResults = $showAttemptAnswers && shift;
566 my $showSummary = shift;
567 my $showAttemptPreview = shift || 0;
265 my $problemResult = $pg->{result}; # the overall result of the problem 568 my $problemResult = $pg->{result}; # the overall result of the problem
266 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 569 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
267 570
571 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
572
268 my $header = th("answer"); 573 my $header = CGI::th("Part");
269 $header .= $showAttemptAnswers ? th("attempt") : ""; 574 $header .= $showAttemptAnswers ? CGI::th("Entered") : "";
575 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : "";
270 $header .= $showCorrectAnswers ? th("correct") : ""; 576 $header .= $showCorrectAnswers ? CGI::th("Correct") : "";
271 $header .= $showAttemptResults ? th("result") : ""; 577 $header .= $showAttemptResults ? CGI::th("Result") : "";
272 $header .= $showAttemptAnswers ? th("messages") : ""; 578 $header .= $showMessages ? CGI::th("messages") : "";
273 my @tableRows = ( $header ); 579 my @tableRows = ( $header );
274 my $numCorrect; 580 my $numCorrect;
275 foreach my $name (@answerNames) { 581 foreach my $name (@answerNames) {
276 my $answerResult = $pg->{answers}->{$name}; 582 my $answerResult = $pg->{answers}->{$name};
277 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 583 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
584 my $preview = ($showAttemptPreview
585 ? $self->previewAnswer($answerResult)
586 : "");
278 my $correctAnswer = $answerResult->{correct_ans}; 587 my $correctAnswer = $answerResult->{correct_ans};
279 my $answerScore = $answerResult->{score}; 588 my $answerScore = $answerResult->{score};
280 my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : ""; 589 my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
281 590
282 $numCorrect += $answerScore > 0; 591 $numCorrect += $answerScore > 0;
283 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 592 my $resultString = $answerScore ? "correct" : "incorrect";
284 593
594 # get rid of the goofy prefix on the answer names (supposedly, the format
595 # of the answer names is changeable. this only fixes it for "AnSwEr"
596 $name =~ s/^AnSwEr//;
597
285 my $row = td($name); 598 my $row = CGI::td($name);
286 $row .= $showAttemptAnswers ? td($studentAnswer) : ""; 599 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
600 $row .= $showAttemptPreview ? CGI::td($preview) : "";
287 $row .= $showCorrectAnswers ? td($correctAnswer) : ""; 601 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
288 $row .= $showAttemptResults ? td($resultString) : ""; 602 $row .= $showAttemptResults ? CGI::td($resultString) : "";
289 $row .= $answerMessage ? td($answerMessage) : ""; 603 $row .= $answerMessage ? CGI::td($answerMessage) : "";
290 push @tableRows, $row; 604 push @tableRows, $row;
291 } 605 }
292 606
293 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions"; 607 my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
294 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 608 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
295 #my $message = i($problemResult->{msg});
296 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of " 609 my $summary = "On this attempt, you answered $numCorrect out of "
297 . scalar @answerNames . " correct, for a score of $scorePercent."; 610 . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
298 #return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary); 611 return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . ($showSummary ? CGI::p($summary) : "");
299 return table({-border=>1}, Tr(\@tableRows)) . p($summary);
300} 612}
301 613
302sub viewOptions($\%\%\%) { 614sub viewOptions($) {
303 my $displayMode = shift; 615 my $self = shift;
616 my $displayMode = $self->{displayMode};
304 my %must = %{ shift() }; 617 my %must = %{ $self->{must} };
305 my %can = %{ shift() }; 618 my %can = %{ $self->{can} };
306 my %will = %{ shift() }; 619 my %will = %{ $self->{will} };
307 620
308 my $optionLine; 621 my $optionLine;
309 $can{showOldAnswers} and $optionLine .= join "", 622 $can{showOldAnswers} and $optionLine .= join "",
310 "Show: &nbsp;", 623 "Show: &nbsp;",
311 checkbox( 624 CGI::checkbox(
312 -name => "showOldAnswers", 625 -name => "showOldAnswers",
313 -checked => $will{showOldAnswers}, 626 -checked => $will{showOldAnswers},
314 -label => "Saved answers", 627 -label => "Saved answers",
315 ), "&nbsp;&nbsp;"; 628 ), "&nbsp;&nbsp;";
316 $can{showCorrectAnswers} and $optionLine .= join "", 629 $can{showCorrectAnswers} and $optionLine .= join "",
317 checkbox( 630 CGI::checkbox(
318 -name => "showCorrectAnswers", 631 -name => "showCorrectAnswers",
319 -checked => $will{showCorrectAnswers}, 632 -checked => $will{showCorrectAnswers},
320 -label => "Correct answers", 633 -label => "Correct answers",
321 ), "&nbsp;&nbsp;"; 634 ), "&nbsp;&nbsp;";
322 $can{showHints} and $optionLine .= join "", 635 $can{showHints} and $optionLine .= join "",
323 checkbox( 636 CGI::checkbox(
324 -name => "showHints", 637 -name => "showHints",
325 -checked => $will{showHints}, 638 -checked => $will{showHints},
326 -label => "Hints", 639 -label => "Hints",
327 ), "&nbsp;&nbsp;"; 640 ), "&nbsp;&nbsp;";
328 $can{showSolutions} and $optionLine .= join "", 641 $can{showSolutions} and $optionLine .= join "",
329 checkbox( 642 CGI::checkbox(
330 -name => "showSolutions", 643 -name => "showSolutions",
331 -checked => $will{showSolutions}, 644 -checked => $will{showSolutions},
332 -label => "Solutions", 645 -label => "Solutions",
333 ), "&nbsp;&nbsp;"; 646 ), "&nbsp;&nbsp;";
334 $optionLine and $optionLine .= join "", br(); 647 $optionLine and $optionLine .= join "", CGI::br();
335 648
336 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, 649 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
337 "View equations as: &nbsp;", 650 "View equations as: &nbsp;",
338 radio_group( 651 CGI::radio_group(
339 -name => "displayMode", 652 -name => "displayMode",
340 -values => ['plainText', 'formattedText', 'images'], 653 -values => ['plainText', 'formattedText', 'images'],
341 -default => $displayMode, 654 -default => $displayMode,
342 -labels => { 655 -labels => {
343 plainText => "plain text", 656 plainText => "plain text",
344 formattedText => "formatted text", 657 formattedText => "formatted text",
345 images => "images", 658 images => "images",
346 } 659 }
347 ), br(), 660 ), CGI::br(),
348 $optionLine, 661 $optionLine,
349 submit(-name=>"redisplay", -label=>"Redisplay Problem"), 662 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
350 ); 663 );
351} 664}
665
666sub previewAnswer($$) {
667 my ($self, $answerResult) = @_;
668 my $ce = $self->{ce};
669 my $effectiveUser = $self->{effectiveUser};
670 my $set = $self->{set};
671 my $problem = $self->{problem};
672 my $displayMode = $self->{displayMode};
673
674 # note: right now, we have to do things completely differently when we are
675 # rendering math from INSIDE the translator and from OUTSIDE the translator.
676 # so we'll just deal with each case explicitly here. there's some code
677 # duplication that can be dealt with later by abstracting out tth/dvipng/etc.
678
679 my $tex = $answerResult->{preview_latex_string};
680
681 return "" if $tex eq "";
682
683 if ($displayMode eq "plainText") {
684 return $tex;
685 } elsif ($displayMode eq "formattedText") {
686 my $tthCommand = $ce->{externalPrograms}->{tth}
687 . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
688 . "\\(".$tex."\\)\n"
689 . "END_OF_INPUT\n";
690
691 # call tth
692 my $result = `$tthCommand`;
693 if ($?) {
694 return "<b>[tth failed: $? $@]</b>";
695 }
696 return $result;
697 } elsif ($displayMode eq "images") {
698 # how are we going to name this?
699 my $targetPathCommon = "/png/"
700 . $effectiveUser->user_id . "."
701 . $set->set_id . "."
702 . $problem->problem_id . "."
703 . $answerResult->{ans_name} . ".png";
704
705 # figure out where to put things
706 my $wd = tempdir("webwork-dvipng-XXXXXXXX", DIR => $ce->{courseDirs}->{html_temp});
707 my $latex = $ce->{externalPrograms}->{latex};
708 my $dvipng = $ce->{externalPrograms}->{dvipng};
709 my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
710 # should use surePathToTmpFile, but we have to
711 # isolate it from the problem enivronment first
712 my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
713
714 # call dvipng to generate a preview
715 dvipng($wd, $latex, $dvipng, $tex, $targetPath);
716 rmtree($wd, 0, 0);
717 if (-e $targetPath) {
718 return "<img src=\"$targetURL\" alt=\"$tex\" />";
719 } else {
720 return "<b>[math2img failed]</b>";
721 }
722 }
723}
724
725sub info {
726
727return "Identifying information goes here";
728
729}
730##### logging subroutine ####
731
732
352 733
353##### permission queries ##### 734##### permission queries #####
354 735
355# this stuff should be abstracted out into the permissions system 736# this stuff should be abstracted out into the permissions system
356# however, the permission system only knows about things in the 737# however, the permission system only knows about things in the
… …
372 753
373sub canRecordAnswers($$$$$) { 754sub canRecordAnswers($$$$$) {
374 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_; 755 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
375 my $permHigh = $permissionLevel > 0; 756 my $permHigh = $permissionLevel > 0;
376 my $timeOK = time >= $openDate && time <= $dueDate; 757 my $timeOK = time >= $openDate && time <= $dueDate;
377 my $attemptsOK = $attempts <= $maxAttempts; 758 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
378 return $permHigh || ($timeOK && $attemptsOK); 759 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK);
760 return $recordAnswers;
761}
762
763sub canCheckAnswers($$) {
764 my ($permissionLevel, $answerDate) = @_;
765 my $permHigh = $permissionLevel > 0;
766 my $timeOK = time >= $answerDate;
767 my $recordAnswers = $permHigh || $timeOK;
768 return $recordAnswers;
379} 769}
380 770
381sub mustRecordAnswers($) { 771sub mustRecordAnswers($) {
382 my ($permissionLevel) = @_; 772 my ($permissionLevel) = @_;
383 return $permissionLevel == 0; 773 return $permissionLevel == 0;
Legend:
Removed from v.435  
changed lines
  Added in v.939
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9