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

Revision 430		Revision 431
…		…
29	}	29	}
30		30
31	# TODO:	31	# TODO:
32	# :) enforce permissions for showCorrectAnswers and showSolutions	32	# :) enforce permissions for showCorrectAnswers and showSolutions
33	# (use $PRIV = $mustPRIV \|\| ($canPRIV && $wantPRIV) -- cool syntax!)	33	# (use $PRIV = $mustPRIV \|\| ($canPRIV && $wantPRIV) -- cool syntax!)
34	# 2. if answers were not submitted and there are student answers in the DB,	34	# :) if answers were not submitted and there are student answers in the DB,
35	# decode them and put them into $formFields for the translator	35	# decode them and put them into $formFields for the translator
36	# 3. Latex2HTML massaging code	36	# 3. Latex2HTML massaging code
37	# 4. store submitted answers hash in database for sticky answers	37	# :) store submitted answers hash in database for sticky answers
38	# 5. deal with the results of answer evaluation and grading :p	38	# :) deal with the results of answer evaluation and grading :p
39	# :) introduce a recordAnswers option, which works on the same principle as	39	# :) introduce a recordAnswers option, which works on the same principle as
40	# the other permission-based options	40	# the other permission-based options
41	# 7. make warnings work	41	# 7. make warnings work
42		42
43	sub body {	43	sub body {
…		…
49	# fix format of setName and problem	49	# fix format of setName and problem
50	$setName =~ s/^set//;	50	$setName =~ s/^set//;
51	$problemNumber =~ s/^prob//;	51	$problemNumber =~ s/^prob//;
52		52
53	##### database setup #####	53	##### database setup #####
		54	# this should probably go in initialize() or whatever it's called
54		55
55	my $classlist = WeBWorK::DB::Classlist->new($courseEnv);	56	my $classlist = WeBWorK::DB::Classlist->new($courseEnv);
56	my $wwdb = WeBWorK::DB::WW->new($courseEnv);	57	my $wwdb = WeBWorK::DB::WW->new($courseEnv);
57	my $authdb = WeBWorK::DB::Auth->new($courseEnv);	58	my $authdb = WeBWorK::DB::Auth->new($courseEnv);
58		59
59	my $user = $classlist->getUser($userName);	60	my $user = $classlist->getUser($userName);
60	my $set = $wwdb->getSet($userName, $setName);	61	my $set = $wwdb->getSet($userName, $setName);
61	my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);	62	my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
62	my $psvn = $wwdb->getPSVN($userName, $setName);
63	my $permissionLevel = $authdb->getPermissions($userName);	63	my $permissionLevel = $authdb->getPermissions($userName);
64		64
65	##### form processing #####	65	##### form processing #####
66		66
67	# set options from form fields (see comment at top of file for names)	67	# set options from form fields (see comment at top of file for names)
68	my $displayMode = $r->param("displayMode") \|\| $courseEnv->{pg}->{options}->{displayMode};	68	my $displayMode = $r->param("displayMode") \|\| $courseEnv->{pg}->{options}->{displayMode};
69	my $redisplay = $r->param("redisplay");	69	my $redisplay = $r->param("redisplay");
70	my $submitAnswers = $r->param("submitAnswers");	70	my $submitAnswers = $r->param("submitAnswers");
71		71
		72	my %want = (
72	my $wantShowOldAnswers = $r->param("showOldAnswers") \|\| $courseEnv->{pg}->{options}->{showOldAnswers};	73	showOldAnswers => $r->param("showOldAnswers") \|\| $courseEnv->{pg}->{options}->{showOldAnswers},
73	my $wantShowCorrectAnswers = $r->param("showCorrectAnswers") \|\| $courseEnv->{pg}->{options}->{showCorrectAnswers};	74	showCorrectAnswers => $r->param("showCorrectAnswers") \|\| $courseEnv->{pg}->{options}->{showCorrectAnswers},
74	my $wantShowHints = $r->param("showHints") \|\| $courseEnv->{pg}->{options}->{showHints};	75	showHints => $r->param("showHints") \|\| $courseEnv->{pg}->{options}->{showHints},
75	my $wantShowSolutions = $r->param("showSolutions") \|\| $courseEnv->{pg}->{options}->{showSolutions};	76	showSolutions => $r->param("showSolutions") \|\| $courseEnv->{pg}->{options}->{showSolutions},
76	my $wantRecordAnswers = $r->param("recordAnswers") \|\| 1;	77	recordAnswers => $r->param("recordAnswers") \|\| 1,
		78	);
77		79
78	# coerce form fields into CGI::Vars format	80	# coerce form fields into CGI::Vars format
79	my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };	81	my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
80		82
81	##### permissions #####	83	##### permissions #####
82		84
		85	# are certain options enforced?
		86	my %must = (
		87	showOldAnswers => 0,
		88	showCorrectAnswers => 0,
		89	showHints => 0,
		90	showSolutions => 0,
		91	recordAnswers => mustRecordAnswers($permissionLevel),
		92	);
		93
