Annotation of /branches/rel-2-3-dev/webwork-modperl/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm

Revision 4332 - (view) (download) (as text)
Original Path: trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm

1 :	gage	1129	################################################################################
2 :	sh002i	1663	# WeBWorK Online Homework Delivery System
3 :	sh002i	3973	# Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
4 :	glarose	4332	# $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm,v 1.27 2006/08/01 22:02:50 glarose Exp $
5 :	sh002i	1663	#
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 :
20 :			=head1 NAME
21 :
22 :	glarose	3377	WeBWorK::ContentGenerator::GatewayQuiz - display a quiz of problems on one page,
23 :			deal with versioning sets
24 :	gage	1129
25 :			=cut
26 :
27 :			use strict;
28 :			use warnings;
29 :	gage	4235	#use CGI qw(-nosticky );
30 :			use WeBWorK::CGI;
31 :	sh002i	1877	use File::Path qw(rmtree);
32 :			use WeBWorK::Form;
33 :			use WeBWorK::PG;
34 :	glarose	3377	use WeBWorK::PG::ImageGenerator;
35 :	sh002i	1877	use WeBWorK::PG::IO;
36 :	glarose	3377	use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory);
37 :	sh002i	1877	use WeBWorK::DB::Utils qw(global2user user2global findDefaults);
38 :	sh002i	3642	use WeBWorK::Debug;
39 :	glarose	3377	use WeBWorK::ContentGenerator::Instructor qw(assignSetVersionToUser);
40 :	glarose	4316	use PGrandom;
41 :	glarose	3377
42 :			# template method
43 :			sub templateName {
44 :			return "gateway";
45 :			}
46 :
47 :
48 :			################################################################################
49 :			# "can" methods
50 :			################################################################################
51 :
52 :			# Subroutines to determine if a user "can" perform an action. Each subroutine is
53 :			# called with the following arguments:
54 :			#
55 :			# ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem)
56 :
57 :			# *** The "can" routines are taken from Problem.pm, with small modifications
58 :			# *** to look at number of attempts per version, not per set, and to allow
59 :			# *** showing of correct answers after all attempts at a version are used
60 :
61 :			sub can_showOldAnswers {
62 :			#my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) = @_;
63 :	gage	1138
64 :	glarose	3377	return 1;
65 :			}
66 :	gage	1138
67 :	glarose	3377	# gateway change here: add $submitAnswers as an optional additional argument
68 :			# to be included if it's defined
69 :			sub can_showCorrectAnswers {
70 :			my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem,
71 :			$submitAnswers) = @_;
72 :			my $authz = $self->r->authz;
73 :	gage	1138
74 :	glarose	3377	# gateway change here to allow correct answers to be viewed after all attempts
75 :			# at a version are exhausted as well as if it's after the answer date
76 :			# $addOne allows us to count the current submission
77 :			my $addOne = defined( $submitAnswers ) ? $submitAnswers : 0;
78 :			my $maxAttempts = $Set->attempts_per_version();
79 :			my $attemptsUsed = $Problem->num_correct + $Problem->num_incorrect +
80 :			$addOne;
81 :	gage	1138
82 :	glarose	3377	return ( ( after( $Set->answer_date ) \|\|
83 :			$attemptsUsed >= $maxAttempts ) \|\|
84 :			$authz->hasPermissions($User->user_id,
85 :			"show_correct_answers_before_answer_date") )
86 :			;
87 :			}
88 :
89 :			sub can_showHints {
90 :			#my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) = @_;
91 :	gage	1138
92 :	glarose	3377	return 1;
93 :			}
94 :	gage	1138
95 :	glarose	3377	# gateway change here: add $submitAnswers as an optional additional argument
96 :			# to be included if it's defined
97 :			sub can_showSolutions {
98 :			my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem,
99 :			$submitAnswers) = @_;
100 :			my $authz = $self->r->authz;
101 :	gage	1138
102 :	glarose	3377	# this is the same as can_showCorrectAnswers
103 :			# gateway change here to allow correct answers to be viewed after all attempts
104 :			# at a version are exhausted as well as if it's after the answer date
105 :			# $addOne allows us to count the current submission
106 :			my $addOne = defined( $submitAnswers ) ? $submitAnswers : 0;
107 :			my $maxAttempts = $Set->attempts_per_version();
108 :			my $attemptsUsed = $Problem->num_correct+$Problem->num_incorrect+$addOne;
109 :
110 :			return ( ( after( $Set->answer_date ) \|\|
111 :			$attemptsUsed >= $maxAttempts ) \|\|
112 :			$authz->hasPermissions($User->user_id,
113 :			"show_correct_answers_before_answer_date") );
114 :			}
115 :
116 :			# gateway change here: add $submitAnswers as an optional additional argument
117 :			# to be included if it's defined
118 :			# we also allow for a version_last_attempt_time which is the time the set was
119 :			# submitted; if that's present we use that instead of the current time to
120 :			# decide if we can record the answers. this deals with the time between the
121 :			# submission time and the proctor authorization.
122 :			sub can_recordAnswers {
123 :			my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem,
124 :			$submitAnswers) = @_;
125 :			my $authz = $self->r->authz;
126 :
127 :	glarose	3842	my $timeNow = ( defined($self->{timeNow}) ) ? $self->{timeNow} : time();
128 :			# get the sag time after the due date in which we'll still grade the test
129 :			my $grace = $self->{ce}->{gatewayGracePeriod};
130 :
131 :	glarose	3377	my $submitTime = ( defined($Set->version_last_attempt_time()) &&
132 :			$Set->version_last_attempt_time() ) ?
133 :	glarose	3842	$Set->version_last_attempt_time() : $timeNow;
134 :	glarose	3377
135 :			if ($User->user_id ne $EffectiveUser->user_id) {
136 :			return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student");
137 :	gage	1138	}
138 :	glarose	3842
139 :	glarose	3377	if (before($Set->open_date, $submitTime)) {
140 :			return $authz->hasPermissions($User->user_id, "record_answers_before_open_date");
141 :	glarose	3842	} elsif (between($Set->open_date, ($Set->due_date + $grace), $submitTime)) {
142 :	gage	1138
143 :	glarose	3377	# gateway change here; we look at maximum attempts per version, not for the set,
144 :			# to determine the number of attempts allowed
145 :			# $addOne allows us to count the current submission
146 :	glarose	3842	my $addOne = ( defined( $submitAnswers ) && $submitAnswers ) ?
147 :			1 : 0;
148 :	glarose	3377	my $max_attempts = $Set->attempts_per_version();
149 :			my $attempts_used = $Problem->num_correct+$Problem->num_incorrect+$addOne;
150 :			if ($max_attempts == -1 or $attempts_used < $max_attempts) {
151 :			return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts");
152 :			} else {
153 :			return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts");
154 :			}
155 :	glarose	3842	} elsif (between(($Set->due_date + $grace), $Set->answer_date, $submitTime)) {
156 :	glarose	3377	return $authz->hasPermissions($User->user_id, "record_answers_after_due_date");
157 :			} elsif (after($Set->answer_date, $submitTime)) {
158 :			return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date");
159 :			}
160 :			}
161 :	gage	1138
162 :	glarose	3377	# gateway change here: add $submitAnswers as an optional additional argument
163 :			# to be included if it's defined
164 :			# we also allow for a version_last_attempt_time which is the time the set was
165 :			# submitted; if that's present we use that instead of the current time to
166 :			# decide if we can check the answers. this deals with the time between the
167 :			# submission time and the proctor authorization.
168 :			sub can_checkAnswers {
169 :			my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem,
170 :			$submitAnswers) = @_;
171 :			my $authz = $self->r->authz;
172 :	glarose	3842
173 :			my $timeNow = ( defined($self->{timeNow}) ) ? $self->{timeNow} : time();
174 :			# get the sag time after the due date in which we'll still grade the test
175 :			my $grace = $self->{ce}->{gatewayGracePeriod};
176 :	gage	1129
177 :	glarose	3377	my $submitTime = ( defined($Set->version_last_attempt_time()) &&
178 :			$Set->version_last_attempt_time() ) ?
179 :	glarose	3842	$Set->version_last_attempt_time() : $timeNow;
180 :	glarose	3377
181 :			if (before($Set->open_date, $submitTime)) {
182 :			return $authz->hasPermissions($User->user_id, "check_answers_before_open_date");
183 :	glarose	3842	} elsif (between($Set->open_date, ($Set->due_date + $grace), $submitTime)) {
184 :	glarose	3377
185 :			# gateway change here; we look at maximum attempts per version, not for the set,
186 :			# to determine the number of attempts allowed
187 :			# $addOne allows us to count the current submission
188 :	glarose	3842	my $addOne = (defined( $submitAnswers ) && $submitAnswers) ?
189 :			1 : 0;
190 :	glarose	3377	my $max_attempts = $Set->attempts_per_version();
191 :			my $attempts_used = $Problem->num_correct+$Problem->num_incorrect+$addOne;
192 :
193 :			if ($max_attempts == -1 or $attempts_used < $max_attempts) {
194 :			return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts");
195 :			} else {
196 :			return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts");
197 :			}
198 :	glarose	3842	} elsif (between(($Set->due_date + $grace), $Set->answer_date, $submitTime)) {
199 :	glarose	3377	return $authz->hasPermissions($User->user_id, "check_answers_after_due_date");
200 :			} elsif (after($Set->answer_date, $submitTime)) {
201 :			return $authz->hasPermissions($User->user_id, "check_answers_after_answer_date");
202 :			}
203 :	gage	1129	}
204 :
205 :	glarose	3377	# Helper functions for calculating times
206 :			# gateway change here: we allow an optional additional argument to use as the
207 :			# time to check rather than time()
208 :	glarose	3842	sub before { return (@_==2) ? $_[1] < $_[0] : time < $_[0] }
209 :			sub after { return (@_==2) ? $_[1] > $_[0] : time > $_[0] }
210 :			sub between { my $t = (@_==3) ? $_[2] : time; return $t >= $_[0] && $t <= $_[1] }
211 :	glarose	3377
212 :			################################################################################
213 :			# output utilities
214 :			################################################################################
215 :
216 :			# subroutine is modified from that in Problem.pm to produce a different
217 :			# table format
218 :			sub attemptResults {
219 :			my $self = shift;
220 :			my $pg = shift;
221 :			my $showAttemptAnswers = shift;
222 :			my $showCorrectAnswers = shift;
223 :			my $showAttemptResults = $showAttemptAnswers && shift;
224 :			my $showSummary = shift;
225 :			my $showAttemptPreview = shift \|\| 0;
226 :	gage	1129
227 :	sh002i	1841	my $r = $self->{r};
228 :			my $setName = $r->urlpath->arg("setID");
229 :	gage	1129	my $ce = $self->{ce};
230 :			my $root = $ce->{webworkURLs}->{root};
231 :			my $courseName = $ce->{courseName};
232 :	sh002i	3357	my @links = ("Homework Sets" , "$root/$courseName", "navUp");
233 :	gage	1129	my $tail = "";
234 :
235 :	glarose	3377	my $problemResult = $pg->{result}; # the overall result of the problem
236 :			my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
237 :	gage	1129
238 :	glarose	3377	my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
239 :	gage	1138
240 :	glarose	3377	# present in ver 1.10; why is this checked here?
241 :			# return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the homework set that contains it is not yet open."))
242 :			# unless $self->{isOpen};
243 :	gage	1138
244 :	glarose	3377	my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview";
245 :
246 :			# to make grabbing these options easier, we'll pull them out now...
247 :			my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}};
248 :	gage	1129
249 :	glarose	3377	my $imgGen = WeBWorK::PG::ImageGenerator->new(
250 :			tempDir => $ce->{webworkDirs}->{tmp},
251 :			latex => $ce->{externalPrograms}->{latex},
252 :			dvipng => $ce->{externalPrograms}->{dvipng},
253 :			useCache => 1,
254 :			cacheDir => $ce->{webworkDirs}->{equationCache},
255 :			cacheURL => $ce->{webworkURLs}->{equationCache},
256 :			cacheDB => $ce->{webworkFiles}->{equationCacheDB},
257 :			dvipng_align => $imagesModeOptions{dvipng_align},
258 :			dvipng_depth_db => $imagesModeOptions{dvipng_depth_db},
259 :			);
260 :	gage	1138
261 :	glarose	3377	my %resultsData = ();
262 :			$resultsData{'Entered'} = CGI::td({-class=>"label"}, "Your answer parses as:");
263 :			$resultsData{'Preview'} = CGI::td({-class=>"label"}, "Your answer previews as:");
264 :			$resultsData{'Correct'} = CGI::td({-class=>"label"}, "The correct answer is:");
265 :			$resultsData{'Results'} = CGI::td({-class=>"label"}, "Result:");
266 :			$resultsData{'Messages'} = CGI::td({-class=>"label"}, "Messages:");
267 :
268 :			my %resultsRows = ();
269 :			foreach ( qw( Entered Preview Correct Results Messages ) ) {
270 :			$resultsRows{$_} = "";
271 :			}
272 :
273 :			my $numCorrect = 0;
274 :			my $numAns = 0;
275 :			foreach my $name (@answerNames) {
276 :			my $answerResult = $pg->{answers}->{$name};
277 :			my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
278 :			my $preview = ($showAttemptPreview
279 :			? $self->previewAnswer($answerResult, $imgGen)
280 :			: "");
281 :			my $correctAnswer = $answerResult->{correct_ans};
282 :			my $answerScore = $answerResult->{score};
283 :			my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
284 :			#FIXME --Can we be sure that $answerScore is an integer-- could the problem give partial credit?
285 :			$numCorrect += $answerScore > 0;
286 :			my $resultString = $answerScore == 1 ? "correct" : "incorrect";
287 :
288 :			# get rid of the goofy prefix on the answer names (supposedly, the format
289 :			# of the answer names is changeable. this only fixes it for "AnSwEr"
290 :			#$name =~ s/^AnSwEr//;
291 :
292 :			my $pre = $numAns ? CGI::td(" ") : "";
293 :
294 :			$resultsRows{'Entered'} .= $showAttemptAnswers ?
295 :			CGI::Tr( $pre . $resultsData{'Entered'} .
296 :			CGI::td({-class=>"output"}, $self->nbsp($studentAnswer))) : "";
297 :			$resultsData{'Entered'} = '';
298 :			$resultsRows{'Preview'} .= $showAttemptPreview ?
299 :			CGI::Tr( $pre . $resultsData{'Preview'} .
300 :			CGI::td({-class=>"output"}, $self->nbsp($preview)) ) : "";
301 :			$resultsData{'Preview'} = '';
302 :			$resultsRows{'Correct'} .= $showCorrectAnswers ?
303 :			CGI::Tr( $pre . $resultsData{'Correct'} .
304 :			CGI::td({-class=>"output"}, $self->nbsp($correctAnswer)) ) : "";
305 :			$resultsData{'Correct'} = '';
306 :			$resultsRows{'Results'} .= $showAttemptResults ?
307 :			CGI::Tr( $pre . $resultsData{'Results'} .
308 :			CGI::td({-class=>"output"}, $self->nbsp($resultString)) ) : "";
309 :	glarose	4306	$resultsData{'Results'} = '';
310 :	glarose	3377	$resultsRows{'Messages'} .= $showMessages ?
311 :			CGI::Tr( $pre . $resultsData{'Messages'} .
312 :			CGI::td({-class=>"output"}, $self->nbsp($answerMessage)) ) : "";
313 :
314 :			$numAns++;
315 :			}
316 :	gage	1129
317 :	glarose	3377	# render equation images
318 :			$imgGen->render(refresh => 1);
319 :	gage	1129
320 :	glarose	3377	# my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
321 :			my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100);
322 :			# FIXME -- I left the old code in in case we have to back out.
323 :			# my $summary = "On this attempt, you answered $numCorrect out of "
324 :			# . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
325 :
326 :			my $summary = "";
327 :			if (scalar @answerNames == 1) {
328 :			if ($numCorrect == scalar @answerNames) {
329 :			$summary .= CGI::div({class=>"gwCorrect"},"This answer is correct.");
330 :			} else {
331 :			$summary .= CGI::div({class=>"gwIncorrect"},"This answer is NOT correct.");
332 :			}
333 :			} else {
334 :			if ($numCorrect == scalar @answerNames) {
335 :			$summary .= CGI::div({class=>"gwCorrect"},"All of these answers are correct.");
336 :			} else {
337 :			$summary .= CGI::div({class=>"gwIncorrect"},"At least one of these answers is NOT correct.");
338 :			}
339 :	gage	1129	}
340 :
341 :	glarose	3377	return
342 :			# CGI::table({-class=>"attemptResults"}, $resultsRows{'Entered'},
343 :			CGI::table({-class=>"gwAttemptResults"}, $resultsRows{'Entered'},
344 :			$resultsRows{'Preview'}, $resultsRows{'Correct'},
345 :			$resultsRows{'Results'}, $resultsRows{'Messages'}) .
346 :	sh002i	3768	($showSummary ? CGI::p({class=>'attemptResultsSummary'},$summary) : "");
347 :	glarose	3377	# CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows))
348 :			# . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
349 :	gage	1129	}
350 :
351 :	glarose	3377	# BeginPPM ###################################################################
352 :			# this code taken from Problem.pm; excerpted section ends at EndPPM
353 :			# modifications are flagged with comments GW
354 :
355 :			sub previewAnswer {
356 :	gage	1639	my ($self, $answerResult, $imgGen) = @_;
357 :	glarose	3377	my $ce = $self->r->ce;
358 :			my $EffectiveUser = $self->{effectiveUser};
359 :	gage	1138	my $set = $self->{set};
360 :			my $problem = $self->{problem};
361 :			my $displayMode = $self->{displayMode};
362 :
363 :			# note: right now, we have to do things completely differently when we are
364 :			# rendering math from INSIDE the translator and from OUTSIDE the translator.
365 :			# so we'll just deal with each case explicitly here. there's some code
366 :			# duplication that can be dealt with later by abstracting out tth/dvipng/etc.
367 :
368 :	gage	1639	my $tex = $answerResult->{preview_latex_string};
369 :	gage	1138
370 :	gage	1639	return "" unless defined $tex and $tex ne "";
371 :	gage	1138
372 :			if ($displayMode eq "plainText") {
373 :			return $tex;
374 :			} elsif ($displayMode eq "formattedText") {
375 :			my $tthCommand = $ce->{externalPrograms}->{tth}
376 :			. " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
377 :			. "\$".$tex."\$\n"
378 :			. "END_OF_INPUT\n";
379 :
380 :			# call tth
381 :			my $result = `$tthCommand`;
382 :			if ($?) {
383 :			return "<b>[tth failed: $? $@]</b>";
384 :	glarose	3377	} else {
385 :			return $result;
386 :	gage	1138	}
387 :			} elsif ($displayMode eq "images") {
388 :	glarose	3377	$imgGen->add($tex);
389 :			} elsif ($displayMode eq "jsMath") {
390 :	dpvc	4071	$tex =~ s/</</g; $tex =~ s/>/>/g;
391 :			return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>';
392 :	gage	1138	}
393 :			}
394 :
395 :	glarose	3377	# *EndPPM ######################################################################
396 :	gage	1138
397 :	glarose	3377	################################################################################
398 :			# Template escape implementations
399 :			################################################################################
400 :
401 :			# FIXME need to make $Set and $set be used consistently
402 :
403 :			sub pre_header_initialize {
404 :			my ($self) = @_;
405 :
406 :			my $r = $self->r;
407 :			my $ce = $r->ce;
408 :			my $db = $r->db;
409 :			my $authz = $r->authz;
410 :			my $urlpath = $r->urlpath;
411 :
412 :			my $setName = $urlpath->arg("setID");
413 :			my $userName = $r->param('user');
414 :			my $effectiveUserName = $r->param('effectiveUser');
415 :			my $key = $r->param('key');
416 :
417 :	glarose	4306	# this is a hack manage previewing a page. we set previewAnswers to
418 :			# yes if any of the following are true:
419 :			# 1. the "previewAnswers" input is set (the "preview" button was clicked),
420 :			# 2. the "previewHack" input is set (a preview link was used), or
421 :			# 3. the "previewingAnswersNow" and "newPage" inputs are set (the page
422 :			# is currently being previewed, and we're switching pages)
423 :			my $prevOr = $r->param('previewAnswers') \|\| $r->param('previewHack') \|\|
424 :			($r->param('previewingAnswersNow') && $r->param('newPage'));
425 :	glarose	3377	$r->param('previewAnswers', $prevOr) if ( defined( $prevOr ) );
426 :
427 :	glarose	4306	# we similarly hack checking answers
428 :			my $checkOr = $r->param('checkAnswers') \|\|
429 :			($r->param('checkingAnswersNow') && $r->param('newPage'));
430 :			$r->param('checkAnswers', $checkOr) if ( defined( $checkOr ) );
431 :
432 :	glarose	3377	my $User = $db->getUser($userName);
433 :			die "record for user $userName (real user) does not exist."
434 :			unless defined $User;
435 :			my $EffectiveUser = $db->getUser($effectiveUserName);
436 :			die "record for user $effectiveUserName (effective user) does not exist."
437 :			unless defined $EffectiveUser;
438 :
439 :			my $PermissionLevel = $db->getPermissionLevel($userName);
440 :			die "permission level record for $userName does not exist (but the " .
441 :			"user does? odd...)" unless defined($PermissionLevel);
442 :			my $permissionLevel = $PermissionLevel->permission;
443 :
444 :			# we could be coming in with $setName = the versioned or nonversioned set
445 :			# deal with that first
446 :			my $requestedVersion = ( $setName =~ /,v(\d+)$/ ) ? $1 : '';
447 :			$setName =~ s/,v\d+$//;
448 :			# note that if we're already working with a version we want to be sure to stick
449 :			# with that version. we do this after we've validated that the user is
450 :			# assigned the set, below
451 :
452 :			###################################
453 :			# gateway content generator tests
454 :			###################################
455 :
456 :			# get template set: the non-versioned set that's assigned to the user
457 :			my $tmplSet = $db->getMergedSet( $effectiveUserName, $setName );
458 :			die( "Set $setName hasn't been assigned to effective user " .
459 :			$effectiveUserName ) unless( defined( $tmplSet ) );
460 :
461 :			# ok, get the version number if we should be required to stay with a version
462 :			$requestedVersion =
463 :			$db->getUserSetVersionNumber($effectiveUserName, $setName)
464 :			if ( ( $r->param("previewAnswers") \|\| $r->param("checkAnswers") \|\|
465 :	glarose	4307	$r->param("submitAnswers") \|\| $r->param("newPage") )
466 :	glarose	4306	&& ! $requestedVersion );
467 :	glarose	3377	die("Requested version 0 when returning to problem?!")
468 :			if ( ( $r->param("previewAnswers") \|\| $r->param("checkAnswers") \|\|
469 :	glarose	4307	$r->param("submitAnswers") \|\| $r->param("newPage") )
470 :	glarose	4306	&& ! $requestedVersion );
471 :	glarose	3377
472 :	glarose	3842	# FIXME should we be more subtle than just die()ing here? c.f. Problem.pm,
473 :			# which sets $self->{invalidSet} and lets body() deal with it. for
474 :			# gateways I think we need to die() or skip the version creation
475 :			# conditional, or else we could get user versions of an unpublished
476 :			# set. FIXME
477 :	glarose	3377	die( "Invalid set $setName requested" )
478 :			if ( ! ( $tmplSet->published \|\|
479 :			$authz->hasPermissions($userName,"view_unpublished_sets") ) );
480 :
481 :			# if this set isn't a gateway test, we're in the wrong content generator
482 :			die("Set $setName isn't a gateway test. Error in ContentGenerator " .
483 :			"call.") if ( ! defined( $tmplSet->assignment_type() ) \|\|
484 :			$tmplSet->assignment_type() !~ /gateway/i );
485 :
486 :			# now we know that we're in a gateway test, save the assignment test for
487 :			# the processing of proctor keys for graded proctored tests
488 :			$self->{'assignment_type'} = $tmplSet->assignment_type();
489 :
490 :			# to test for a proctored test, we need the set version, not the template,
491 :			# which allows for a finished proctored test to be checked as an
492 :			# unproctored test. so we get the versioned set here
493 :			my $set = $db->getMergedVersionedSet($effectiveUserName, $setName,
494 :			$requestedVersion);
495 :
496 :			unless (defined $set) {
497 :			my $userSetClass = $ce->{dbLayout}->{set_user}->{record};
498 :			$set = global2user($userSetClass, $db->getGlobalSet($setName));
499 :			die "set $setName not found." unless $set;
500 :			$set->user_id($effectiveUserName);
501 :			$set->psvn('000');
502 :			$set->set_id("$setName,v0"); # set to establish the version number only
503 :			}
504 :			my $setVersionName = $set->set_id();
505 :			my ($setVersionNumber) = ($setVersionName =~ /.*,v(\d+)$/);
506 :
507 :			# proctor check to be sure that no one is trying to abuse the url path to sneak
508 :			# in the back door on a proctored test
509 :			# in the dispatcher we make sure that every call with a proctored url has a
510 :			# valid proctor authentication. so if we're here either we were called with
511 :			# an unproctored url, or we have a valid proctor authentication.
512 :			# this check is to be sure we have a valid proctor authentication for any test
513 :			# that has a proctored assignment type, preventing someone from trying to
514 :			# go to a proctored test with a hacked unproctored URL
515 :			if ( ( $requestedVersion && $set->assignment_type() =~ /proctored/i ) \|\|
516 :			( ! $requestedVersion && $tmplSet->assignment_type() =~ /proctored/i )
517 :			) {
518 :			# check against the requested set, if that is the one we're using, or against
519 :			# the template if no version was specified.
520 :			die("Set $setName requires a valid proctor login.")
521 :	sh002i	4049	if ( ! WeBWorK::Authen::Proctor->new($r, $ce, $db)->verify() );
522 :	glarose	3377	}
523 :
524 :			#################################
525 :			# assemble gateway parameters
526 :			#################################
527 :
528 :			# we get the open/close dates for the gateway from the template set.
529 :			# note $isOpen/Closed give the open/close dates for the gateway as a whole
530 :			my $isOpen = after($tmplSet->open_date()) \|\|
531 :			$authz->hasPermissions($userName, "view_unopened_sets");
532 :
533 :			# FIXME for $isClosed, "record_answers_after_due_date" isn't quite the
534 :			# right description, but it's probably reasonable for our purposes FIXME
535 :			my $isClosed = after($tmplSet->due_date()) &&
536 :			! $authz->hasPermissions($userName, "record_answers_after_due_date");
537 :
538 :			# to determine if we need a new version, we need to know whether this
539 :			# version exceeds the number of attempts per version. (among other
540 :			# things,) the number of attempts is a property of the problem, so
541 :			# get a problem to check that. note that for a gateway/quiz all
542 :	glarose	3842	# problems will have the same number of attempts. This means that if
543 :			# the set doesn't have any problems we're up a creek, so check for that
544 :			# here and bail if it's the case
545 :			my @setPNum = $db->listUserProblems($EffectiveUser->user_id, $setName);
546 :			die("Set $setName contains no problems.") if ( ! @setPNum );
547 :
548 :			# the Problem here might not be defined, if the set hasn't been versioned
549 :	glarose	3377	# to the user yet--this gets fixed when we assign the setVersion
550 :			my $Problem =
551 :			$db->getMergedVersionedProblem($EffectiveUser->user_id,
552 :	glarose	3842	$setName, $setVersionName, $setPNum[0]);
553 :	glarose	3377
554 :			# FIXME: is there any case where $maxAttemptsPerVersion shouldn't be
555 :			# finite? For the moment we don't deal with this here FIXME
556 :			my $maxAttemptsPerVersion = $tmplSet->attempts_per_version();
557 :			my $timeInterval = $tmplSet->time_interval();
558 :			my $versionsPerInterval = $tmplSet->versions_per_interval();
559 :			my $timeLimit = $tmplSet->version_time_limit();
560 :
561 :			# these both work because every problem in the set must have the same
562 :			# submission characteristics
563 :			my $currentNumAttempts = ( defined($Problem) ? $Problem->num_correct() +
564 :			$Problem->num_incorrect() : 0 );
565 :
566 :			# $maxAttempts turns into the maximum number of versions we can create;
567 :			# if $Problem isn't defined, we can't have made any attempts, so it
568 :			# doesn't matter
569 :			# FIXME: I'm using max_attempts == 0, instead of -1; does this matter?
570 :			my $maxAttempts = ( defined($Problem) &&
571 :			defined($Problem->max_attempts()) &&
572 :			$Problem->max_attempts() != -1 ?
573 :			$Problem->max_attempts() : 0 );
574 :
575 :			# finding the number of versions per time interval is a little harder. we
576 :			# interpret the time interval as a rolling interval: that is, if we allow
577 :			# two sets per day, that's two sets in any 24 hour period. this is
578 :			# probably not what we really want, but it's more extensible to a
579 :			# limitation like "one version per hour", and we can set it to two sets
580 :			# per 12 hours for most "2ce daily" type applications
581 :			my $timeNow = time();
582 :	glarose	3842	my $grace = $ce->{gatewayGracePeriod};
583 :
584 :	glarose	3377	my $currentNumVersions = 0; # this is the number of versions in the last
585 :			# time interval
586 :			my $totalNumVersions = 0;
587 :
588 :			if ( $setVersionNumber ) {
589 :			my @setVersions = $db->getUserSetVersions($effectiveUserName,$setName,
590 :			$setVersionNumber);
591 :			foreach ( @setVersions ) {
592 :			$totalNumVersions++;
593 :			$currentNumVersions++
594 :			if ( $_->version_creation_time() > ($timeNow - $timeInterval) );
595 :			}
596 :			}
597 :
598 :			####################################
599 :			# new version creation conditional
600 :			####################################
601 :
602 :			my $versionIsOpen = 0; # can we do anything to this version?
603 :
604 :			if ( $isOpen && ! $isClosed ) { # this makes sense, really
605 :
606 :			# if no specific version is requested, we can create a new one if
607 :			# need be
608 :			if ( ! $requestedVersion ) {
609 :			if (
610 :			( ! $maxAttempts \|\| $totalNumVersions < $maxAttempts )
611 :			&&
612 :			( $setVersionNumber == 0 \|\|
613 :			(
614 :			( $currentNumAttempts >= $maxAttemptsPerVersion
615 :			\|\|
616 :	glarose	3842	$timeNow >= $set->due_date + $grace )
617 :	glarose	3377	&&
618 :			( ! $versionsPerInterval
619 :			\|\|
620 :			$currentNumVersions < $versionsPerInterval )
621 :			)
622 :			)
623 :			&&
624 :			( $effectiveUserName eq $userName \|\|
625 :			$authz->hasPermissions($effectiveUserName,
626 :			"record_answers_when_acting_as_student") )
627 :			) {
628 :
629 :			# assign set, get the right name, version number, etc., and redefine
630 :			# the $set and $Problem we're working with
631 :			my $setTmpl = $db->getUserSet($effectiveUserName,$setName);
632 :			WeBWorK::ContentGenerator::Instructor::assignSetVersionToUser(
633 :			$self, $effectiveUserName, $setTmpl);
634 :			$setVersionNumber++;
635 :			$setVersionName = "$setName,v$setVersionNumber";
636 :			$set = $db->getMergedVersionedSet($userName,$setName,
637 :			$setVersionNumber);
638 :
639 :			$Problem = $db->getMergedVersionedProblem($userName,$setName,
640 :			$setVersionName,1);
641 :			# because we're creating this on the fly, it should be published
642 :			$set->published(1);
643 :			# set up creation time, open and due dates
644 :			$set->version_creation_time( $timeNow );
645 :			$set->open_date( $timeNow );
646 :			$set->due_date( $timeNow+$timeLimit );
647 :			$set->answer_date( $timeNow+$timeLimit );
648 :			$set->version_last_attempt_time( 0 );
649 :			# put this new info into the database. note that this means that -all- of
650 :			# the merged information gets put back into the database. as long as
651 :			# the version doesn't have a long lifespan, this is ok...
652 :			$db->putVersionedUserSet( $set );
653 :
654 :			# we have a new set version, so it's open
655 :			$versionIsOpen = 1;
656 :
657 :			# also reset the number of attempts for this set; this will be zero
658 :			$currentNumAttempts = $Problem->num_correct() +
659 :			$Problem->num_incorrect();
660 :
661 :			} elsif ( $maxAttempts && $totalNumVersions > $maxAttempts ) {
662 :			$self->{invalidSet} = "No new versions of this assignment " .
663 :			"are available,\nbecause you have already taken the " .
664 :			"maximum number\nallowed.";
665 :
666 :			} elsif ( $currentNumAttempts < $maxAttemptsPerVersion &&
667 :	glarose	3842	$timeNow < $set->due_date() + $grace ) {
668 :	glarose	3377
669 :	glarose	3842	if ( between($set->open_date(), $set->due_date() + $grace, $timeNow) ) {
670 :	glarose	3377	$versionIsOpen = 1;
671 :			} else {
672 :			$versionIsOpen = 0; # redundant; default is 0
673 :			$self->{invalidSet} = "No new versions of this assignment" .
674 :			"are available,\nbecause the set is not open or its" .
675 :			"time limit has expired.\n";
676 :			}
677 :
678 :			} elsif ( $versionsPerInterval &&
679 :			( $currentNumVersions >= $versionsPerInterval ) ) {
680 :			$self->{invalidSet} = "You have already taken all available " .
681 :			"versions of this\ntest in the current time interval. " .
682 :			"You may take the\ntest again after the time interval " .
683 :			"has expired.";
684 :
685 :			}
686 :
687 :			} else {
688 :			# (we're still in the $isOpen && ! $isClosed conditional here)
689 :			# if a specific version is requested, then we only check to see if it's open
690 :			if (
691 :			( $currentNumAttempts < $maxAttemptsPerVersion )
692 :			&&
693 :			( $effectiveUserName eq $userName \|\|
694 :			$authz->hasPermissions($effectiveUserName,
695 :			"record_answers_when_acting_as_student") )
696 :			) {
697 :	glarose	3842	if ( between($set->open_date(), $set->due_date() + $grace, $timeNow) ) {
698 :	glarose	3377	$versionIsOpen = 1;
699 :			} else {
700 :			$versionIsOpen = 0; # redundant; default is 0
701 :			}
702 :			}
703 :			}
704 :
705 :			# set isn't available.
706 :			} elsif ( ! $isOpen ) {
707 :			$self->{invalidSet} = "This assignment is not open.";
708 :
709 :			} elsif ( ! $requestedVersion ) { # closed set, with attempt at a new one
710 :			$self->{invalidSet} = "This set is closed. No new set versions may " .
711 :			"be taken.";
712 :			}
713 :
714 :
715 :			####################################
716 :			# save problem and user data
717 :			####################################
718 :
719 :			my $psvn = $set->psvn();
720 :			$self->{set} = $set;
721 :			$self->{problem} = $Problem;
722 :			$self->{requestedVersion} = $requestedVersion;
723 :	gage	1129
724 :	glarose	3377	$self->{userName} = $userName;
725 :			$self->{effectiveUserName} = $effectiveUserName;
726 :			$self->{user} = $User;
727 :			$self->{effectiveUser} = $EffectiveUser;
728 :			$self->{permissionLevel} = $permissionLevel;
729 :
730 :			$self->{isOpen} = $isOpen;
731 :			$self->{isClosed} = $isClosed;
732 :			$self->{versionIsOpen} = $versionIsOpen;
733 :	glarose	3842
734 :			$self->{timeNow} = $timeNow;
735 :	gage	1129
736 :	glarose	3377	####################################
737 :			# form processing
738 :			####################################
739 :
740 :	glarose	4306	# this is the same as the following, but doesn't appear in Problem.pm
741 :			my $newPage = $r->param("newPage");
742 :			$self->{newPage} = $newPage;
743 :
744 :	glarose	3377	# BeginPPM ###################################################################
745 :
746 :			# set options from form fields (see comment at top of file for names)
747 :			my $displayMode = $r->param("displayMode") \|\|
748 :			$ce->{pg}->{options}->{displayMode};
749 :			my $redisplay = $r->param("redisplay");
750 :			my $submitAnswers = $r->param("submitAnswers");
751 :			my $checkAnswers = $r->param("checkAnswers");
752 :			my $previewAnswers = $r->param("previewAnswers");
753 :
754 :			my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
755 :
756 :			$self->{displayMode} = $displayMode;
757 :			$self->{redisplay} = $redisplay;
758 :			$self->{submitAnswers} = $submitAnswers;
759 :			$self->{checkAnswers} = $checkAnswers;
760 :			$self->{previewAnswers} = $previewAnswers;
761 :			$self->{formFields} = $formFields;
762 :
763 :			# get result and send to message
764 :			my $success = $r->param("sucess");
765 :			my $failure = $r->param("failure");
766 :			$self->addbadmessage(CGI::p($failure)) if $failure;
767 :			$self->addgoodmessage(CGI::p($success)) if $success;
768 :
769 :			# now that we've set all the necessary variables quit out if the set or
770 :			# problem is invalid
771 :			return if $self->{invalidSet} \|\| $self->{invalidProblem};
772 :
773 :			# EndPPM #####################################################################
774 :
775 :			####################################
776 :			# permissions
777 :			####################################
778 :
779 :			# bail without doing anything if the set isn't yet open for this user
780 :			return unless $self->{isOpen};
781 :
782 :			# what does the user want to do?
783 :			my %want =
784 :			(showOldAnswers => $r->param("showOldAnswers") \|\|
785 :			$ce->{pg}->{options}->{showOldAnswers},
786 :			showCorrectAnswers => $r->param("showCorrectAnswers") \|\|
787 :			$ce->{pg}->{options}->{showCorrectAnswers},
788 :			showHints => $r->param("showHints") \|\|
789 :			$ce->{pg}->{options}->{showHints},
790 :			showSolutions => $r->param("showSolutions") \|\|
791 :			$ce->{pg}->{options}->{showSolutions},
792 :			recordAnswers => $submitAnswers,
793 :			checkAnswers => $checkAnswers,
794 :			);
795 :
796 :			# are certain options enforced?
797 :			my %must =
798 :			(showOldAnswers => 0,
799 :			showCorrectAnswers => 0,
800 :			showHints => 0,
801 :			showSolutions => 0,
802 :			recordAnswers => ! $authz->hasPermissions($userName,
803 :			"avoid_recording_answers"),
804 :			checkAnswers => 0,
805 :			);
806 :
807 :			# does the user have permission to use certain options?
808 :			my @args = ($User, $PermissionLevel, $EffectiveUser, $set, $Problem );
809 :			my $sAns = ( $submitAnswers ? 1 : 0 );
810 :			my %can =
811 :			(showOldAnswers => $self->can_showOldAnswers(@args),
812 :			showCorrectAnswers => $self->can_showCorrectAnswers(@args, $sAns),
813 :			showHints => $self->can_showHints(@args),
814 :			showSolutions => $self->can_showSolutions(@args, $sAns),
815 :			recordAnswers => $self->can_recordAnswers(@args),
816 :			checkAnswers => $self->can_checkAnswers(@args),
817 :			recordAnswersNextTime => $self->can_recordAnswers(@args, $sAns),
818 :			checkAnswersNextTime => $self->can_checkAnswers(@args, $sAns),
819 :	gage	1639	);
820 :	glarose	3377
821 :			# final values for options
822 :			# warn("back - next time, " . $can{recordAnswersNextTime} . "\n");
823 :			my %will;
824 :			foreach (keys %must) {
825 :			$will{$_} = $can{$_} && ($must{$_} \|\| $want{$_}) ;
826 :			}
827 :
828 :			##### store fields #####
829 :
830 :			## FIXME: the following is present in Problem.pm, but missing here. how do we
831 :			## deal with it in the context of multiple problems with possible hints?
832 :			## ##### fix hint/solution options #####
833 :			## $can{showHints} &&= $pg->{flags}->{hintExists}
834 :			## &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans};
835 :			## $can{showSolutions} &&= $pg->{flags}->{solutionExists};
836 :	gage	1639
837 :	glarose	3377	$self->{want} = \%want;
838 :			$self->{must} = \%must;
839 :			$self->{can} = \%can;
840 :			$self->{will} = \%will;
841 :	gage	1639
842 :	glarose	3377
843 :			####################################
844 :			# process problems
845 :			####################################
846 :
847 :			my @problemNumbers = $db->listUserProblems($effectiveUserName,
848 :			$setVersionName);
849 :			my @problems = ();
850 :			my @pg_results = ();
851 :
852 :			foreach my $problemNumber (sort {$a<=>$b } @problemNumbers) {
853 :			my $ProblemN = $db->getMergedVersionedProblem($effectiveUserName,
854 :			$setName,
855 :			$setVersionName,
856 :			$problemNumber);
857 :
858 :			# sticky answers are set up here
859 :	glarose	4306	if ( not ( $submitAnswers or $previewAnswers or $checkAnswers or
860 :			$newPage ) and $will{showOldAnswers} ) {
861 :			# FIXME: sorting out sticky answers on multiple page tests here
862 :			# if ( not ( $submitAnswers or $previewAnswers or $checkAnswers )
863 :			# and $will{showOldAnswers} ) {
864 :	glarose	3377	my %oldAnswers = decodeAnswers( $ProblemN->last_answer );
865 :			$formFields->{$_} = $oldAnswers{$_} foreach ( keys %oldAnswers );
866 :	glarose	4306
867 :			# foreach ( keys %oldAnswers ) {
868 :			# if ( ! $newPage \|\|
869 :			# ( $newPage && ( ! defined( $formFields->{$_} ) \|\|
870 :			# ! $formFields->{$_} ) ) ) {
871 :			# if ( ! defined( $formFields->{$_} ) ) {
872 :			# $formFields->{$_} = $oldAnswers{$_};
873 :			# }
874 :			# }
875 :	gage	1129	}
876 :	glarose	3377	push( @problems, $ProblemN );
877 :
878 :			# this is the actual translation of each problem. errors are stored in
879 :			# @{$self->{errors}} in each case
880 :			my $pg = $self->getProblemHTML( $self->{effectiveUser}, $setVersionName,
881 :			$formFields, $ProblemN );
882 :			push(@pg_results, $pg);
883 :			}
884 :			$self->{ra_problems} = \@problems;
885 :			$self->{ra_pg_results}=\@pg_results;
886 :
887 :			}
888 :
889 :			sub path {
890 :			my ( $self, $args ) = @_;
891 :
892 :			my $r = $self->{r};
893 :			my $setName = $r->urlpath->arg("setID");
894 :			my $ce = $self->{ce};
895 :			my $root = $ce->{webworkURLs}->{root};
896 :			my $courseName = $ce->{courseName};
897 :
898 :			return $self->pathMacro( $args, "Home" => "$root",
899 :			$courseName => "$root/$courseName",
900 :			$setName => "" );
901 :			}
902 :
903 :			sub nav {
904 :			my ($self, $args) = @_;
905 :	gage	1129
906 :	glarose	3377	my $r = $self->{r};
907 :			my $setName = $r->urlpath->arg("setID");
908 :			my $ce = $self->{ce};
909 :			my $root = $ce->{webworkURLs}->{root};
910 :			my $courseName = $ce->{courseName};
911 :			my @links = ("Problem Sets" , "$root/$courseName", "navUp");
912 :			my $tail = "";
913 :
914 :			return $self->navMacro($args, $tail, @links);
915 :			}
916 :	gage	1639
917 :	glarose	3377	sub options {
918 :			my ($self) = @_;
919 :	sh002i	3767	#warn "doing options in GatewayQuiz";
920 :	glarose	3377
921 :	sh002i	3767	# don't show options if we don't have anything to show
922 :			return if $self->{invalidSet} or $self->{invalidProblem};
923 :			return unless $self->{isOpen};
924 :	glarose	3377
925 :	sh002i	3767	my $displayMode = $self->{displayMode};
926 :			my %can = %{ $self->{can} };
927 :
928 :			my @options_to_show = "displayMode";
929 :			push @options_to_show, "showOldAnswers" if $can{showOldAnswers};
930 :			push @options_to_show, "showHints" if $can{showHints};
931 :			push @options_to_show, "showSolutions" if $can{showSolutions};
932 :
933 :			return $self->optionsMacro(
934 :			options_to_show => \@options_to_show,
935 :	glarose	3377	);
936 :	gage	1129	}
937 :	gage	1138
938 :	glarose	3377	sub body {
939 :			my $self = shift();
940 :			my $r = $self->r;
941 :			my $ce = $r->ce;
942 :			my $db = $r->db;
943 :			my $authz = $r->authz;
944 :			my $urlpath = $r->urlpath;
945 :			my $user = $r->param('user');
946 :			my $effectiveUser = $r->param('effectiveUser');
947 :	gage	1138
948 :	glarose	3842	# report everything with the same time that we started with
949 :			my $timeNow = $self->{timeNow};
950 :			my $grace = $ce->{gatewayGracePeriod};
951 :	gage	1138
952 :	glarose	3377	#########################################
953 :			# preliminary error checking and output
954 :			#########################################
955 :	gage	1138
956 :	glarose	3377	# basic error checking: is the set actually open?
957 :			unless ( $self->{isOpen} ) {
958 :			return CGI::div({class=>"ResultsWithError"},
959 :			CGI::p("This assignment is not open yet, and " .
960 :			"therefore is not yet available"));
961 :			}
962 :			# if we set the invalid flag, we may want this too
963 :			if ($self->{invalidSet}) {
964 :			# delete any proctor keys that are floating around
965 :			if ( $self->{'assignment_type'} eq 'proctored_gateway' ) {
966 :			my $proctorID = $r->param('proctor_user');
967 :			eval{ $db->deleteKey( "$effectiveUser,$proctorID" ); };
968 :			eval{ $db->deleteKey( "$effectiveUser,$proctorID,g" ); };
969 :			}
970 :	gage	1138
971 :	glarose	3377	return CGI::div({class=>"ResultsWithError"},
972 :			CGI::p("The selected problem set (" .
973 :			$urlpath->arg("setID") . ") is not a valid set" .
974 :			" for $effectiveUser."),
975 :			CGI::p("This is because: " . $self->{invalidSet}));
976 :			}
977 :
978 :			my $set = $self->{set};
979 :			my $Problem = $self->{problem};
980 :			my $permissionLevel = $self->{permissionLevel};
981 :			my $submitAnswers = $self->{submitAnswers};
982 :			my $checkAnswers = $self->{checkAnswers};
983 :			my $previewAnswers = $self->{previewAnswers};
984 :	glarose	4306	my $newPage = $self->{newPage};
985 :	glarose	3377	my %want = %{ $self->{want} };
986 :			my %can = %{ $self->{can} };
987 :			my %must = %{ $self->{must} };
988 :			my %will = %{ $self->{will} };
989 :			my @problems = @{ $self->{ra_problems} };
990 :			my @pg_results = @{ $self->{ra_pg_results} };
991 :			my @pg_errors = @{ $self->{errors} };
992 :			my $requestedVersion = $self->{requestedVersion};
993 :	gage	1138
994 :	glarose	3377	my $setVersionName = $set->set_id;
995 :			my ( $setName ) = ( $setVersionName =~ /(.*),v\d+$/ );
996 :			my ( $versionNumber ) = ( $setVersionName =~ /.*,v(\d+)$/ );
997 :	gage	1138
998 :	glarose	3377	# translation errors -- we use the same output routine as Problem.pm, but
999 :			# play around to allow for errors on multiple translations because we
1000 :			# have an array of problems to deal with.
1001 :			if ( @pg_errors ) {
1002 :			my $errorNum = 1;
1003 :			my ( $message, $context ) = ( '', '' );
1004 :			foreach ( @pg_errors ) {
1005 :	gage	1138
1006 :	glarose	3377	$message .= "$errorNum. " if ( @pg_errors > 1 );
1007 :			$message .= $_->{message} . CGI::br() . "\n";
1008 :	gage	1138
1009 :	glarose	3377	$context .= CGI::p( (@pg_errors > 1 ? "$errorNum." : '') .
1010 :			$_->{context} ) . "\n\n" . CGI::hr() . "\n\n";
1011 :			}
1012 :			return $self->errorOutput( $message, $context );
1013 :			}
1014 :
1015 :			####################################
1016 :			# answer processing
1017 :			####################################
1018 :
1019 :	sh002i	3485	debug("begin answer processing");
1020 :	glarose	3377
1021 :			my @scoreRecordedMessage = ('') x scalar(@problems);
1022 :
1023 :			if ( $submitAnswers ) {
1024 :
1025 :			# if we're submitting answers for a proctored exam, we want to delete
1026 :			# the proctor keys that authorized that grading, so that it isn't possible
1027 :			# to just log in and take another proctored test without getting
1028 :			# reauthorized
1029 :			if ( $self->{'assignment_type'} eq 'proctored_gateway' ) {
1030 :			my $proctorID = $r->param('proctor_user');
1031 :			eval{ $db->deleteKey( "$effectiveUser,$proctorID" ); };
1032 :			# we should be more subtle than die()ing, but this is a potentially
1033 :			# big problem
1034 :			if ( $@ ) {
1035 :			die("ERROR RESETTING PROCTOR KEY: $@\n");
1036 :			}
1037 :			eval{ $db->deleteKey( "$effectiveUser,$proctorID,g" ); };
1038 :			if ( $@ ) {
1039 :			die("ERROR RESETTING PROCTOR GRADING KEY: $@\n");
1040 :			}
1041 :			}
1042 :
1043 :			foreach my $i ( 0 .. $#problems ) { # process each problem in g/w
1044 :			# this code is essentially that from Problem.pm
1045 :			my $pureProblem = $db->getUserProblem( $problems[$i]->user_id,
1046 :			$setVersionName,
1047 :			$problems[$i]->problem_id );
1048 :			# this should be defined unless it's not assigned yet, in which case
1049 :			# we should have die()ed earlier, but what's an extra conditional
1050 :			# between friends?
1051 :			if ( defined( $pureProblem ) ) {
1052 :			# store answers in problem for sticky answers later
1053 :			my %answersToStore;
1054 :			my %answerHash = %{$pg_results[$i]->{answers}};
1055 :			$answersToStore{$_} =
1056 :			$self->{formFields}->{$_} foreach ( keys %answerHash );
1057 :			# check for extra answers that slipped by---e.g. for matrices, and get
1058 :			# them from the original input form
1059 :			my @extra_answer_names =
1060 :			@{ $pg_results[$i]->{flags}->{KEPT_EXTRA_ANSWERS} };
1061 :			$answersToStore{$_} =
1062 :			$self->{formFields}->{$_} foreach ( @extra_answer_names );
1063 :			# now encode all answers
1064 :			my @answer_order =
1065 :			( @{$pg_results[$i]->{flags}->{ANSWER_ENTRY_ORDER}},
1066 :			@extra_answer_names );
1067 :			my $answerString = encodeAnswers( %answersToStore,
1068 :			@answer_order );
1069 :			# and store the last answer to the database
1070 :			$problems[$i]->last_answer( $answerString );
1071 :			$pureProblem->last_answer( $answerString );
1072 :			my $versioned = 1;
1073 :			$db->putUserProblem( $pureProblem, $versioned );
1074 :
1075 :			# next, store the state in the database if that makes sense
1076 :			if ( $will{recordAnswers} ) {
1077 :			$problems[$i]->status($pg_results[$i]->{state}->{recorded_score});
1078 :			$problems[$i]->attempted(1);
1079 :			$problems[$i]->num_correct($pg_results[$i]->{state}->{num_of_correct_ans});
1080 :			$problems[$i]->num_incorrect($pg_results[$i]->{state}->{num_of_incorrect_ans});
1081 :			$pureProblem->status($pg_results[$i]->{state}->{recorded_score});
1082 :			$pureProblem->attempted(1);
1083 :			$pureProblem->num_correct($pg_results[$i]->{state}->{num_of_correct_ans});
1084 :			$pureProblem->num_incorrect($pg_results[$i]->{state}->{num_of_incorrect_ans});
1085 :
1086 :			if ( $db->putUserProblem( $pureProblem, $versioned ) ) {
1087 :			$scoreRecordedMessage[$i] = "Your score on this " .
1088 :			"problem was recorded.";
1089 :			} else {
1090 :			$scoreRecordedMessage[$i] = "Your score was not " .
1091 :			"recorded because there was a failure in storing " .
1092 :			"the problem record to the database.";
1093 :			}
1094 :			# write the transaction log
1095 :			writeLog( $self->{ce}, "transaction",
1096 :			$problems[$i]->problem_id . "\t" .
1097 :			$problems[$i]->set_id . "\t" .
1098 :			$problems[$i]->user_id . "\t" .
1099 :			$problems[$i]->source_file . "\t" .
1100 :			$problems[$i]->value . "\t" .
1101 :			$problems[$i]->max_attempts . "\t" .
1102 :			$problems[$i]->problem_seed . "\t" .
1103 :			$problems[$i]->status . "\t" .
1104 :			$problems[$i]->attempted . "\t" .
1105 :			$problems[$i]->last_answer . "\t" .
1106 :			$problems[$i]->num_correct . "\t" .
1107 :			$problems[$i]->num_incorrect
1108 :			);
1109 :			} else {
1110 :
1111 :			if ($self->{isClosed}) {
1112 :			$scoreRecordedMessage[$i] = "Your score was not " .
1113 :			"recorded because this problem set version is " .
1114 :			"not open.";
1115 :			} elsif ( $problems[$i]->num_correct +
1116 :			$problems[$i]->num_incorrect >=
1117 :			$set->attempts_per_version ) {
1118 :			$scoreRecordedMessage[$i] = "Your score was not " .
1119 :			"recorded because you have no attempts " .
1120 :			"remaining on this set version.";
1121 :			} elsif ( ! $self->{versionIsOpen} ) {
1122 :	glarose	3842	my $endTime = ( $set->version_last_attempt_time ) ?
1123 :			$set->version_last_attempt_time : $timeNow;
1124 :			if ( $endTime > $set->due_date &&
1125 :			$endTime < $set->due_date + $grace ) {
1126 :			$endTime = $set->due_date;
1127 :			}
1128 :			# sprintf forces two decimals, which we don't like
1129 :			# my $elapsed = sprintf("%4.2f",($endTime -
1130 :			# $set->open_date)/60);
1131 :			my $elapsed =
1132 :	glarose	3852	int(($endTime - $set->open_date)/0.6 + 0.5)/100;
1133 :	glarose	3842	# we assume that allowed is an even number of minutes
1134 :			my $allowed = ($set->due_date - $set->open_date)/60;
1135 :	glarose	3377	$scoreRecordedMessage[$i] = "Your score was not " .
1136 :			"recorded because you have exceeded the time " .
1137 :	glarose	3842	"limit for this test. (Time taken: $elapsed min;" .
1138 :			" allowed: $allowed min.)";
1139 :	glarose	3377	} else {
1140 :			$scoreRecordedMessage[$i] = "Your score was not " .
1141 :			"recorded.";
1142 :			}
1143 :			}
1144 :			} else {
1145 :			# I don't think this should ever happen, because we die() out of the
1146 :			# pre_header_initialize routine when we have the same situation
1147 :			$scoreRecordedMessage[$i] = "Your score was not recorded, " .
1148 :			"because this problem set has not been assigned to you.";
1149 :			}
1150 :			# log student answers
1151 :			my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'};
1152 :
1153 :			# this is carried over from Problem.pm
1154 :			if ( defined( $answer_log ) && defined( $pureProblem ) ) {
1155 :			if ( $submitAnswers ) {
1156 :			my $answerString = '';
1157 :			my %answerHash = %{ $pg_results[$i]->{answers} };
1158 :			# FIXME fix carried over from Problem.pm for "line 552 error"
1159 :
1160 :			foreach ( sort keys %answerHash ) {
1161 :			my $student_ans =
1162 :			$answerHash{$_}->{original_student_ans} \|\| '';
1163 :			$answerString .= $student_ans . "\t";
1164 :			}
1165 :			$answerString = '' unless defined( $answerString );
1166 :
1167 :			writeCourseLog( $self->{ce}, "answer_log",
1168 :			join("", '\|', $problems[$i]->user_id,
1169 :			'\|', $problems[$i]->set_id,
1170 :			'\|', $problems[$i]->problem_id,
1171 :			'\|', "\t$timeNow\t",
1172 :			$answerString),
1173 :			);
1174 :			}
1175 :			}
1176 :			} # end loop through problems
1177 :
1178 :			} # end if submitAnswers conditional
1179 :	sh002i	3485	debug("end answer processing");
1180 :	glarose	3377
1181 :	glarose	3842	# additional set-level database manipulation: we want to save the time
1182 :			# that a set was submitted, and for proctored tests we want to reset
1183 :			# the assignment type after a set is submitted for the last time so
1184 :			# that it's possible to look at it later without getting proctor
1185 :			# authorization
1186 :			if ( ( $submitAnswers &&
1187 :			( $will{recordAnswers} \|\|
1188 :			( ! $set->version_last_attempt_time() &&
1189 :			$timeNow > $set->due_date + $grace ) ) ) \|\|
1190 :	glarose	3377	( ! $can{recordAnswersNextTime} &&
1191 :			$set->assignment_type() eq 'proctored_gateway' ) ) {
1192 :
1193 :			my $setName = $set->set_id();
1194 :
1195 :	glarose	3842	# save the submission time if we're recording the answer, or if the
1196 :			# first submission occurs after the due_date
1197 :			if ( $submitAnswers &&
1198 :			( $will{recordAnswers} \|\|
1199 :			( ! $set->version_last_attempt_time() &&
1200 :			$timeNow > $set->due_date + $grace ) ) ) {
1201 :	glarose	3377	$set->version_last_attempt_time( $timeNow );
1202 :			}
1203 :			if ( ! $can{recordAnswersNextTime} &&
1204 :			$set->assignment_type() eq 'proctored_gateway' ) {
1205 :			$set->assignment_type( 'gateway' );
1206 :			}
1207 :			$db->putVersionedUserSet( $set );
1208 :			}
1209 :
1210 :
1211 :
1212 :			####################################
1213 :			# output
1214 :			####################################
1215 :
1216 :	glarose	4306	# set up variables to deal with multi-page tests
1217 :			my ($numPages, $pageNumber, $numProbPerPage) = (0, 0, 0);
1218 :			my ($startProb, $endProb) = (0, $#pg_results);
1219 :			# these are changed if the test is a multi-page test
1220 :			if ( $set->problems_per_page() ) {
1221 :			$numProbPerPage = $set->problems_per_page();
1222 :			$pageNumber = ( $newPage ) ? $newPage : 1;
1223 :
1224 :			$numPages = scalar(@problems)/$numProbPerPage;
1225 :			$numPages = int($numPages) + 1 if ( int($numPages) != $numPages );
1226 :
1227 :			$startProb = ($pageNumber - 1)*$numProbPerPage;
1228 :			$startProb = 0 if ( $startProb < 0 \|\| $startProb > $#pg_results );
1229 :			$endProb = ($startProb + $numProbPerPage > $#pg_results) ?
1230 :			$#pg_results : $startProb + $numProbPerPage - 1;
1231 :			}
1232 :
1233 :	glarose	3842	# figure out score on this attempt, and recorded score for the set, if any
1234 :			my $recordedScore = 0;
1235 :	glarose	3377	my $totPossible = 0;
1236 :	glarose	3842	# foreach ( @pg_results ) {
1237 :			foreach ( @problems ) {
1238 :			# FIXME: this requires all problems to have weight 1
1239 :			$totPossible++;
1240 :			# $recordedScore += $_->{state}->{recorded_score}
1241 :			# if ( defined( $_->{state}->{recorded_score} ) );
1242 :			$recordedScore += $_->{status} if ( defined( $_->status ) );
1243 :			}
1244 :
1245 :			my $attemptScore = 0;
1246 :			if ( $submitAnswers \|\| $checkAnswers ) {
1247 :			foreach my $pg ( @pg_results ) {
1248 :	glarose	3852	# to get the current result, we need to go through the parts of each problem
1249 :			# (is there a better way of doing this?) FIXME: factor in problem weight
1250 :	glarose	3842	foreach ( @{$pg->{flags}->{ANSWER_ENTRY_ORDER}} ) {
1251 :			$attemptScore += $pg->{answers}->{$_}->{score};
1252 :			}
1253 :	glarose	3377	}
1254 :			}
1255 :
1256 :	glarose	3842	# we want to print elapsed and allowed times; allowed is easy (we assume
1257 :			# this is an even number of minutes)
1258 :			my $allowed = ($set->due_date - $set->open_date)/60;
1259 :			# elapsed is a little harder; we're counting to the last submission
1260 :			# time, or to the current time if the test hasn't been submitted, and if the
1261 :			# submission fell in the grace period round it to the due_date
1262 :			my $exceededAllowedTime = 0;
1263 :			my $endTime = ( $set->version_last_attempt_time ) ?
1264 :			$set->version_last_attempt_time : $timeNow;
1265 :			if ( $endTime > $set->due_date && $endTime < $set->due_date + $grace ) {
1266 :			$endTime = $set->due_date;
1267 :			} elsif ( $endTime > $set->due_date ) {
1268 :			$exceededAllowedTime = 1;
1269 :			}
1270 :			my $elapsed = int(($endTime - $set->open_date)/0.6 + 0.5)/100;
1271 :
1272 :			if ( $submitAnswers ) {
1273 :	glarose	3377	my $divClass = '';
1274 :			my $recdMsg = '';
1275 :			foreach ( @scoreRecordedMessage ) {
1276 :			if ( $_ ne 'Your score on this problem was recorded.' ) {
1277 :			$recdMsg = $_;
1278 :			last;
1279 :			}
1280 :			}
1281 :	glarose	3842	if ( $recdMsg ) {
1282 :			$divClass = 'ResultsWithError';
1283 :			$recdMsg = "Your score on this test was NOT recorded. " . $recdMsg;
1284 :			} else {
1285 :	glarose	3377	$divClass = 'ResultsWithoutError';
1286 :			$recdMsg = "Your score on this test was recorded.";
1287 :			}
1288 :
1289 :	glarose	3842	print CGI::start_div({class=>"$divClass"});
1290 :	glarose	4306	print CGI::strong("Your score on this test (number " .
1291 :	glarose	3842	"$versionNumber) is $attemptScore / " .
1292 :			"$totPossible"), CGI::br();
1293 :			if ( $will{recordAnswers} ) { # then this is a counted submission
1294 :			print CGI::strong("Time taken: $elapsed min (allowed: $allowed)"),
1295 :			CGI::br();
1296 :			}
1297 :			print CGI::strong("$recdMsg"), CGI::br() if ( $recdMsg );
1298 :			print CGI::end_div();
1299 :			} elsif ( $checkAnswers ) {
1300 :			print CGI::start_div({class=>"gwMessage"});
1301 :			print "Your score on this (checked, not recorded) submission " .
1302 :			"is $attemptScore / $totPossible", CGI::end_div();
1303 :	glarose	3377	}
1304 :
1305 :			if ( ! $can{recordAnswersNextTime} ) {
1306 :	glarose	3842	# if we can't record answers any more, then we want to add any message about
1307 :			# that, note if there's a recorded score, and be sure to flag any tests that
1308 :			# are overtime. (it's worth the effort to be careful about labeling tests
1309 :			# this way mainly so that when students print a test and bring it in we know
1310 :			# what's going on.)
1311 :	glarose	3377
1312 :	glarose	3842	my $timemsg = '';
1313 :	glarose	4327	# FIXME: add printme link
1314 :			my $link = $ce->{webworkURLs}->{root} . '/' . $ce->{courseName} .
1315 :			'/hardcopy/' . $set->set_id . '/?' . $self->url_authen_args;
1316 :			my $printmsg = CGI::div({-class=>'gwPrintMe'},
1317 :			CGI::a({-href=>$link}, "Print Test"));
1318 :			print $printmsg;
1319 :	glarose	3842
1320 :			# if the test was submitted, just check to see if we should make a note about
1321 :			# the recorded score and time taken
1322 :			if ( $submitAnswers ) {
1323 :			if ( $recordedScore ne $attemptScore \|\| ! $will{recordAnswers} ) {
1324 :			print CGI::start_div({class=>"gwMessage"});
1325 :			if ( $recordedScore ne $attemptScore ) {
1326 :			print CGI::strong("Your recorded score on this test " .
1327 :			"is $recordedScore / $totPossible.");
1328 :			} elsif ( ! $will{recordAnswers} ) {
1329 :			print CGI::strong("Time taken: $elapsed min (allowed: " .
1330 :			"$allowed)");
1331 :			}
1332 :			print CGI::end_div();
1333 :			}
1334 :
1335 :			# otherwise, go through more convoluted logic
1336 :			} else {
1337 :			# first case: the test isn't submitted, but it's out of time.
1338 :			if ( ! $set->version_last_attempt_time && $exceededAllowedTime ) {
1339 :			print CGI::start_div({class=>'ResultsWithError'});
1340 :			print CGI::strong("You have exceeded the allowed time on " .
1341 :			"this test ($allowed min; elapsed time " .
1342 :			"is $elapsed min)."), CGI::br();
1343 :
1344 :			# second case: it has been submitted, and the score is zero, possibly
1345 :			# because it's over time
1346 :			} elsif ( $set->version_last_attempt_time && $exceededAllowedTime &&
1347 :			$recordedScore == 0 ) {
1348 :			print CGI::start_div({class=>'gwMessage'});
1349 :			print CGI::strong("Your recorded score on this test is " .
1350 :			"0 / $totPossible (possibly because you " .
1351 :			"exceeded the allowed time on the test). " .
1352 :			"Time taken: $elapsed min (allowed: " .
1353 :			"$allowed)"), CGI::br();
1354 :
1355 :	glarose	4316	# last case: here we can't record answers, and if it's not submitted we
1356 :			# must be out of time (which was caught in the first case, above), which
1357 :			# means this last case is that it's been submitted and we are either out
1358 :			# of time or out of attempts
1359 :	glarose	3842	} else {
1360 :			print CGI::start_div({class=>'gwMessage'});
1361 :			print CGI::strong("Your recorded score on this test is " .
1362 :			"$recordedScore / $totPossible. " .
1363 :			"Time taken: $elapsed min (allowed: " .
1364 :			"$allowed)"), CGI::br();
1365 :			}
1366 :			print "The test (which is number $versionNumber) may no " .
1367 :			"longer be submitted for a grade, but you may still " .
1368 :			"check your answers.", CGI::end_div();
1369 :			}
1370 :
1371 :	glarose	3377	} else {
1372 :
1373 :			# FIXME: This assumes that there IS a time limit!
1374 :			# FIXME: We need to drop this out gracefully if there isn't!
1375 :			# set up a timer
1376 :			my $timeLeft = $set->due_date() - $timeNow; # this is in seconds
1377 :	glarose	4327	print CGI::div({-id=>"gwTimer"},"\n");
1378 :			print CGI::startform({-name=>"gwTimeData", -method=>"POST",
1379 :	glarose	3842	-action=>$r->uri});
1380 :	glarose	4327	print CGI::hidden({-name=>"serverTime", -value=>$timeNow}), "\n";
1381 :			print CGI::hidden({-name=>"serverDueTime", -value=>$set->due_date()}),
1382 :			"\n";
1383 :			print CGI::endform();
1384 :	glarose	3852
1385 :	glarose	4327	# print CGI::startform({-name=>"gwtimer", -method=>"POST",
1386 :			# -action=>$r->uri});
1387 :			# print CGI::hidden({-name=>"gwpagetimeleft", -value=>$timeLeft}), "\n";
1388 :			#
1389 :			# print CGI::strong("Time Remaining:"), "\n";
1390 :			# print CGI::textfield({-name=>'gwtime', -default=>0, -size=>8}),
1391 :			# CGI::strong("min:sec"), CGI::br(), "\n";
1392 :			# print CGI::endform();
1393 :	glarose	4332	if ( $timeLeft < 1 && $timeLeft > 0 ) {
1394 :	glarose	3377	print CGI::span({-class=>"resultsWithError"},
1395 :			CGI::b("You have less than 1 minute to ",
1396 :			"complete this test.\n"));
1397 :	glarose	4332	} elsif ( $timeLeft <= 0 ) {
1398 :			print CGI::span({-class=>"resultsWithError"},
1399 :			CGI::b("You are out of time. Press grade now!\n"));
1400 :	glarose	3377	}
1401 :	glarose	4327	# print CGI::end_div();
1402 :	glarose	3377	}
1403 :
1404 :	glarose	3852	# this is a hack to get a URL that won't require a proctor login if we've
1405 :			# submitted a proctored test for the last time. above we've reset the
1406 :	glarose	3377	# assignment_type in this case, so we'll use that to decide if we should
1407 :	glarose	3852	# give a path to an unproctored test.
1408 :	glarose	3377	my $action = $r->uri();
1409 :			$action =~ s/proctored_quiz_mode/quiz_mode/
1410 :			if ( $set->assignment_type() eq 'gateway' );
1411 :
1412 :			print CGI::startform({-name=>"gwquiz", -method=>"POST", -action=>$action}), $self->hidden_authen_fields,
1413 :			$self->hidden_proctor_authen_fields;
1414 :
1415 :	glarose	4306	# hacks to use a javascript link to trigger previews and jump to
1416 :			# subsequent pages of a multipage test
1417 :	glarose	3377	print CGI::hidden({-name=>'previewHack', -value=>''}), CGI::br();
1418 :	glarose	4306	print CGI::hidden({-name=>'newPage', -value=>''}) if ( $numProbPerPage &&
1419 :			$numPages > 1 );
1420 :	glarose	3377
1421 :	glarose	4306	# the link for a preview; for a multipage test, this also needs to
1422 :			# keep track of what page we're on
1423 :			my $jsprevlink = 'javascript:document.gwquiz.previewHack.value="1";';
1424 :			$jsprevlink .= "document.gwquiz.newPage.value=\"$pageNumber\";"
1425 :			if ( $numProbPerPage && $numPages > 1 );
1426 :			$jsprevlink .= 'document.gwquiz.submit();';
1427 :
1428 :			# set up links between problems and, for multi-page tests, pages
1429 :			my $jumpLinks = '';
1430 :			my $probRow = [ CGI::b("Problem"), CGI::b(" [ ") ];
1431 :	glarose	3377	for my $i ( 0 .. $#pg_results ) {
1432 :	glarose	4306	push( @$probRow , ( CGI::b(" ] "), CGI::b(" [ ") ) )
1433 :			if ( $numProbPerPage && $numPages > 1 &&
1434 :			$i && ! ($i % $numProbPerPage) );
1435 :			my $pn = $i + 1;
1436 :			if ( $i >= $startProb && $i <= $endProb ) {
1437 :			push( @$probRow, "   " .
1438 :			CGI::a({-href=>".", -onclick=>"jumpTo($pn);return false;"},
1439 :			"$pn") . "   " );
1440 :			} else {
1441 :			push( @$probRow, "   $pn   " );
1442 :			}
1443 :	glarose	3377	}
1444 :	glarose	4306	push( @$probRow, CGI::b(" ] ") );
1445 :			if ( $numProbPerPage && $numPages > 1 ) {
1446 :			my $pageRow = [ CGI::td( [ CGI::b('Jump to: '), CGI::b('Page '),
1447 :			CGI::b(' [ ') ] ) ];
1448 :			for my $i ( 1 .. $numPages ) {
1449 :			my $pn = ( $i == $pageNumber ) ? $i :
1450 :			CGI::a({-href=>'javascript:' .
1451 :			"document.gwquiz.newPage.value=\"$i\";" .
1452 :			'document.gwquiz.submit();'}, "$i");
1453 :			# this doesn't quite preserve preview/etc. as we'd like
1454 :			# my $pn = ( $i == $pageNumber ) ? $i :
1455 :			# CGI::a({-href=>'javascript:' .
1456 :			# "document.gwquiz.newPage.value=\"$i\";" .
1457 :			# ($previewAnswers ?
1458 :			# 'document.gwquiz.previewHack.value="1";' : '') .
1459 :			# 'document.gwquiz.submit();'}, "$i");
1460 :			my $colspan =
1461 :			( ($#pg_results - ($i-1)*$numProbPerPage) > $numProbPerPage ) ?
1462 :			$numProbPerPage : ($#pg_results - ($i-1)*$numProbPerPage + 1);
1463 :			push( @$pageRow, CGI::td({-colspan=>$colspan,
1464 :			-align=>'center'}, $pn) );
1465 :			push( @$pageRow, CGI::td( [CGI::b(' ] '), CGI::b(' [ ')] ) )
1466 :			if ( $i != $numPages );
1467 :			}
1468 :			push( @$pageRow, CGI::td(CGI::b(' ] ')) );
1469 :			unshift( @$probRow, '   ' );
1470 :			$jumpLinks = CGI::table( CGI::Tr(@$pageRow),
1471 :			CGI::Tr( CGI::td($probRow) ) );
1472 :			} else {
1473 :			unshift( @$probRow, CGI::b('Jump to: ') );
1474 :			$jumpLinks = CGI::table( CGI::Tr( CGI::td($probRow) ) );
1475 :			}
1476 :	glarose	3377
1477 :	glarose	4306	print $jumpLinks,"\n";
1478 :
1479 :	glarose	3377	# print out problems and attempt results, as appropriate
1480 :			# note: args to attemptResults are (self,) $pg, $showAttemptAnswers,
1481 :			# $showCorrectAnswers, $showAttemptResults (and-ed with
1482 :			# $showAttemptAnswers), $showSummary, $showAttemptPreview (or-ed with zero)
1483 :			my $problemNumber = 0;
1484 :
1485 :			# deal with ordering
1486 :			my @probOrder = ( 0 .. $#pg_results );
1487 :
1488 :			# there's a routine to do this somewhere, I think...
1489 :			if ( defined( $set->problem_randorder ) && $set->problem_randorder ) {
1490 :			my @newOrder = ();
1491 :			# we need to keep the random order the same each time the set is loaded!
1492 :			# this requires either saving the order in the set definition, or being
1493 :			# sure that the random seed that we use is the same each time the same
1494 :			# set is called. we'll do the latter by setting the seed to the psvn
1495 :	glarose	4316	# of the problem set. we use a local PGrandom object to avoid mucking
1496 :			# with the system seed.
1497 :			my $pgrand = PGrandom->new();
1498 :			$pgrand->srand( $set->psvn );
1499 :	glarose	3377	while ( @probOrder ) {
1500 :	glarose	4316	my $i = int($pgrand->rand(scalar(@probOrder)));
1501 :	glarose	3377	push( @newOrder, $probOrder[$i] );
1502 :			splice(@probOrder, $i, 1);
1503 :			}
1504 :			@probOrder = @newOrder;
1505 :			}
1506 :
1507 :			foreach my $i ( 0 .. $#pg_results ) {
1508 :			my $pg = $pg_results[$probOrder[$i]];
1509 :			$problemNumber++;
1510 :
1511 :	glarose	4306	if ( $i >= $startProb && $i <= $endProb ) {
1512 :	glarose	3377
1513 :	glarose	4306	my $recordMessage = '';
1514 :			my $resultsTable = '';
1515 :	glarose	3377
1516 :	glarose	4306	if ($pg->{flags}->{showPartialCorrectAnswers}>=0 && $submitAnswers){
1517 :			if ( $scoreRecordedMessage[$probOrder[$i]] ne
1518 :			"Your score on this problem was recorded." ) {
1519 :			$recordMessage = CGI::span({class=>"resultsWithError"},
1520 :			"ANSWERS NOT RECORDED --",
1521 :			$scoreRecordedMessage[$probOrder[$i]]);
1522 :
1523 :			}
1524 :			$resultsTable =
1525 :			$self->attemptResults($pg, 1, $will{showCorrectAnswers},
1526 :			$pg->{flags}->{showPartialCorrectAnswers},
1527 :			1, 1);
1528 :	glarose	3377
1529 :	glarose	4306	} elsif ( $checkAnswers ) {
1530 :			$recordMessage = CGI::span({class=>"resultsWithError"},
1531 :			"ANSWERS ONLY CHECKED -- ",
1532 :			"ANSWERS NOT RECORDED");
1533 :	glarose	3377
1534 :	glarose	4306	$resultsTable =
1535 :			$self->attemptResults($pg, 1, $will{showCorrectAnswers},
1536 :			$pg->{flags}->{showPartialCorrectAnswers},
1537 :			1, 1);
1538 :	glarose	3377
1539 :	glarose	4306	} elsif ( $previewAnswers ) {
1540 :			$recordMessage =
1541 :			CGI::span({class=>"resultsWithError"},
1542 :			"PREVIEW ONLY -- ANSWERS NOT RECORDED");
1543 :			$resultsTable = $self->attemptResults($pg, 1, 0, 0, 0, 1);
1544 :	glarose	3377
1545 :	glarose	4306	}
1546 :	glarose	3377
1547 :	glarose	4306	print CGI::start_div({class=>"gwProblem"});
1548 :			my $i1 = $i+1;
1549 :			print CGI::a({-name=>"#$i1"},"");
1550 :			print CGI::strong("Problem $problemNumber."), "\n", $recordMessage;
1551 :			print CGI::p($pg->{body_text}),
1552 :	glarose	3377	CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "",
1553 :			CGI::i($pg->{result}->{msg}));
1554 :	glarose	4306	print CGI::p({class=>"gwPreview"},
1555 :			CGI::a({-href=>"$jsprevlink"}, "preview problems"));
1556 :	glarose	3377	# print CGI::end_div();
1557 :
1558 :	glarose	4306	print $resultsTable if $resultsTable;
1559 :	glarose	3377
1560 :	glarose	4306	print CGI::end_div();
1561 :	glarose	3377
1562 :	glarose	4306	print "\n", CGI::hr(), "\n";
1563 :			} else {
1564 :			my $i1 = $i+1;
1565 :			# keep the jump to anchors so that jumping to problem number 6 still
1566 :			# works, even if we're viewing only problems 5-7, etc.
1567 :			print CGI::a({-name=>"#$i1"},""), "\n";
1568 :			my $curr_prefix = 'Q' . sprintf("%04d", $probOrder[$i]+1) . '_';
1569 :			my @curr_fields = grep /^$curr_prefix/, keys %{$self->{formFields}};
1570 :			foreach my $curr_field ( @curr_fields ) {
1571 :			print CGI::hidden({-name=>$curr_field,
1572 :			-value=>$self->{formFields}->{$curr_field}});
1573 :			}
1574 :			# my $probid = 'Q' . sprintf("%04d", $probOrder[$i]+1) . "_AnSwEr1";
1575 :			# my $probval = $self->{formFields}->{$probid};
1576 :			# print CGI::hidden({-name=>$probid, -value=>$probval}), "\n";
1577 :			}
1578 :	glarose	3377	}
1579 :			print CGI::p($jumpLinks, "\n");
1580 :	glarose	4306	print "\n",CGI::hr(), "\n";
1581 :	glarose	3377
1582 :			if ($can{showCorrectAnswers}) {
1583 :			print CGI::checkbox(-name => "showCorrectAnswers",
1584 :			-checked => $will{showCorrectAnswers},
1585 :			-label => "Show correct answers",
1586 :			);
1587 :			}
1588 :			# if ($can{showHints}) {
1589 :			# print CGI::div({style=>"color:red"},
1590 :			# CGI::checkbox(-name => "showHints",
1591 :			# -checked => $will{showHints},
1592 :			# -label => "Show Hints",
1593 :			# )
1594 :			# );
1595 :			# }
1596 :			if ($can{showSolutions}) {
1597 :			print CGI::checkbox(-name => "showSolutions",
1598 :			-checked => $will{showSolutions},
1599 :			-label => "Show Solutions",
1600 :			);
1601 :			}
1602 :	glarose	4306
1603 :			# this solution results in not being able to turn off preview or whatever
1604 :			# should we be previewing or checking answers too? we need this to
1605 :			# preserve state when viewing multiple page tests
1606 :			if ( $numProbPerPage && $numPages > 1 ) {
1607 :			print "\n";
1608 :			print CGI::hidden({-name=>"previewingAnswersNow",
1609 :			-value=>"1"}), "\n" if $previewAnswers;
1610 :			print CGI::hidden({-name=>"checkingAnswersNow",
1611 :	glarose	4307	-value=>"1"}), "\n" if $checkAnswers \|\| $submitAnswers;
1612 :	glarose	4306	# should we allow this too?
1613 :			# print CGI::hidden({-name=>"submittingAnswersNow",
1614 :			# -value=>"1"}), "\n" if $submitAnswers;
1615 :			}
1616 :	glarose	3377
1617 :			if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) {
1618 :			print CGI::br();
1619 :			}
1620 :
1621 :			# Note: because of the way these things are grouped, the submit/et al buttons
1622 :			# in this form are getting put outside of the problem div, while on a regular
1623 :			# problem they'd fall inside. Does this matter? We shall see.
1624 :			print CGI::p( CGI::submit( -name=>"previewAnswers",
1625 :	glarose	4306	-label=>"Preview Test" ),
1626 :	glarose	3377	($can{recordAnswersNextTime} ?
1627 :			CGI::submit( -name=>"submitAnswers",
1628 :	glarose	4306	-label=>"Grade Test" ) : " "),
1629 :	glarose	3377	($can{checkAnswersNextTime} && ! $can{recordAnswersNextTime} ?
1630 :			CGI::submit( -name=>"checkAnswers",
1631 :	glarose	4306	-label=>"Check Test" ) : " "),
1632 :			($numProbPerPage && $numPages > 1 &&
1633 :			$can{recordAnswersNextTime} ? CGI::br() .
1634 :			CGI::em("Note: grading the test grades " .
1635 :			CGI::b("all") . " problems, not just those " .
1636 :			"on this page.") : " ") );
1637 :	glarose	3377
1638 :			print CGI::endform();
1639 :
1640 :			# debugging verbiage
1641 :			# if ( $can{checkAnswersNextTime} ) {
1642 :			# print "Can check answers next time\n";
1643 :			# } else {
1644 :			# print "Can NOT check answers next time\n";
1645 :			# }
1646 :			# if ( $can{recordAnswersNextTime} ) {
1647 :			# print "Can record answers next time\n";
1648 :			# } else {
1649 :			# print "Can NOT record answers next time\n";
1650 :			# }
1651 :
1652 :			# we exclude the feedback form from gateway tests. they can use the feedback
1653 :			# button on the preceding or following pages
1654 :			# my $ce = $r->ce;
1655 :			# my $root = $ce->{webworkURLs}->{root};
1656 :			# my $courseName = $ce->{courseName};
1657 :			# my $feedbackURL = "$root/$courseName/feedback/";
1658 :			# print CGI::startform("POST", $feedbackURL),
1659 :			# $self->hidden_authen_fields,
1660 :			# CGI::hidden("module", __PACKAGE__),
1661 :			# CGI::hidden("set", $self->{set}->set_id),
1662 :			# CGI::p({-align=>"right"},
1663 :			# CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback")
1664 :			# ),
1665 :			# CGI::endform();
1666 :
1667 :			return "";
1668 :
1669 :	gage	1138	}
1670 :
1671 :	glarose	3377
1672 :			###########################################################################
1673 :			# Evaluation utilities
1674 :			############################################################################
1675 :
1676 :			sub getProblemHTML {
1677 :			my ( $self, $EffectiveUser, $setVersionName, $formFields,
1678 :			$mergedProblem, $pgFile ) = @_;
1679 :			# in: $EffectiveUser is the effective user we're working as, $setVersionName
1680 :			# the versioned set name (setID,vN), %$formFields the form fields from
1681 :			# the input form that we need to worry about putting into the HTML we're
1682 :			# generating, and $mergedProblem and $pgFile are what we'd expect.
1683 :			# $pgFile is optional
1684 :			# out: the translated problem is returned
1685 :
1686 :			my $r = $self->r;
1687 :			my $ce = $r->ce;
1688 :			my $db = $r->db;
1689 :			my $key = $r->param('key');
1690 :
1691 :			# this isn't good because it doesn't include the sticky answers that we
1692 :			# might want. so off with its head!
1693 :			## my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
1694 :
1695 :			my $permissionLevel = $self->{permissionLevel};
1696 :			my $set = $db->getMergedVersionedSet( $EffectiveUser->user_id,
1697 :			$setVersionName );
1698 :
1699 :			# should this ever happen? I think we should have die()ed way earlier than
1700 :			# this if the set doesn't exist, but it can't hurt to try and die() here
1701 :			# too
1702 :			die "set $setVersionName for effectiveUser " . $EffectiveUser->user_id .
1703 :			" not found." unless $set;
1704 :
1705 :			my $psvn = $set->psvn();
1706 :			my ($setName) = ($setVersionName =~ /^(.*),v\d+/);
1707 :
1708 :			if ( defined($mergedProblem) && $mergedProblem->problem_id ) {
1709 :			# nothing needs to be done
1710 :
1711 :			} elsif ($pgFile) {
1712 :			$mergedProblem =
1713 :			WeBWorK::DB::Record::UserProblem->new(
1714 :			set_id => $set->set_id,
1715 :			problem_id => 0,
1716 :			login_id => $EffectiveUser->user_id,
1717 :			source_file => $pgFile,
1718 :			# the rest of Problem's fields are not needed, i think
1719 :			);
1720 :			}
1721 :			# figure out if we're allowed to get solutions and call PG->new accordingly.
1722 :			my $showCorrectAnswers = $self->{will}->{showCorrectAnswers};
1723 :			my $showHints = $self->{will}->{showHints};
1724 :			my $showSolutions = $self->{will}->{showSolutions};
1725 :			my $processAnswers = $self->{will}->{checkAnswers};
1726 :
1727 :			# FIXME I'm not sure that problem_id is what we want here FIXME
1728 :			my $problemNumber = $mergedProblem->problem_id;
1729 :
1730 :			my $pg =
1731 :			WeBWorK::PG->new(
1732 :			$ce,
1733 :			$EffectiveUser,
1734 :			$key,
1735 :			$set,
1736 :			$mergedProblem,
1737 :			$psvn,
1738 :			$formFields,
1739 :			{ # translation options
1740 :			displayMode => $self->{displayMode},
1741 :			showHints => $showHints,
1742 :			showSolutions => $showSolutions,
1743 :			refreshMath2img => $showHints \|\| $showSolutions,
1744 :			processAnswers => 1,
1745 :			QUIZ_PREFIX => 'Q' .
1746 :			sprintf("%04d",$problemNumber) . '_',
1747 :			},
1748 :			);
1749 :
1750 :			# FIXME is problem_id the correct thing in the following two stanzas?
1751 :			# FIXME the original version had "problem number", which is what we want.
1752 :			# FIXME I think problem_id will work, too
1753 :			if ($pg->{warnings} ne "") {
1754 :			push @{$self->{warnings}}, {
1755 :			set => $setVersionName,
1756 :			problem => $mergedProblem->problem_id,
1757 :			message => $pg->{warnings},
1758 :			};
1759 :			}
1760 :
1761 :			$self->{errors} = []; # initialize this to no errors
1762 :			if ($pg->{flags}->{error_flag}) {
1763 :			push @{$self->{errors}}, {
1764 :			set => $setVersionName,
1765 :			problem => $mergedProblem->problem_id,
1766 :			message => $pg->{errors},
1767 :			context => $pg->{body_text},
1768 :			};
1769 :			# if there was an error, body_text contains
1770 :			# the error context, not TeX code
1771 :			$pg->{body_text} = undef;
1772 :			}
1773 :
1774 :			return $pg;
1775 :	gage	1138	}
1776 :
1777 :	glarose	3377	##### output utilities #####
1778 :			sub problemListRow($$$) {
1779 :			my $self = shift;
1780 :			my $set = shift;
1781 :			my $Problem = shift;
1782 :
1783 :			my $name = $Problem->problem_id;
1784 :			my $interactiveURL = "$name/?" . $self->url_authen_args;
1785 :			my $interactive = CGI::a({-href=>$interactiveURL}, "Problem $name");
1786 :			my $attempts = $Problem->num_correct + $Problem->num_incorrect;
1787 :			my $remaining = $Problem->max_attempts < 0
1788 :			? "unlimited"
1789 :			: $Problem->max_attempts - $attempts;
1790 :			my $status = sprintf("%.0f%%", $Problem->status * 100); # round to whole number
1791 :
1792 :			return CGI::Tr(CGI::td({-nowrap=>1}, [
1793 :			$interactive,
1794 :			$attempts,
1795 :			$remaining,
1796 :			$status,
1797 :			]));
1798 :	gage	1138	}
1799 :	glarose	3377	# sub nbsp {
1800 :			# my $str = shift;
1801 :			# ($str) ? $str : ' '; # returns non-breaking space for empty strings
1802 :			# }
1803 :	gage	1138
1804 :	glarose	3377	##### logging subroutine ####
1805 :
1806 :
1807 :
1808 :
1809 :	gage	1129	1;

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9