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

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

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

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