83	# does the user have permission to use certain options?	94	# does the user have permission to use certain options?
		95	my %can = (
84	my $canShowOldAnswers = 1;	96	showOldAnswers => 1,
85	my $canShowCorrectAnswers = canShowCorrectAnswers($permissionLevel, $set->answer_date);	97	showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),
86	my $canShowHints = 1;	98	showHints => 1,
87	my $canShowSolutions = canShowSolutions($permissionLevel, $set->answer_date);	99	showSolutions => canShowSolutions($permissionLevel, $set->answer_date),
88	my $canRecordAnswers = canRecordAnswers($permissionLevel, $set->open_date, $set->due_date);	100	recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
89		101	$problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
90	# are certain options enforced?	102	# num_correct+num_incorrect+1 -- as this happens before updating $problem
91	my $mustShowOldAnswers = 0;	103	);
92	my $mustShowCorrectAnswers = 0;
93	my $mustShowHints = 0;
94	my $mustShowSolutions = 0;
95	my $mustRecordAnswers = mustRecordAnswers($permissionLevel);
96		104
97	# final values for options	105	# final values for options
98	my $showOldAnswers = $mustShowOldAnswers \|\| ($canShowOldAnswers && $wantShowOldAnswers );	106	my %will;
99	my $showCorrectAnswers = $mustShowCorrectAnswers \|\| ($canShowCorrectAnswers && $wantShowCorrectAnswers);	107	foreach(keys %must) {
100	my $showHints = $mustShowHints \|\| ($canShowHints && $wantShowHints );	108	$will{$_} = $can{$_} && ($want{$_} \|\| $must{$_});
101	my $showSolutions = $mustShowSolutions \|\| ($canShowSolutions && $wantShowSolutions );	109	}
102	my $recordAnswers = $mustRecordAnswers \|\| ($canRecordAnswers && $wantRecordAnswers );
103		110
104	##### sticky answers #####	111	##### sticky answers #####
105		112
106	# [TODO #2]
107
108	if (not $submitAnswers and $showOldAnswers) {	113	if (not $submitAnswers and $will{showOldAnswers}) {
109	# only do this if new answers are NOT being submitted	114	# do this only if new answers are NOT being submitted
110	my %oldAnswers = decodeAnswers($problem->last_answer);	115	my %oldAnswers = decodeAnswers($problem->last_answer);
111	$formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;	116	$formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
112	}	117	}
113		118
114	##### translation #####	119	##### translation #####
…		…
119	$r->param('key'),	124	$r->param('key'),
120	$setName,	125	$setName,
121	$problemNumber,	126	$problemNumber,
122	{ # translation options	127	{ # translation options
123	displayMode => $displayMode,	128	displayMode => $displayMode,
124	showHints => $showHints,	129	showHints => $will{showHints},
125	showSolutions => $showSolutions,	130	showSolutions => $will{showSolutions},
126	# try leaving processAnswers on all the time:	131	# try leaving processAnswers on all the time?
127	processAnswers => 1, #$submitAnswers ? 1 : 0,	132	processAnswers => 1, #$submitAnswers ? 1 : 0,
128	},	133	},
129	$formFields	134	$formFields
130	);	135	);
131		136
…		…
143		148
144	##### answer processing #####	149	##### answer processing #####
145		150
146	# if answers were submitted:	151	# if answers were submitted:
147	if ($submitAnswers) {	152	if ($submitAnswers) {
148	# store answers in DB for sticky answers [TODO #4]	153	# store answers in DB for sticky answers
149	my %answersToStore;	154	my %answersToStore;
150	my %answerHash = %{ $pg->{answers} };	155	my %answerHash = %{ $pg->{answers} };
151	$answersToStore{$_} = $answerHash{$_}->{original_student_ans}	156	$answersToStore{$_} = $answerHash{$_}->{original_student_ans}
152	foreach (keys %answerHash);	157	foreach (keys %answerHash);
153	my $answerString = encodeAnswers(%answersToStore,	158	my $answerString = encodeAnswers(%answersToStore,
154	@{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });	159	@{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
155	$problem->last_answer($answerString);	160	$problem->last_answer($answerString);
156	$wwdb->setProblem($problem);	161	$wwdb->setProblem($problem);
157		162
158	# store score in DB if it makes sense [TODO #5]	163	# store score in DB if it makes sense
		164	if ($will{recordAnswers}) {
		165	# the grader makes a lot of decisions for us...
		166	# all we have to do is update information from
		167	# the 'state' hash in the $pg hash.
		168	$problem->attempted(1);
		169	$problem->status($pg->{state}->{recorded_score});
		170	$problem->num_correct($pg->{state}->{num_of_correct_ans});
		171	$problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
		172	#warn "Would have stored the following:\n",
		173	# $problem->toString, "\n";
		174	$wwdb->setProblem($problem);
		175	} else {
		176	print p("Your score was not recorded for some reason. ;)");
159		177	}
160	# print the answer summary table
161	print
162	h3("Results of your latest attempt"),
163	attemptResults($pg, $showCorrectAnswers,
164	$pg->{flags}->{showPartialCorrectAnswers}),
165	hr();
166	}	178	}
167		179
168	##### output #####	180	##### output #####
169		181
170	# view options	182	# attempt summary
171	# what i'd really like to do here is:	183	if ($submitAnswers or $will{showCorrectAnswers}) {
172	# - preserve the answers currently in the form fields	184	# print this if user submitted answers OR requested correct answers
173	# - display the answer summary box	185	print attemptResults($pg, $submitAnswers, $will{showCorrectAnswers},
174	# - NOT record answers UNDER ANY CIRCUMSTANCES!	186	$pg->{flags}->{showPartialCorrectAnswers});
		187	}
		188
		189	# score summary
		190	my $attempts = $problem->num_correct + $problem->num_incorrect;
		191	my $attemptsNoun = $attempts != 1 ? "times" : "time";
		192	my $lastScore = int ($problem->status * 100) . "%";
		193	my ($attemptsLeft, $attemptsLeftNoun);
		194	if ($problem->max_attempts == -1) {
		195	# unlimited attempts
		196	$attemptsLeft = "unlimited";
		197	$attemptsLeftNoun = "attempts";
		198	} else {
		199	$attemptsLeft = $problem->max_attempts - $attempts;
		200	$attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
		201	}
		202	print p(
		203	"You have attempted this problem $attempts $attemptsNoun.", br(),
		204	$problem->attempted
		205	? "Your recorded score is $lastScore." . br()
		206	: "",
		207	"You have $attemptsLeft $attemptsLeftNoun remaining."
		208	);
		209
		210	# BY THE WAY..........
		211	# we have to figure out some way to tell the student if their NEW answer,
		212	# on THIS attempt, has been recorded. however, this is decided in part by
		213	# the grader, so is there any way for us to know? we can rule out several
		214	# cases where the answer is NOT being recorded, because of things decided
		215	# in &canRecordAnswers...
		216
		217	print hr();
175		218
176	# main form	219	# main form
177	print	220	print
178	startform("POST", $r->uri),	221	startform("POST", $r->uri),
179	$self->hidden_authen_fields,	222	$self->hidden_authen_fields,
		223	p(i($pg->{result}->{msg})),
180	p($pg->{body_text}),	224	p($pg->{body_text}),
181	p(submit(-name=>"submitAnswers", -label=>"Submit Answers")),	225	p(submit(-name=>"submitAnswers", -label=>"Submit Answers")),
182	viewOptions($displayMode, $showOldAnswers, $showCorrectAnswers,	226	viewOptions($displayMode, \%must, \%can, \%will),
183	$showHints, $showSolutions),
184	endform(),	227	endform(),
185	hr();	228	hr();
186		229
187	# debugging stuff	230	# debugging stuff
188	print	231	print
…		…
199	ref2string($pg, {'WeBWorK::PG::Translator' => 1});	242	ref2string($pg, {'WeBWorK::PG::Translator' => 1});
200		243
201	return "";	244	return "";
202	}	245	}
203		246
204	# -----	247	##### output utilities #####
205		248
206	sub translationError($$) {	249	sub translationError($$) {
207	my ($error, $details) = @_;	250	my ($error, $details) = @_;
208	return	251	return
209	p(<<EOF),	252	p(<<EOF),
…		…
216	h3("Error context"), blockquote(pre($details));	259	h3("Error context"), blockquote(pre($details));
217	}	260	}
218		261
219	sub attemptResults($$$) {	262	sub attemptResults($$$) {
220	my $pg = shift;	263	my $pg = shift;
		264	my $showAttemptAnswers = shift;
221	my $showCorrectAnswers = shift;	265	my $showCorrectAnswers = shift;
222	my $showAttemptResults = shift;	266	my $showAttemptResults = $showAttemptAnswers && shift;
223	my $problemResult = $pg->{result}; # the overall result of the problem	267	my $problemResult = $pg->{result}; # the overall result of the problem
224	my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };	268	my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
225		269
226	my $header = th("answer") . th("attempt");	270	my $header = th("answer");
		271	$header .= $showAttemptAnswers ? th("attempt") : "";
227	$header .= $showCorrectAnswers ? th("correct") : "";	272	$header .= $showCorrectAnswers ? th("correct") : "";
228	$header .= $showAttemptResults ? th("result") : "";	273	$header .= $showAttemptResults ? th("result") : "";
229	$header .= th("messages");	274	$header .= $showAttemptAnswers ? th("messages") : "";
230	my @tableRows = ( $header );	275	my @tableRows = ( $header );
231	my $numCorrect;	276	my $numCorrect;
232	foreach my $name (@answerNames) {	277	foreach my $name (@answerNames) {
233	my $answerResult = $pg->{answers}->{$name};	278	my $answerResult = $pg->{answers}->{$name};
234	my $studentAnswer = $answerResult->{student_ans}; # original_student_ans	279	my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
235	my $correctAnswer = $answerResult->{correct_ans};	280	my $correctAnswer = $answerResult->{correct_ans};
236	my $answerScore = $answerResult->{score};	281	my $answerScore = $answerResult->{score};
237	my $answerMessage = $answerResult->{ans_message};	282	my $answerMessage = $showAttemptAnswers ? $answerResult->{ans_message} : "";
238		283
239	$numCorrect += $answerScore > 0;	284	$numCorrect += $answerScore > 0;
240	my $resultString = $answerScore ? "correct :^)" : "incorrect >:(";	285	my $resultString = $answerScore ? "correct :^)" : "incorrect >:(";
241		286
242	my $row = td($name) . td($studentAnswer);	287	my $row = td($name);
		288	$row .= $showAttemptAnswers ? td($studentAnswer) : "";
243	$row .= $showCorrectAnswers ? td($correctAnswer) : "";	289	$row .= $showCorrectAnswers ? td($correctAnswer) : "";
244	$row .= $showAttemptResults ? td($resultString) : "";	290	$row .= $showAttemptResults ? td($resultString) : "";
245	$row .= $answerMessage ? td($answerMessage) : "";	291	$row .= $answerMessage ? td($answerMessage) : "";
246	push @tableRows, $row;	292	push @tableRows, $row;
247	}	293	}
248		294
		295	my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions";
249	my $scorePercent = int ($problemResult->{score} * 100) . "\%";	296	my $scorePercent = int ($problemResult->{score} * 100) . "\%";
250	my $message = i($problemResult->{msg});	297	#my $message = i($problemResult->{msg});
251	my $summary = "You answered $numCorrect questions out of "	298	my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of "
252	. scalar @answerNames . " correct, for a score of $scorePercent.";	299	. scalar @answerNames . " correct, for a score of $scorePercent.";
253	return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary);	300	#return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary);
		301	return table({-border=>1}, Tr(\@tableRows)) . p($summary);
