[system] / trunk / webwork-modperl / lib / WeBWorK / ContentGenerator / GatewayQuiz.pm Repository:
ViewVC logotype

Annotation of /trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1663 - (view) (download) (as text)

1 : gage 1129 ################################################################################
2 : sh002i 1663 # WeBWorK Online Homework Delivery System
3 :     # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4 :     # $CVSHeader$
5 :     #
6 :     # This program is free software; you can redistribute it and/or modify it under
7 :     # the terms of either: (a) the GNU General Public License as published by the
8 :     # Free Software Foundation; either version 2, or (at your option) any later
9 :     # version, or (b) the "Artistic License" which comes with this package.
10 :     #
11 :     # This program is distributed in the hope that it will be useful, but WITHOUT
12 :     # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
13 :     # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
14 :     # Artistic License for more details.
15 : gage 1129 ################################################################################
16 :    
17 :     package WeBWorK::ContentGenerator::GatewayQuiz;
18 :     use base qw(WeBWorK::ContentGenerator);
19 : gage 1138 use File::Path qw(rmtree);
20 :     use WeBWorK::Form;
21 :     use WeBWorK::PG;
22 :     use WeBWorK::PG::IO;
23 : sh002i 1149 use WeBWorK::Utils qw(writeLog encodeAnswers decodeAnswers ref2string makeTempDirectory);
24 : gage 1138 use WeBWorK::DB::Utils qw(global2user user2global findDefaults);
25 : gage 1129
26 :     =head1 NAME
27 :    
28 :     WeBWorK::ContentGenerator::GatewayQuiz - display an index of the problems in a
29 :     problem set. (modifying this from ProblemSet.pm)
30 :    
31 :     =cut
32 :    
33 :     use strict;
34 :     use warnings;
35 :     use CGI qw();
36 :    
37 : gage 1138 sub pre_header_initialize {
38 :     my ($self, $setName) = @_;
39 :     my $r = $self->{r};
40 :     my $courseEnv = $self->{ce};
41 :     my $db = $self->{db};
42 :     my $userName = $r->param('user');
43 :     my $effectiveUserName = $r->param('effectiveUser');
44 :     my $key = $r->param('key');
45 :     my $user = $db->getUser($userName);
46 :     my $effectiveUser = $db->getUser($effectiveUserName);
47 :    
48 :     # obtain the effective user set, or if that is not yet defined obtain global set
49 :     my $set = $db->getMergedSet($effectiveUserName, $setName);
50 :     unless (defined $set) {
51 :     my $userSetClass = $courseEnv->{dbLayout}->{set_user}->{record};
52 :     $set = global2user($userSetClass, $db->getGlobalSet($setName));
53 :     $set->psvn('000');
54 :     }
55 :    
56 :     # FIXME obtain first problem for recording number of attempts FIXME
57 :     my $problem = $db->getMergedProblem($effectiveUser->user_id, $setName, 1);
58 :    
59 :     my $psvn = $set->psvn();
60 :    
61 :     $self->{set} = $set;
62 :     $self->{problem} = $problem;
63 :    
64 :     ##### get and save permission levels #####
65 :    
66 :     my $permissionLevel = $db->getPermissionLevel($userName)->permission();
67 :    
68 :     $self->{userName} = $userName;
69 :     $self->{user} = $user;
70 :     $self->{effectiveUser} = $effectiveUser;
71 :     $self->{permissionLevel} = $permissionLevel;
72 :    
73 :     ##### form processing #####
74 :    
75 :     # set options from form fields (see comment at top of file for names)
76 :     my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
77 :     my $redisplay = $r->param("redisplay");
78 :     my $submitAnswers = $r->param("submitAnswers");
79 :     my $checkAnswers = $r->param("checkAnswers");
80 :     my $previewAnswers = $r->param("previewAnswers");
81 :    
82 :    
83 :     # coerce form fields into CGI::Vars format
84 :     my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
85 :    
86 :     $self->{displayMode} = $displayMode;
87 :     $self->{redisplay} = $redisplay;
88 :     $self->{submitAnswers} = $submitAnswers;
89 :     $self->{checkAnswers} = $checkAnswers;
90 :     $self->{previewAnswers} = $previewAnswers;
91 :     $self->{formFields} = $formFields;
92 :    
93 :     ##### permissions #####
94 :    
95 :     # are we allowed to view this quiz?
96 :     $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0;
97 :     return unless $self->{isOpen};
98 :    
99 :     # what does the user want to do?
100 :     my %want = (
101 :     showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
102 :     showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
103 :     showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
104 :     showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
105 :     recordAnswers => defined($submitAnswers),
106 :     );
107 :    
108 :     # are certain options enforced?
109 :     my %must = (
110 :     showOldAnswers => 0,
111 :     showCorrectAnswers => 0,
112 :     showHints => 0,
113 :     showSolutions => 0,
114 :     recordAnswers => mustRecordAnswers($permissionLevel),
115 :     checkAnswers => 1,
116 :     );
117 :    
118 :     # does the user have permission to use certain options?
119 :     # QUIZ MAX ATTEMPTS should be set quiz wide FIXME
120 :     my $QUIZ_MAX_ATTEMPTS=100;
121 :     my %can = (
122 :     showOldAnswers => 1,
123 :     showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),
124 :     showHints => 1,
125 :     showSolutions => canShowSolutions($permissionLevel, $set->answer_date),
126 :     recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
127 :     $QUIZ_MAX_ATTEMPTS, $problem->num_correct + $problem->num_incorrect + 1),
128 :     # attempts=num_correct+num_incorrect+1, as this happens before updating $problem
129 :     checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date),
130 :     );
131 :    
132 :     # final values for options
133 :     my %will;
134 :     foreach (keys %must) {
135 :     $will{$_} = $must{$_} || ($can{$_} && $want{$_}) ;
136 :     }
137 :     # warn "\n want";
138 :     # WeBWorK::Utils::pretty_print_rh(\%want);
139 :     # warn "can";
140 :     # WeBWorK::Utils::pretty_print_rh(\%can);
141 :     # warn "must";
142 :     # WeBWorK::Utils::pretty_print_rh(\%must);
143 :     # warn "will";
144 :     # WeBWorK::Utils::pretty_print_rh(\%will);
145 :    
146 :     ##### store fields #####
147 :    
148 :     $self->{want} = \%want;
149 :     $self->{must} = \%must;
150 :     $self->{can} = \%can;
151 :     $self->{will} = \%will;
152 :    
153 :    
154 :     #
155 :     # #### sticky answers ##### FIXME
156 :     #
157 :     # if (not $submitAnswers and $will{showOldAnswers}) {
158 :     # do this only if new answers are NOT being submitted
159 :     # my %oldAnswers = decodeAnswers($problem->last_answer);
160 :     # $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
161 :     # }
162 :    
163 :     ######### translate problems ############
164 :     my @problemNumbers = $db->listUserProblems($effectiveUserName, $setName);
165 :    
166 :     my @pg_results = ();
167 :     foreach my $problemNumber (sort {$a<=> $b } @problemNumbers) {
168 :     my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber);
169 :     my $pg = $self->getProblemHTML($self->{effectiveUser}, $setName, $problemNumber);
170 :     push(@pg_results, $pg);
171 :     }
172 :     $self->{ra_pg_results}=\@pg_results;
173 :    
174 :    
175 :     }
176 : gage 1129 sub initialize {
177 :     my ($self, $setName) = @_;
178 :     my $courseEnvironment = $self->{ce};
179 :     my $r = $self->{r};
180 :     my $db = $self->{db};
181 :     my $userName = $r->param("user");
182 :     my $effectiveUserName = $r->param("effectiveUser");
183 :    
184 :     my $user = $db->getUser($userName);
185 :     my $effectiveUser = $db->getUser($effectiveUserName);
186 :     my $set = $db->getMergedSet($effectiveUserName, $setName);
187 :     my $permissionLevel = $db->getPermissionLevel($userName)->permission();
188 :    
189 :     $self->{userName} = $userName;
190 :     $self->{user} = $user;
191 :     $self->{effectiveUser} = $effectiveUser;
192 :     $self->{set} = $set;
193 :     $self->{permissionLevel} = $permissionLevel;
194 :    
195 :     ##### permissions #####
196 :    
197 :     $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0;
198 :     }
199 :    
200 :     sub path {
201 :     my ($self, $setName, $args) = @_;
202 :    
203 :     my $ce = $self->{ce};
204 :     my $root = $ce->{webworkURLs}->{root};
205 :     my $courseName = $ce->{courseName};
206 :     return $self->pathMacro($args,
207 :     "Home" => "$root",
208 :     $courseName => "$root/$courseName",
209 :     $setName => "",
210 :     );
211 :     }
212 :    
213 :     sub nav {
214 :     my ($self, $setName, $args) = @_;
215 :    
216 :     my $ce = $self->{ce};
217 :     my $root = $ce->{webworkURLs}->{root};
218 :     my $courseName = $ce->{courseName};
219 :     my @links = ("Problem Sets" , "$root/$courseName", "navUp");
220 :     my $tail = "";
221 :    
222 :     return $self->navMacro($args, $tail, @links);
223 :     }
224 :    
225 :    
226 :     sub siblings {
227 :     my ($self, $setName) = @_;
228 :     return "";
229 :     }
230 :    
231 :     sub title {
232 :     my ($self, $setName) = @_;
233 :    
234 :     return $setName;
235 :     }
236 :    
237 :    
238 : gage 1138
239 : gage 1129 sub body {
240 : gage 1138 my $self = shift;
241 : gage 1129
242 : gage 1138 return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open."))
243 :     unless $self->{isOpen};
244 :    
245 :     # unpack some useful variables
246 :    
247 :     my $r = $self->{r};
248 :     my $db = $self->{db};
249 :     my $set = $self->{set};
250 :     my $problem = $self->{problem};
251 :     my $permissionLevel = $self->{permissionLevel};
252 :     my $submitAnswers = $self->{submitAnswers};
253 :     my $checkAnswers = $self->{checkAnswers};
254 :     my $previewAnswers = $self->{previewAnswers};
255 :     my %want = %{ $self->{want} };
256 :     my %can = %{ $self->{can} };
257 :     my %must = %{ $self->{must} };
258 :     my %will = %{ $self->{will} };
259 :    
260 :     # coerce form fields into CGI::Vars format
261 :    
262 : gage 1129 return CGI::p(CGI::font({-color=>"red"}, "This problem set is not available because it is not yet open."))
263 :     unless ($self->{isOpen});
264 : gage 1138
265 : gage 1129 print CGI::h3("This is an experimental gateway quiz format");
266 :    
267 : gage 1138 print "Number of attempts is ". ($problem->num_correct + $problem->num_incorrect + 1);
268 :    
269 : gage 1129 print
270 :     CGI::startform("POST", $r->uri),
271 :     $self->hidden_authen_fields;
272 :    
273 : gage 1138 #my $set = $db->getMergedSet($effectiveUserName, $setName);
274 :     #my @problemNumbers = $db->listUserProblems($effectiveUserName, $setName);
275 :     my @pg_results = @{ $self->{ra_pg_results} };
276 :     my $problemNumber = 0;
277 :     foreach my $pg (@pg_results) {
278 :     $problemNumber++;
279 : gage 1129 print CGI::p("Problem $problemNumber");
280 : gage 1138 # FIXME determine when to see correct answers etc.
281 :     print $self->attemptResults($pg, 1,1,1, 1, 1 ) if $submitAnswers or $checkAnswers;
282 :     print CGI::p( $pg->{body_text});
283 :     print "\n\n", CGI::hr(),CGI::hr(),"\n\n";
284 : gage 1129
285 :    
286 :    
287 :     }
288 :     print CGI::p( #FIXME
289 : gage 1138 ($will{recordAnswers})
290 :     ? CGI::submit(-name=>"submitAnswers",
291 : gage 1129 -label=>"Submit Quiz")
292 : gage 1138 : "",
293 :     (not $will{recordAnswers})
294 :     ? CGI::submit(-name=>"checkAnswers",
295 : gage 1129 -label=>"Check Answers")
296 : gage 1138 : "",
297 : gage 1129 CGI::submit(-name=>"previewAnswers",
298 :     -label=>"Preview Answers"),
299 :     );
300 :     # print CGI::end_table();
301 :    
302 :     # feedback form
303 :     my $ce = $self->{ce};
304 :     my $root = $ce->{webworkURLs}->{root};
305 :     my $courseName = $ce->{courseName};
306 :     my $feedbackURL = "$root/$courseName/feedback/";
307 :     print
308 :     CGI::startform("POST", $feedbackURL),
309 :     $self->hidden_authen_fields,
310 :     CGI::hidden("module", __PACKAGE__),
311 : gage 1138 CGI::hidden("set", $self->{set}->set_id),
312 : gage 1129 CGI::p({-align=>"right"},
313 :     CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback")
314 :     ),
315 :     CGI::endform();
316 :    
317 :     return "";
318 :     }
319 :    
320 : gage 1138 sub viewOptions($) {
321 : gage 1129 my $self = shift;
322 : gage 1138 my $displayMode = $self->{displayMode};
323 :     my %must = %{ $self->{must} };
324 :     my %can = %{ $self->{can} };
325 :     my %will = %{ $self->{will} };
326 : gage 1129
327 : gage 1138 my $optionLine;
328 :     $can{showOldAnswers} and $optionLine .= join "",
329 :     "Show: &nbsp;".CGI::br(),
330 :     CGI::checkbox(
331 :     -name => "showOldAnswers",
332 :     -checked => $will{showOldAnswers},
333 :     -label => "Saved answers",
334 :     ), "&nbsp;&nbsp;".CGI::br();
335 :     $can{showCorrectAnswers} and $optionLine .= join "",
336 :     CGI::checkbox(
337 :     -name => "showCorrectAnswers",
338 :     -checked => $will{showCorrectAnswers},
339 :     -label => "Correct answers",
340 :     ), "&nbsp;&nbsp;".CGI::br();
341 :     $can{showHints} and $optionLine .= join "",
342 :     CGI::checkbox(
343 :     -name => "showHints",
344 :     -checked => $will{showHints},
345 :     -label => "Hints",
346 :     ), "&nbsp;&nbsp;".CGI::br();
347 :     $can{showSolutions} and $optionLine .= join "",
348 :     CGI::checkbox(
349 :     -name => "showSolutions",
350 :     -checked => $will{showSolutions},
351 :     -label => "Solutions",
352 :     ), "&nbsp;&nbsp;".CGI::br();
353 :     $optionLine and $optionLine .= join "", CGI::br();
354 : gage 1129
355 : gage 1138 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"},
356 :     "View&nbsp;equations&nbsp;as:&nbsp;&nbsp;&nbsp;&nbsp;".CGI::br(),
357 :     CGI::radio_group(
358 :     -name => "displayMode",
359 :     -values => ['plainText', 'formattedText', 'images'],
360 :     -default => $displayMode,
361 :     -linebreak=>'true',
362 :     -labels => {
363 :     plainText => "plain",
364 :     formattedText => "formatted",
365 :     images => "images",
366 :     }
367 :     ), CGI::br(),CGI::hr(),
368 :     $optionLine,
369 :     CGI::submit(-name=>"redisplay", -label=>"Save Options"),
370 :     );
371 : gage 1129 }
372 : gage 1138 sub options {
373 :     my $self = shift;
374 :     return join("",
375 :     CGI::start_form("POST", $self->{r}->uri),
376 :     $self->hidden_authen_fields,
377 :     CGI::hr(),
378 :     CGI::start_div({class=>"viewOptions"}),
379 :     $self->viewOptions(),
380 :     CGI::end_div(),
381 :     CGI::end_form()
382 :     );
383 :     }
384 :    
385 :    
386 :    
387 : gage 1129 ###########################################################################
388 :     # Evaluation utilties
389 :     ############################################################################
390 :     sub getProblemHTML {
391 :     my ($self, $effectiveUser, $setName, $problemNumber, $pgFile) = @_;
392 :     my $r = $self->{r};
393 :     my $ce = $self->{ce};
394 :     my $db = $self->{db};
395 : gage 1138 my $key = $r->param('key');
396 : gage 1129 # Should we provide a default user ? I think not FIXME
397 : gage 1138 # $effectiveUser = $self->{effectiveUser} unless defined($effectiveUser);
398 : gage 1129
399 : gage 1138 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
400 :    
401 : gage 1129 my $permissionLevel = $self->{permissionLevel};
402 :     my $set = $db->getMergedSet($effectiveUser->user_id, $setName);
403 :     my $psvn = $set->psvn();
404 :    
405 :     # decide what to do about problem number
406 :     my $problem;
407 :     if ($problemNumber) {
408 :     $problem = $db->getMergedProblem($effectiveUser->user_id, $setName, $problemNumber);
409 :     } elsif ($pgFile) {
410 :     $problem = WeBWorK::DB::Record::UserProblem->new(
411 :     set_id => $set->set_id,
412 :     problem_id => 0,
413 :     login_id => $effectiveUser->user_id,
414 :     source_file => $pgFile,
415 :     # the rest of Problem's fields are not needed, i think
416 :     );
417 :     }
418 :    
419 :     # figure out if we're allowed to get solutions and call PG->new accordingly.
420 : gage 1138 my $showCorrectAnswers = $self->{will}->{showCorrectAnswers};
421 :     my $showHints = $self->{will}->{showHints};
422 :     my $showSolutions = $self->{will}->{showSolutions};
423 :     my $processAnswers = $self->{will}->{checkAnswers};
424 :    
425 : gage 1129 unless ($permissionLevel > 0 or time > $set->answer_date) {
426 :     $showCorrectAnswers = 0;
427 :     $showSolutions = 0;
428 :     }
429 : gage 1138
430 :     # FIXME WeBWorK::Utils::pretty_print_rh($formFields);
431 : gage 1129 my $pg = WeBWorK::PG->new(
432 :     $ce,
433 :     $effectiveUser,
434 : gage 1138 $key,
435 : gage 1129 $set,
436 :     $problem,
437 :     $psvn,
438 : gage 1138 $formFields,
439 : gage 1129 { # translation options
440 :     displayMode => "images",
441 :     showHints => $showHints,
442 :     showSolutions => $showSolutions,
443 : gage 1138 refreshMath2img => $showHints || $showSolutions,
444 :     processAnswers => 1,
445 :     QUIZ_PREFIX => 'Q'.sprintf("%04d",$problemNumber).'_',
446 : gage 1129 },
447 :     );
448 :    
449 :     if ($pg->{warnings} ne "") {
450 :     push @{$self->{warnings}}, {
451 :     set => $setName,
452 :     problem => $problemNumber,
453 :     message => $pg->{warnings},
454 :     };
455 :     }
456 :    
457 :     if ($pg->{flags}->{error_flag}) {
458 :     push @{$self->{errors}}, {
459 :     set => $setName,
460 :     problem => $problemNumber,
461 :     message => $pg->{errors},
462 :     context => $pg->{body_text},
463 :     };
464 :     # if there was an error, body_text contains
465 :     # the error context, not TeX code
466 :     $pg->{body_text} = undef;
467 :     }
468 : gage 1138
469 : gage 1129 #return '<br>hi FIXME'."effective User $effectiveUser, setName $setName, probNum $problemNumber, file: $pgFile".
470 : gage 1138 return $pg;
471 : gage 1129 }
472 :     ##### output utilities #####
473 : gage 1138 sub problemListRow($$$) {
474 :     my $self = shift;
475 :     my $set = shift;
476 :     my $problem = shift;
477 :    
478 :     my $name = $problem->problem_id;
479 :     my $interactiveURL = "$name/?" . $self->url_authen_args;
480 :     my $interactive = CGI::a({-href=>$interactiveURL}, "Problem $name");
481 :     my $attempts = $problem->num_correct + $problem->num_incorrect;
482 :     my $remaining = $problem->max_attempts < 0
483 :     ? "unlimited"
484 :     : $problem->max_attempts - $attempts;
485 :     my $status = sprintf("%.0f%%", $problem->status * 100); # round to whole number
486 :    
487 :     return CGI::Tr(CGI::td({-nowrap=>1}, [
488 :     $interactive,
489 :     $attempts,
490 :     $remaining,
491 :     $status,
492 :     ]));
493 :     }
494 :     sub nbsp {
495 :     my $str = shift;
496 :     ($str) ? $str : '&nbsp;'; # returns non-breaking space for empty strings
497 :     }
498 :     sub previewAnswer($$) {
499 : gage 1639 my ($self, $answerResult, $imgGen) = @_;
500 : gage 1138 my $ce = $self->{ce};
501 :     my $effectiveUser = $self->{effectiveUser};
502 :     my $set = $self->{set};
503 :     my $problem = $self->{problem};
504 :     my $displayMode = $self->{displayMode};
505 :    
506 :     # note: right now, we have to do things completely differently when we are
507 :     # rendering math from INSIDE the translator and from OUTSIDE the translator.
508 :     # so we'll just deal with each case explicitly here. there's some code
509 :     # duplication that can be dealt with later by abstracting out tth/dvipng/etc.
510 :    
511 : gage 1639 my $tex = $answerResult->{preview_latex_string};
512 : gage 1138
513 : gage 1639 return "" unless defined $tex and $tex ne "";
514 : gage 1138
515 :     if ($displayMode eq "plainText") {
516 :     return $tex;
517 :     } elsif ($displayMode eq "formattedText") {
518 :     my $tthCommand = $ce->{externalPrograms}->{tth}
519 :     . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
520 :     . "\\(".$tex."\\)\n"
521 :     . "END_OF_INPUT\n";
522 :    
523 :     # call tth
524 :     my $result = `$tthCommand`;
525 :     if ($?) {
526 :     return "<b>[tth failed: $? $@]</b>";
527 :     }
528 :     return $result;
529 :     } elsif ($displayMode eq "images") {
530 : gage 1639 ## how are we going to name this?
531 :     #my $targetPathCommon = "/m2i/"
532 :     # . $effectiveUser->user_id . "."
533 :     # . $set->set_id . "."
534 :     # . $problem->problem_id . "."
535 :     # . $answerResult->{ans_name} . ".png";
536 :     #
537 :     ## figure out where to put things
538 :     #my $wd = makeTempDirectory($ce->{courseDirs}->{html_temp}, "webwork-dvipng");
539 :     #my $latex = $ce->{externalPrograms}->{latex};
540 :     #my $dvipng = $ce->{externalPrograms}->{dvipng};
541 :     #my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
542 :     # # should use surePathToTmpFile, but we have to
543 :     # # isolate it from the problem enivronment first
544 :     #my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
545 :     #
546 :     ## call dvipng to generate a preview
547 :     #dvipng($wd, $latex, $dvipng, $tex, $targetPath);
548 :     #rmtree($wd, 0, 0);
549 :     #if (-e $targetPath) {
550 :     # return "<img src=\"$targetURL\" alt=\"$tex\" />";
551 :     #} else {
552 :     # return "<b>[math2img failed]</b>";
553 :     #}
554 :     $imgGen->add($answerResult->{preview_latex_string});
555 :    
556 : gage 1138 }
557 :     }
558 :    
559 :    
560 : gage 1129 sub attemptResults($$$$$$) {
561 :     my $self = shift;
562 :     my $pg = shift;
563 :     my $showAttemptAnswers = shift;
564 :     my $showCorrectAnswers = shift;
565 :     my $showAttemptResults = $showAttemptAnswers && shift;
566 :     my $showSummary = shift;
567 :     my $showAttemptPreview = shift || 0;
568 : gage 1639 my $ce = $self->{ce};
569 : gage 1129 my $problemResult = $pg->{result}; # the overall result of the problem
570 :     my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
571 :    
572 :     my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
573 :    
574 : gage 1639 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview";
575 :     my $imgGen = WeBWorK::PG::ImageGenerator->new(
576 :     tempDir => $ce->{webworkDirs}->{tmp},
577 :     latex => $ce->{externalPrograms}->{latex},
578 :     dvipng => $ce->{externalPrograms}->{dvipng},
579 :     useCache => 1,
580 :     cacheDir => $ce->{webworkDirs}->{equationCache},
581 :     cacheURL => $ce->{webworkURLs}->{equationCache},
582 :     cacheDB => $ce->{webworkFiles}->{equationCacheDB},
583 :     );
584 :    
585 :     my $header;
586 : gage 1129 $header .= $showAttemptAnswers ? CGI::th("Entered") : "";
587 :     $header .= $showAttemptPreview ? CGI::th("Answer Preview") : "";
588 :     $header .= $showCorrectAnswers ? CGI::th("Correct") : "";
589 :     $header .= $showAttemptResults ? CGI::th("Result") : "";
590 :     $header .= $showMessages ? CGI::th("messages") : "";
591 :     my @tableRows = ( $header );
592 :     my $numCorrect;
593 :     foreach my $name (@answerNames) {
594 :     my $answerResult = $pg->{answers}->{$name};
595 : gage 1138
596 : gage 1129 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
597 : gage 1138
598 : gage 1129 my $preview = ($showAttemptPreview
599 : gage 1639 ? $self->previewAnswer($answerResult,$imgGen)
600 : gage 1129 : "");
601 :     my $correctAnswer = $answerResult->{correct_ans};
602 :     my $answerScore = $answerResult->{score};
603 :     my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
604 :    
605 :     $numCorrect += $answerScore > 0;
606 :     my $resultString = $answerScore ? "correct" : "incorrect";
607 :    
608 : gage 1639
609 :     my $row = '';
610 : gage 1129 $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : "";
611 :     $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : "";
612 :     $row .= $showCorrectAnswers ? CGI::td(nbsp($correctAnswer)) : "";
613 :     $row .= $showAttemptResults ? CGI::td(nbsp($resultString)) : "";
614 :     $row .= $answerMessage ? CGI::td(nbsp($answerMessage)) : "";
615 :     push @tableRows, $row;
616 :     }
617 :    
618 : gage 1639 # render equation images
619 :     $imgGen->render(refresh => 1);
620 :    
621 : gage 1129 my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
622 :     my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100);
623 :     my $summary = "On this attempt, you answered $numCorrect out of "
624 :     . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
625 :     return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) . ($showSummary ? CGI::p($summary) : "");
626 :     }
627 : gage 1138
628 :     ##### logging subroutine ####
629 :    
630 :    
631 :    
632 :     ##### permission queries #####
633 :    
634 :     # this stuff should be abstracted out into the permissions system
635 :     # however, the permission system only knows about things in the
636 :     # course environment and the username. hmmm...
637 :    
638 :     # also, i should fix these so that they have a consistent calling
639 :     # format -- perhaps:
640 :     # canPERM($courseEnv, $user, $set, $problem, $permissionLevel)
641 :    
642 :     sub canShowCorrectAnswers($$) {
643 :     my ($permissionLevel, $answerDate) = @_;
644 :     return $permissionLevel > 0 || time > $answerDate;
645 :     }
646 :    
647 :     sub canShowSolutions($$) {
648 :     my ($permissionLevel, $answerDate) = @_;
649 :     return canShowCorrectAnswers($permissionLevel, $answerDate);
650 :     }
651 :    
652 :     sub canRecordAnswers($$$$$) {
653 :     my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
654 :     my $permHigh = $permissionLevel > 0;
655 :     my $timeOK = time >= $openDate && time <= $dueDate;
656 :     my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
657 :     my $recordAnswers = $permHigh || ($timeOK && $attemptsOK);
658 :     return $recordAnswers;
659 :     }
660 :    
661 :     sub canCheckAnswers($$) {
662 :     my ($permissionLevel, $answerDate) = @_;
663 :     my $permHigh = $permissionLevel > 0;
664 :     my $timeOK = time >= $answerDate;
665 :     my $recordAnswers = $permHigh || $timeOK;
666 :     return $recordAnswers;
667 :     }
668 :    
669 :     sub mustRecordAnswers($) {
670 :     my ($permissionLevel) = @_;
671 :     return $permissionLevel == 0;
672 :     }
673 :    
674 : gage 1129 1;
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9