254	}	302	}
255		303
256	sub viewOptions($$$$$) {	304	sub viewOptions($\%\%\%) {
257	my ($displayMode, $showOldAnswers, $showCorrectAnswers,	305	my $displayMode = shift;
258	$showHints, $showSolutions) = @_;	306	my %must = %{ shift() };
		307	my %can = %{ shift() };
		308	my %will = %{ shift() };
		309
		310	my $optionLine;
		311	$can{showOldAnswers} and $optionLine .= join "",
		312	"Show:  ",
		313	checkbox(
		314	-name => "showOldAnswers",
		315	-checked => $will{showOldAnswers},
		316	-label => "Saved answers",
		317	), "  ";
		318	$can{showCorrectAnswers} and $optionLine .= join "",
		319	checkbox(
		320	-name => "showCorrectAnswers",
		321	-checked => $will{showCorrectAnswers},
		322	-label => "Correct answers",
		323	), "  ";
		324	$can{showHints} and $optionLine .= join "",
		325	checkbox(
		326	-name => "showHints",
		327	-checked => $will{showHints},
		328	-label => "Hints",
		329	), "  ";
		330	$can{showSolutions} and $optionLine .= join "",
		331	checkbox(
		332	-name => "showSolutions",
		333	-checked => $will{showSolutions},
		334	-label => "Solutions",
		335	), "  ";
		336	$optionLine and $optionLine .= join "", br();
		337
259	return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},	338	return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
260	"View equations as:  ",	339	"View equations as:  ",
261	radio_group(	340	radio_group(
262	-name => "displayMode",	341	-name => "displayMode",
263	-values => ['plainText', 'formattedText', 'images'],	342	-values => ['plainText', 'formattedText', 'images'],
264	-default => $displayMode,	343	-default => $displayMode,
265	-labels => {	344	-labels => {
266	plainText => "plain text",	345	plainText => "plain text",
267	formattedText => "formatted text",	346	formattedText => "formatted text",
268	images => "images",	347	images => "images",
269	}	348	}
270	), br(),	349	), br(),
271	"Show:  ",	350	$optionLine,
272	checkbox(
273	-name => "showOldAnswers",
274	-checked => $showOldAnswers,
275	-label => "Old answers",
276	), "  ",
277	checkbox(
278	-name => "showCorrectAnswers",
279	-checked => $showCorrectAnswers,
280	-label => "Correct answers",
281	), "  ",
282	checkbox(
283	-name => "showHints",
284	-checked => $showHints,
285	-label => "Hints",
286	), "  ",
287	checkbox(
288	-name => "showSolutions",
289	-checked => $showSolutions,
290	-label => "Solutions",
291	), br(),
292	submit(-name=>"redisplay", -label=>"Redisplay Problem"),	351	submit(-name=>"redisplay", -label=>"Redisplay Problem"),
293	);	352	);
294	}	353	}
295		354
296	# -----	355	##### permission queries #####
297		356
298	# this stuff should be abstracted out into the permissions system	357	# this stuff should be abstracted out into the permissions system
299	# however, the permission system only knows about things in the	358	# however, the permission system only knows about things in the
300	# course environment and the username. hmmm...	359	# course environment and the username. hmmm...
301		360
		361	# also, i should fix these so that they have a consistent calling
		362	# format -- perhaps:
		363	# canPERM($courseEnv, $user, $set, $problem, $permissionLevel)
		364
302	sub canShowCorrectAnswers($$) {	365	sub canShowCorrectAnswers($$) {
303	my ($permissionLevel, $answerDate) = @_;	366	my ($permissionLevel, $answerDate) = @_;
304	return $permissionLevel > 0 \|\| time > $answerDate;	367	return $permissionLevel > 0 \|\| time > $answerDate;
305	}	368	}
306		369
307	sub canShowSolutions($$) {	370	sub canShowSolutions($$) {
308	my ($permissionLevel, $answerDate) = @_;	371	my ($permissionLevel, $answerDate) = @_;
309	return canShowCorrectAnswers($permissionLevel, $answerDate);	372	return canShowCorrectAnswers($permissionLevel, $answerDate);
310	}	373	}
311		374
312	sub canRecordAnswers($$$) {	375	sub canRecordAnswers($$$$$) {
313	my ($permissionLevel, $openDate, $dueDate) = @_;	376	my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
314	return $permissionLevel > 0 \|\| (time >= $openDate && time <= $dueDate);	377	my $permHigh = $permissionLevel > 0;
		378	my $timeOK = time >= $openDate && time <= $dueDate;
		379	my $attemptsOK = $attempts <= $maxAttempts;
		380	return $permHigh \|\| ($timeOK && $attemptsOK);
315	}	381	}
316		382
317	sub mustRecordAnswers($) {	383	sub mustRecordAnswers($) {
318	my ($permissionLevel) = @_;	384	my ($permissionLevel) = @_;
319	return $permissionLevel == 0;	385	return $permissionLevel == 0;

 Legend:



Removed from v.430
 


changed lines


 
Added in v.431
 Legend:



Removed from v.430
 


changed lines


 
Added in v.431
-Removed from v.430
+Added in v.431

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9