Diff of /branches/gage_dev/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm

trunk/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm Revision 719		branches/gage_dev/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm Revision 6967
1	################################################################################	1	################################################################################
2	# WeBWorK mod_perl (c) 2000-2002 WeBWorK Project	2	# WeBWorK Online Homework Delivery System
3	# $Id$	3	# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
		4	# $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.225 2010/05/28 21:29:48 gage Exp $
		5	#
		6	# This program is free software; you can redistribute it and/or modify it under
		7	# the terms of either: (a) the GNU General Public License as published by the
		8	# Free Software Foundation; either version 2, or (at your option) any later
		9	# version, or (b) the "Artistic License" which comes with this package.
		10	#
		11	# This program is distributed in the hope that it will be useful, but WITHOUT
		12	# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
		13	# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
		14	# Artistic License for more details.
4	################################################################################	15	################################################################################
5		16
6	package WeBWorK::ContentGenerator::Problem;	17	package WeBWorK::ContentGenerator::Problem;
		18	use base qw(WeBWorK);
		19	#use base qw(WeBWorK::ContentGenerator);
		20	use base qw(WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil); # not needed?
7		21
8	=head1 NAME	22	=head1 NAME
9		23
10	WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem.	24	WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem.
11		25
12	=cut	26	=cut
13		27
14	use strict;	28	use strict;
15	use warnings;	29	use warnings;
16	use base qw(WeBWorK::ContentGenerator);	30	#use CGI qw(-nosticky );
17	use CGI qw();	31	use WeBWorK::CGI;
18	use File::Temp qw(tempdir);	32	use File::Path qw(rmtree);
		33	use WeBWorK::Debug;
19	use WeBWorK::Form;	34	use WeBWorK::Form;
20	use WeBWorK::PG;	35	use WeBWorK::PG;
		36	use WeBWorK::PG::ImageGenerator;
21	use WeBWorK::PG::IO;	37	use WeBWorK::PG::IO;
22	use WeBWorK::Utils qw(writeLog encodeAnswers decodeAnswers ref2string);	38	use WeBWorK::Utils qw(readFile writeLog writeCourseLog encodeAnswers decodeAnswers
		39	ref2string makeTempDirectory path_is_subdir sortByName before after between);
		40	use WeBWorK::DB::Utils qw(global2user user2global);
		41	use URI::Escape;
		42	use WeBWorK::Localize;
		43	use WeBWorK::Utils::Tasks qw(fake_set fake_problem);
23		44
24	############################################################	45	################################################################################
		46	# CGI param interface to this module (up-to-date as of v1.153)
		47	################################################################################
		48
		49	# Standard params:
25	#	50	#
26	# user	51	# user - user ID of real user
27	# effectiveUser	52	# key - session key
28	# key	53	# effectiveUser - user ID of effective user
29	#	54	#
30	# displayMode	55	# Integration with PGProblemEditor:
31	# showOldAnswers
32	# showCorrectAnswers
33	# showHints
34	# showSolutions
35	#	56	#
36	# AnSwEr# - answer blanks in problem	57	# editMode - if set, indicates alternate problem source location.
		58	# can be "temporaryFile" or "savedFile".
37	#	59	#
		60	# sourceFilePath - path to file to be edited
		61	# problemSeed - force problem seed to value
		62	# success - success message to display
		63	# failure - failure message to display
		64	#
		65	# Rendering options:
		66	#
		67	# displayMode - name of display mode to use
		68	#
		69	# showOldAnswers - request that last entered answer be shown (if allowed)
		70	# showCorrectAnswers - request that correct answers be shown (if allowed)
		71	# showHints - request that hints be shown (if allowed)
		72	# showSolutions - request that solutions be shown (if allowed)
		73	#
		74	# Problem interaction:
		75	#
		76	# AnSwEr# - answer blanks in problem
		77	#
38	# redisplay - name of the "Redisplay Problem" button	78	# redisplay - name of the "Redisplay Problem" button
39	# submitAnswers - name of "Submit Answers" button	79	# submitAnswers - name of "Submit Answers" button
40	#	80	# checkAnswers - name of the "Check Answers" button
		81	# previewAnswers - name of the "Preview Answers" button
		82
41	############################################################	83	################################################################################
		84	# "can" methods
		85	################################################################################
		86
		87	# Subroutines to determine if a user "can" perform an action. Each subroutine is
		88	# called with the following arguments:
		89	#
		90	# ($self, $User, $EffectiveUser, $Set, $Problem)
		91
		92	# Note that significant parts of the "can" methods are lifted into the
		93	# GatewayQuiz module. It isn't direct, however, because of the necessity
		94	# of dealing with versioning there.
		95
		96	sub can_showOldAnswers {
		97	#my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
		98
		99	return 1;
		100	}
		101
		102	sub can_showCorrectAnswers {
		103	my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
		104	my $authz = $self->r->authz;
		105
		106	return
		107	after($Set->answer_date)
		108	\|\|
		109	$authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date")
		110	;
		111	}
		112
		113	sub can_showHints {
		114	#my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
		115
		116	return 1;
		117	}
		118
		119	sub can_showSolutions {
		120	my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
		121	my $authz = $self->r->authz;
		122
		123	return
		124	after($Set->answer_date)
		125	\|\|
		126	$authz->hasPermissions($User->user_id, "show_solutions_before_answer_date")
		127	;
		128	}
		129
		130	sub can_recordAnswers {
		131	my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_;
		132	my $authz = $self->r->authz;
		133	my $thisAttempt = $submitAnswers ? 1 : 0;
		134	if ($User->user_id ne $EffectiveUser->user_id) {
		135	return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student");
		136	}
		137	if (before($Set->open_date)) {
		138	return $authz->hasPermissions($User->user_id, "record_answers_before_open_date");
		139	} elsif (between($Set->open_date, $Set->due_date)) {
		140	my $max_attempts = $Problem->max_attempts;
		141	my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt;
		142	if ($max_attempts == -1 or $attempts_used < $max_attempts) {
		143	return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts");
		144	} else {
		145	return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts");
		146	}
		147	} elsif (between($Set->due_date, $Set->answer_date)) {
		148	return $authz->hasPermissions($User->user_id, "record_answers_after_due_date");
		149	} elsif (after($Set->answer_date)) {
		150	return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date");
		151	}
		152	}
		153
		154	sub can_checkAnswers {
		155	my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_;
		156	my $authz = $self->r->authz;
		157	my $thisAttempt = $submitAnswers ? 1 : 0;
		158
		159	if (before($Set->open_date)) {
		160	return $authz->hasPermissions($User->user_id, "check_answers_before_open_date");
		161	} elsif (between($Set->open_date, $Set->due_date)) {
		162	my $max_attempts = $Problem->max_attempts;
		163	my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt;
		164	if ($max_attempts == -1 or $attempts_used < $max_attempts) {
		165	return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts");
		166	} else {
		167	return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts");
		168	}
		169	} elsif (between($Set->due_date, $Set->answer_date)) {
		170	return $authz->hasPermissions($User->user_id, "check_answers_after_due_date");
		171	} elsif (after($Set->answer_date)) {
		172	return $authz->hasPermissions($User->user_id, "check_answers_after_answer_date");
		173	}
		174	}
		175
		176	# Reset the default in some cases
		177	sub set_showOldAnswers_default {
		178	my ($self, $ce, $userName, $authz, $set) = @_;
		179	# these people always use the system/course default, so don't
		180	# override the value of ...->{showOldAnswers}
		181	return if $authz->hasPermissions($userName, "can_always_use_show_old_answers_default");
		182	# this person should always default to 0
		183	$ce->{pg}->{options}->{showOldAnswers} = 0
		184	unless ($authz->hasPermissions($userName, "can_show_old_answers_by_default"));
		185	# we are after the due date, so default to not showing it
		186	$ce->{pg}->{options}->{showOldAnswers} = 0 if $set->{due_date} && after($set->{due_date});
		187	}
		188
		189	################################################################################
		190	# output utilities
		191	################################################################################
		192
		193	# Note: the substance of attemptResults is lifted into GatewayQuiz.pm,
		194	# with some changes to the output format
		195
		196	sub attemptResults {
		197	my $self = shift;
		198	my $r = $self->r;
		199	my $pg = shift;
		200	my $showAttemptAnswers = shift;
		201	my $showCorrectAnswers = shift;
		202	my $showAttemptResults = $showAttemptAnswers && shift;
		203	my $showSummary = shift;
		204	my $showAttemptPreview = shift \|\| 0;
		205
		206	my $ce = $self->r->ce;
		207
		208	# for color coding the responses.
		209	my @correct_ids = ();
		210	my @incorrect_ids = ();
		211
		212
		213	my $problemResult = $pg->{result}; # the overall result of the problem
		214	my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
		215
		216	my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
		217
		218	my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview";
		219
		220	# to make grabbing these options easier, we'll pull them out now...
		221	my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}};
		222
		223	my $imgGen = WeBWorK::PG::ImageGenerator->new(
		224	tempDir => $ce->{webworkDirs}->{tmp},
		225	latex => $ce->{externalPrograms}->{latex},
		226	dvipng => $ce->{externalPrograms}->{dvipng},
		227	useCache => 1,
		228	cacheDir => $ce->{webworkDirs}->{equationCache},
		229	cacheURL => $ce->{webworkURLs}->{equationCache},
		230	cacheDB => $ce->{webworkFiles}->{equationCacheDB},
		231	dvipng_align => $imagesModeOptions{dvipng_align},
		232	dvipng_depth_db => $imagesModeOptions{dvipng_depth_db},
		233	);
		234
		235	my $showEvaluatedAnswers = $ce->{pg}->{options}->{showEvaluatedAnswers};
		236
		237	my $header;
		238	#$header .= CGI::th("Part");
		239	if ($showEvaluatedAnswers) {
		240	$header .= $showAttemptAnswers ? CGI::th($r->maketext("Entered")) : "";
		241	}
		242	$header .= $showAttemptPreview ? CGI::th($r->maketext("Answer Preview")) : "";
		243	$header .= $showCorrectAnswers ? CGI::th($r->maketext("Correct")) : "";
		244	$header .= $showAttemptResults ? CGI::th($r->maketext("Result")) : "";
		245	$header .= $showMessages ? CGI::th($r->maketext("Messages")) : "";
		246	my $fully = '';
		247	my @tableRows = ( $header );
		248	my $numCorrect = 0;
		249	my $numBlanks =0;
		250	my $tthPreambleCache;
		251	foreach my $name (@answerNames) {
		252	my $answerResult = $pg->{answers}->{$name};
		253	my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
		254	my $preview = ($showAttemptPreview
		255	? $self->previewAnswer($answerResult, $imgGen, \$tthPreambleCache)
		256	: "");
		257	my $correctAnswerPreview = $self->previewCorrectAnswer($answerResult, $imgGen, \$tthPreambleCache);
		258	my $correctAnswer = $answerResult->{correct_ans};
		259	my $answerScore = $answerResult->{score};
		260	my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
		261	$answerMessage =~ s/\n/<BR>/g;
		262	$numCorrect += $answerScore >= 1;
		263	$numBlanks++ unless $studentAnswer =~/\S/ \|\| $answerScore >= 1; # unless student answer contains entry
		264	my $resultString = $answerScore >= 1 ? $r->maketext("correct") :
		265	$answerScore > 0 ? $r->maketext("[_1]% correct", int($answerScore*100)) :
		266	$r->maketext("incorrect");
		267	$fully = $r->maketext("completely ") if $answerScore >0 and $answerScore < 1;
		268
		269	push @correct_ids, $name if $answerScore == 1;
		270	push @incorrect_ids, $name if $answerScore < 1;
		271
		272	# need to capture auxiliary answers as well and identify their ids.
		273
		274
		275	my $row;
		276	#$row .= CGI::td($name);
		277	if ($showEvaluatedAnswers) {
		278	$row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : "";
		279	}
		280	$row .= $showAttemptPreview ? CGI::td({onmouseover=>qq!Tip('$studentAnswer',SHADOW, true,
		281	DELAY, 1000, FADEIN, 300, FADEOUT, 300, STICKY, 1, OFFSETX, -20, CLOSEBTN, true, CLICKCLOSE, false,
		282	BGCOLOR, '#F4FF91', TITLE, 'Entered:',TITLEBGCOLOR, '#F4FF91', TITLEFONTCOLOR, '#000000')!},
		283	$self->nbsp($preview)) : "";
		284	$row .= $showCorrectAnswers ? CGI::td({onmouseover=> qq!Tip('$correctAnswer',SHADOW, true,
		285	DELAY, 1000, FADEIN, 300, FADEOUT, 300, STICKY, 1, OFFSETX, -20, CLOSEBTN, true, CLICKCLOSE, false,
		286	BGCOLOR, '#F4FF91', TITLE, 'Entered:',TITLEBGCOLOR, '#F4FF91', TITLEFONTCOLOR, '#000000')!},
		287	$self->nbsp($correctAnswerPreview)) : "";
		288	$row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : "";
		289	$row .= $showMessages ? CGI::td({-class=>"Message"},$self->nbsp($answerMessage)) : "";
		290	push @tableRows, $row;
		291	}
		292
		293	# render equation images
		294	$imgGen->render(refresh => 1);
		295
		296	# my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
		297	my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100);
		298	# FIXME -- I left the old code in in case we have to back out.
		299	# my $summary = "On this attempt, you answered $numCorrect out of "
		300	# . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
		301	my $summary = "";
		302	unless (defined($problemResult->{summary}) and $problemResult->{summary} =~ /\S/) {
		303	if (scalar @answerNames == 1) { #default messages
		304	if ($numCorrect == scalar @answerNames) {
		305	$summary .= CGI::div({class=>"ResultsWithoutError"},$r->maketext("The answer above is correct."));
		306	} else {
		307	$summary .= CGI::div({class=>"ResultsWithError"},$r->maketext("The answer above is NOT [_1]correct.", $fully));
		308	}
		309	} else {
		310	if ($numCorrect == scalar @answerNames) {
		311	$summary .= CGI::div({class=>"ResultsWithoutError"},$r->maketext("All of the answers above are correct."));
		312	}
		313	#unless ($numCorrect + $numBlanks == scalar( @answerNames)) { # this allowed you to figure out if you got one answer right.
		314	elsif ($numBlanks != scalar( @answerNames)) {
		315	$summary .= CGI::div({class=>"ResultsWithError"},$r->maketext("At least one of the answers above is NOT [_1]correct.", $fully));
		316	}
		317	if ($numBlanks) {
		318	my $s = ($numBlanks>1)?'':'s';
		319	$summary .= CGI::div({class=>"ResultsAlert"},$r->maketext("[quant,_1,of the questions remains,of the questions remain] unanswered.", $numBlanks));
		320	}
		321	}
		322	} else {
		323	$summary = $problemResult->{summary}; # summary has been defined by grader
		324	}
		325
		326	$self->{correct_ids}=[@correct_ids] if @correct_ids;
		327	$self->{incorrect_ids} = [@incorrect_ids] if @incorrect_ids;
		328
		329	return
		330	CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows))
		331	. ($showSummary ? CGI::p({class=>'attemptResultsSummary'},$summary) : "");
		332	}
		333
		334
		335	# Note: previewAnswer is lifted into GatewayQuiz.pm
		336
		337	sub previewAnswer {
		338	my ($self, $answerResult, $imgGen, $tthPreambleCache) = @_;
		339	my $ce = $self->r->ce;
		340	my $effectiveUser = $self->{effectiveUser};
		341	my $set = $self->{set};
		342	my $problem = $self->{problem};
		343	my $displayMode = $self->{displayMode};
		344
		345	# note: right now, we have to do things completely differently when we are
		346	# rendering math from INSIDE the translator and from OUTSIDE the translator.
		347	# so we'll just deal with each case explicitly here. there's some code
		348	# duplication that can be dealt with later by abstracting out tth/dvipng/etc.
		349
		350	my $tex = $answerResult->{preview_latex_string};
		351
		352	return "" unless defined $tex and $tex ne "";
		353
		354	if ($displayMode eq "plainText") {
		355	return $tex;
		356	} elsif ($displayMode eq "formattedText") {
		357
		358	# read the TTH preamble, or use the cached copy passed in from the caller
		359	my $tthPreamble='';
		360	if (defined $$tthPreambleCache) {
		361	$tthPreamble = $$tthPreambleCache;
		362	} else {
		363	my $tthPreambleFile = $ce->{courseDirs}->{templates} . "/tthPreamble.tex";
		364	if (-r $tthPreambleFile) {
		365	$tthPreamble = readFile($tthPreambleFile);
		366	# thanks to Jim Martino. each line in the definition file should end with
		367	#a % to prevent adding supurious paragraphs to output:
		368	$tthPreamble =~ s/(.)\n/$1%\n/g;
		369	# solves the problem if the file doesn't end with a return:
		370	$tthPreamble .="%\n";
		371	# store preamble in cache:
		372	$$tthPreambleCache = $tthPreamble;
		373	} else {
		374	}
		375	}
		376
		377	# construct TTH command line
		378	my $tthCommand = $ce->{externalPrograms}->{tth}
		379	. " -L -f5 -u -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
		380	. $tthPreamble . "\\[" . $tex . "\\]\n"
		381	. "END_OF_INPUT\n";
		382
		383	# call tth
		384	my $result = `$tthCommand`;
		385	if ($?) {
		386	return "<b>[tth failed: $? $@]</b>";
		387	} else {
		388	# avoid border problems in tables and remove unneeded initial <br>
		389	$result =~ s/(<table [^>]*)>/$1 CLASS="ArrayLayout">/gi;
		390	$result =~ s!\s*<br clear="all" />!!;
		391	return $result;
		392	}
		393
		394	} elsif ($displayMode eq "images") {
		395	$imgGen->add($tex);
		396	} elsif ($displayMode eq "MathJax") {
		397	return '<span class="MathJax_Preview">[math]</span><script type="math/tex; mode=display">'.$tex.'</script>';
		398	} elsif ($displayMode eq "jsMath") {
		399	$tex =~ s/&/&/g; $tex =~ s/</</g; $tex =~ s/>/>/g;
		400	return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>';
		401	}
		402	}
		403	sub previewCorrectAnswer {
		404	my ($self, $answerResult, $imgGen, $tthPreambleCache) = @_;
		405	my $ce = $self->r->ce;
		406	my $effectiveUser = $self->{effectiveUser};
		407	my $set = $self->{set};
		408	my $problem = $self->{problem};
		409	my $displayMode = $self->{displayMode};
		410
		411	# note: right now, we have to do things completely differently when we are
		412	# rendering math from INSIDE the translator and from OUTSIDE the translator.
		413	# so we'll just deal with each case explicitly here. there's some code
		414	# duplication that can be dealt with later by abstracting out tth/dvipng/etc.
		415
		416	my $tex = $answerResult->{correct_ans_latex_string};
		417	return $answerResult->{correct_ans} unless defined $tex and $tex=~/\S/; # some answers don't have latex strings defined
		418	# return "" unless defined $tex and $tex ne "";
		419
		420	if ($displayMode eq "plainText") {
		421	return $tex;
		422	} elsif ($displayMode eq "formattedText") {
		423
		424	# read the TTH preamble, or use the cached copy passed in from the caller
		425	my $tthPreamble='';
		426	if (defined $$tthPreambleCache) {
		427	$tthPreamble = $$tthPreambleCache;
		428	} else {
		429	my $tthPreambleFile = $ce->{courseDirs}->{templates} . "/tthPreamble.tex";
		430	if (-r $tthPreambleFile) {
		431	$tthPreamble = readFile($tthPreambleFile);
		432	# thanks to Jim Martino. each line in the definition file should end with
		433	#a % to prevent adding supurious paragraphs to output:
		434	$tthPreamble =~ s/(.)\n/$1%\n/g;
		435	# solves the problem if the file doesn't end with a return:
		436	$tthPreamble .="%\n";
		437	# store preamble in cache:
		438	$$tthPreambleCache = $tthPreamble;
		439	} else {
		440	}
		441	}
		442
		443	# construct TTH command line
		444	my $tthCommand = $ce->{externalPrograms}->{tth}
		445	. " -L -f5 -u -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
		446	. $tthPreamble . "\\[" . $tex . "\\]\n"
		447	. "END_OF_INPUT\n";
		448
		449	# call tth
		450	my $result = `$tthCommand`;
		451	if ($?) {
		452	return "<b>[tth failed: $? $@]</b>";
		453	} else {
		454	# avoid border problems in tables and remove unneeded initial <br>
		455	$result =~ s/(<table [^>]*)>/$1 CLASS="ArrayLayout">/gi;
		456	$result =~ s!\s*<br clear="all" />!!;
		457	return $result;
		458	}
		459
		460	} elsif ($displayMode eq "images") {
		461	$imgGen->add($tex);
		462	} elsif ($displayMode eq "MathJax") {
		463	return '<span class="MathJax_Preview">[math]</span><script type="math/tex; mode=display">'.$tex.'</script>';
		464	} elsif ($displayMode eq "jsMath") {
		465	$tex =~ s/&/&/g; $tex =~ s/</</g; $tex =~ s/>/>/g;
		466	return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>';
		467	}
		468	}
		469
		470	################################################################################
		471	# Template escape implementations
		472	################################################################################
42		473
43	sub pre_header_initialize {	474	sub pre_header_initialize {
44	my ($self, $setName, $problemNumber) = @_;	475	my ($self) = @_;
45	my $courseEnv = $self->{courseEnvironment};
46	my $r = $self->{r};	476	my $r = $self->r;
		477	my $ce = $r->ce;
		478	my $db = $r->db;
		479	my $authz = $r->authz;
		480	my $urlpath = $r->urlpath;
		481
		482	my $setName = $urlpath->arg("setID");
		483	my $problemNumber = $r->urlpath->arg("problemID");
47	my $userName = $r->param('user');	484	my $userName = $r->param('user');
48	my $effectiveUserName = $r->param('effectiveUser');	485	my $effectiveUserName = $r->param('effectiveUser');
		486	my $key = $r->param('key');
		487	my $editMode = $r->param("editMode");
49		488
50	##### database setup #####
51
52	my $cldb = WeBWorK::DB::Classlist->new($courseEnv);
53	my $wwdb = WeBWorK::DB::WW->new($courseEnv);
54	my $authdb = WeBWorK::DB::Auth->new($courseEnv);
55
56	my $user = $cldb->getUser($userName);	489	my $user = $db->getUser($userName); # checked
		490	die "record for user $userName (real user) does not exist."
		491	unless defined $user;
		492
57	my $effectiveUser = $cldb->getUser($effectiveUserName);	493	my $effectiveUser = $db->getUser($effectiveUserName); # checked
		494	die "record for user $effectiveUserName (effective user) does not exist."
		495	unless defined $effectiveUser;
		496
		497	# obtain the merged set for $effectiveUser
		498	my $set = $db->getMergedSet($effectiveUserName, $setName); # checked
		499
		500	$self->set_showOldAnswers_default($ce, $userName, $authz, $set);
		501
		502	# Database fix (in case of undefined visiblity state values)
		503	# this is only necessary because some people keep holding to ww1.9 which did not have a visible field
		504	# make sure visible is set to 0 or 1
		505	if ( $set and $set->visible ne "0" and $set->visible ne "1") {
		506	my $globalSet = $db->getGlobalSet($set->set_id);
		507	$globalSet->visible("1"); # defaults to visible
		508	$db->putGlobalSet($globalSet);
58	my $set = $wwdb->getSet($effectiveUserName, $setName);	509	$set = $db->getMergedSet($effectiveUserName, $setName);
		510	} else {
		511	# don't do anything just yet, maybe we're a professor and we're
		512	# fabricating a set or haven't assigned it to ourselves just yet
		513	}
		514	# When a set is created enable_reduced_scoring is null, so we have to set it
		515	if ( $set and $set->enable_reduced_scoring ne "0" and $set->enable_reduced_scoring ne "1") {
		516	my $globalSet = $db->getGlobalSet($set->set_id);
		517	$globalSet->enable_reduced_scoring("0"); # defaults to disabled
		518	$db->putGlobalSet($globalSet);
		519	$set = $db->getMergedSet($effectiveUserName, $setName);
		520	}
		521
		522
		523	# obtain the merged problem for $effectiveUser
59	my $problem = $wwdb->getProblem($effectiveUserName, $setName, $problemNumber);	524	my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked
60	my $psvn = $wwdb->getPSVN($effectiveUserName, $setName);	525
61	my $permissionLevel = $authdb->getPermissions($userName);	526	if ($authz->hasPermissions($userName, "modify_problem_sets")) {
		527	# professors are allowed to fabricate sets and problems not
		528	# assigned to them (or anyone). this allows them to use the
		529	# editor to
		530
		531	# if a User Set does not exist for this user and this set
		532	# then we check the Global Set
		533	# if that does not exist we create a fake set
		534	# if it does, we add fake user data
		535	unless (defined $set) {
		536	my $userSetClass = $db->{set_user}->{record};
		537	my $globalSet = $db->getGlobalSet($setName); # checked
		538
		539	if (not defined $globalSet) {
		540	$set = fake_set($db);
		541	} else {
		542	$set = global2user($userSetClass, $globalSet);
		543	$set->psvn(0);
		544	}
		545	}
		546
		547	# if that is not yet defined obtain the global problem,
		548	# convert it to a user problem, and add fake user data
		549	unless (defined $problem) {
		550	my $userProblemClass = $db->{problem_user}->{record};
		551	my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked
		552	# if the global problem doesn't exist either, bail!
		553	if(not defined $globalProblem) {
		554	my $sourceFilePath = $r->param("sourceFilePath");
		555	die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir
		556	# These are problems from setmaker. If declared invalid, they won't come up
		557	$self->{invalidProblem} = $self->{invalidSet} = 1 unless defined $sourceFilePath;
		558	# die "Problem $problemNumber in set $setName does not exist" unless defined $sourceFilePath;
		559	$problem = fake_problem($db);
		560	$problem->problem_id(1);
		561	$problem->source_file($sourceFilePath);
		562	$problem->user_id($effectiveUserName);
		563	} else {
		564	$problem = global2user($userProblemClass, $globalProblem);
		565	$problem->user_id($effectiveUserName);
		566	$problem->problem_seed(0);
		567	$problem->status(0);
		568	$problem->attempted(0);
		569	$problem->last_answer("");
		570	$problem->num_correct(0);
		571	$problem->num_incorrect(0);
		572	}
		573	}
		574
		575	# now we're sure we have valid UserSet and UserProblem objects
		576	# yay!
		577
		578	# now deal with possible editor overrides:
		579
		580	# if the caller is asking to override the source file, and
		581	# editMode calls for a temporary file, do so
		582	my $sourceFilePath = $r->param("sourceFilePath");
		583	if (defined $editMode and $editMode eq "temporaryFile" and defined $sourceFilePath) {
		584	die "sourceFilePath is unsafe!" unless path_is_subdir($sourceFilePath, $ce->{courseDirs}->{templates}, 1); # 1==path can be relative to dir
		585	$problem->source_file($sourceFilePath);
		586	}
		587
		588	# if the problem does not have a source file or no source file has been passed in
		589	# then this is really an invalid problem (probably from a bad URL)
		590	$self->{invalidProblem} = not (defined $sourceFilePath or $problem->source_file);
		591
		592	# if the caller is asking to override the problem seed, do so
		593	my $problemSeed = $r->param("problemSeed");
		594	if (defined $problemSeed) {
		595	$problem->problem_seed($problemSeed);
		596	}
		597
		598	my $visiblityStateClass = ($set->visible) ? "visible" : "hidden";
		599	my $visiblityStateText = ($set->visible) ? "visible to students." : "hidden from students.";
		600	$self->addmessage(CGI::span("This set is " . CGI::font({class=>$visiblityStateClass}, $visiblityStateText)));
		601
		602	# test for additional problem validity if it's not already invalid
		603	} else {
		604	$self->{invalidProblem} = !(defined $problem and ($set->visible \|\| $authz->hasPermissions($userName, "view_hidden_sets")));
		605
		606	$self->addbadmessage(CGI::p($r->maketext("This problem will not count towards your grade."))) if $problem and not $problem->value and not $self->{invalidProblem};
		607	}
		608
		609	$self->{userName} = $userName;
		610	$self->{effectiveUserName} = $effectiveUserName;
		611	$self->{user} = $user;
		612	$self->{effectiveUser} = $effectiveUser;
		613	$self->{set} = $set;
		614	$self->{problem} = $problem;
		615	$self->{editMode} = $editMode;
62		616
63	##### form processing #####	617	##### form processing #####
64		618
65	# set options from form fields (see comment at top of file for names)	619	# set options from form fields (see comment at top of file for names)
66	my $displayMode = $r->param("displayMode") \|\| $courseEnv->{pg}->{options}->{displayMode};	620	my $displayMode = $r->param("displayMode") \|\| $ce->{pg}->{options}->{displayMode};
67	my $redisplay = $r->param("redisplay");	621	my $redisplay = $r->param("redisplay");
68	my $submitAnswers = $r->param("submitAnswers");	622	my $submitAnswers = $r->param("submitAnswers");
69	my $checkAnswers = $r->param("checkAnswers");	623	my $checkAnswers = $r->param("checkAnswers");
70	my $previewAnswers = $r->param("previewAnswers");	624	my $previewAnswers = $r->param("previewAnswers");
71		625
72	# coerce form fields into CGI::Vars format
73	my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };	626	my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
74		627
		628	$self->{displayMode} = $displayMode;
		629	$self->{redisplay} = $redisplay;
		630	$self->{submitAnswers} = $submitAnswers;
		631	$self->{checkAnswers} = $checkAnswers;
		632	$self->{previewAnswers} = $previewAnswers;
		633	$self->{formFields} = $formFields;
		634
		635	# get result and send to message
		636	my $status_message = $r->param("status_message");
		637	$self->addmessage(CGI::p("$status_message")) if $status_message;
		638
		639	# now that we've set all the necessary variables quit out if the set or problem is invalid
		640	return if $self->{invalidSet} \|\| $self->{invalidProblem};
		641
75	##### permissions #####	642	##### permissions #####
76		643
77	# what does the user want to do?	644	# what does the user want to do?
		645	#FIXME There is a problem with checkboxes -- if they are not checked they are invisible. Hence if the default mode in $ce is 1
		646	# there is no way to override this. Probably this is ok for the last three options, but it was definitely not ok for showing
		647	# saved answers which is normally on, but you want to be able to turn it off! This section should be moved to ContentGenerator
		648	# so that you can set these options anywhere. We also need mechanisms for making them sticky.
		649	# Note: ProblemSet and ProblemSets might set showOldAnswers to '', which
		650	# needs to be treated as if it is not set.
78	my %want = (	651	my %want = (
79	showOldAnswers => $r->param("showOldAnswers") \|\| $courseEnv->{pg}->{options}->{showOldAnswers},	652	showOldAnswers => (defined($r->param("showOldAnswers")) and $r->param("showOldAnswers") ne '') ? $r->param("showOldAnswers") : $ce->{pg}->{options}->{showOldAnswers},
80	showCorrectAnswers => $r->param("showCorrectAnswers") \|\| $courseEnv->{pg}->{options}->{showCorrectAnswers},	653	showCorrectAnswers => $r->param("showCorrectAnswers") \|\| $ce->{pg}->{options}->{showCorrectAnswers},
81	showHints => $r->param("showHints") \|\| $courseEnv->{pg}->{options}->{showHints},	654	showHints => $r->param("showHints") \|\| $ce->{pg}->{options}->{showHints},
82	showSolutions => $r->param("showSolutions") \|\| $courseEnv->{pg}->{options}->{showSolutions},	655	showSolutions => $r->param("showSolutions") \|\| $ce->{pg}->{options}->{showSolutions},
83	#recordAnswers => $r->param("recordAnswers") \|\| 1,
84	recordAnswers => $submitAnswers,	656	recordAnswers => $submitAnswers,
		657	checkAnswers => $checkAnswers,
		658	getSubmitButton => 1,
85	);	659	);
86		660
87	# are certain options enforced?	661	# are certain options enforced?
88	my %must = (	662	my %must = (
89	showOldAnswers => 0,	663	showOldAnswers => 0,
90	showCorrectAnswers => 0,	664	showCorrectAnswers => 0,
91	showHints => 0,	665	showHints => 0,
92	showSolutions => 0,	666	showSolutions => 0,
93	recordAnswers => mustRecordAnswers($permissionLevel),	667	recordAnswers => ! $authz->hasPermissions($userName, "avoid_recording_answers"),
		668	checkAnswers => 0,
		669	getSubmitButton => 0,
94	);	670	);
95		671
96	# does the user have permission to use certain options?	672	# does the user have permission to use certain options?
		673	my @args = ($user, $effectiveUser, $set, $problem);
97	my %can = (	674	my %can = (
98	showOldAnswers => 1,	675	showOldAnswers => $self->can_showOldAnswers(@args),
99	showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),	676	showCorrectAnswers => $self->can_showCorrectAnswers(@args),
100	showHints => 1,	677	showHints => $self->can_showHints(@args),
101	showSolutions => canShowSolutions($permissionLevel, $set->answer_date),	678	showSolutions => $self->can_showSolutions(@args),
102	recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,	679	recordAnswers => $self->can_recordAnswers(@args, 0),
103	$problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),	680	checkAnswers => $self->can_checkAnswers(@args, $submitAnswers),
104	# num_correct+num_incorrect+1 -- as this happens before updating $problem	681	getSubmitButton => $self->can_recordAnswers(@args, $submitAnswers),
105	);	682	);
106		683
107	# final values for options	684	# final values for options
108	my %will;	685	my %will;
109	foreach (keys %must) {	686	foreach (keys %must) {
110	$will{$_} = $can{$_} && ($want{$_} \|\| $must{$_});	687	$will{$_} = $can{$_} && ($want{$_} \|\| $must{$_});
		688	#warn "final values for options $_ is can $can{$_}, want $want{$_}, must $must{$_}, will $will{$_}";
111	}	689	}
112		690
113	##### sticky answers #####	691	##### sticky answers #####
114		692
115	if (not $submitAnswers and $will{showOldAnswers}) {	693	if (not ($submitAnswers or $previewAnswers or $checkAnswers) and $will{showOldAnswers}) {
116	# do this only if new answers are NOT being submitted	694	# do this only if new answers are NOT being submitted
117	my %oldAnswers = decodeAnswers($problem->last_answer);	695	my %oldAnswers = decodeAnswers($problem->last_answer);
118	$formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;	696	$formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
119	}	697	}
120		698
121	##### translation #####	699	##### translation #####
122		700
		701	debug("begin pg processing");
123	my $pg = WeBWorK::PG->new(	702	my $pg = WeBWorK::PG->new(
124	$courseEnv,	703	$ce,
125	$effectiveUser,	704	$effectiveUser,
126	$r->param('key'),	705	$key,
127	$set,	706	$set,
128	$problem,	707	$problem,
129	$psvn,	708	$set->psvn, # FIXME: this field should be removed
130	$formFields,	709	$formFields,
131	{ # translation options	710	{ # translation options
132	displayMode => $displayMode,	711	displayMode => $displayMode,
133	showHints => $will{showHints},	712	showHints => $will{showHints},
134	showSolutions => $will{showSolutions},	713	showSolutions => $will{showSolutions},
135	refreshMath2img => $will{showHints} \|\| $will{showSolutions},	714	refreshMath2img => $will{showHints} \|\| $will{showSolutions},
136	processAnswers => 1,	715	processAnswers => 1,
		716	permissionLevel => $db->getPermissionLevel($userName)->permission,
		717	effectivePermissionLevel => $db->getPermissionLevel($effectiveUserName)->permission,
137	},	718	},
138	);	719	);
		720
		721	debug("end pg processing");
139		722
140	##### fix hint/solution options #####	723	##### fix hint/solution options #####
141		724
142	$can{showHints} &&= $pg->{flags}->{hintExists};	725	$can{showHints} &&= $pg->{flags}->{hintExists}
		726	&&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans};
143	$can{showSolutions} &&= $pg->{flags}->{solutionExists};	727	$can{showSolutions} &&= $pg->{flags}->{solutionExists};
144		728
145	##### store fields #####	729	##### store fields #####
146
147	$self->{cldb} = $cldb;
148	$self->{wwdb} = $wwdb;
149	$self->{authdb} = $authdb;
150
151	$self->{userName} = $userName;
152	$self->{user} = $user;
153	$self->{effectiveUser} = $effectiveUser;
154	$self->{set} = $set;
155	$self->{problem} = $problem;
156	$self->{permissionLevel} = $permissionLevel;
157
158	$self->{displayMode} = $displayMode;
159	$self->{redisplay} = $redisplay;
160	$self->{submitAnswers} = $submitAnswers;
161	$self->{checkAnswers} = $checkAnswers;
162	$self->{previewAnswers} = $previewAnswers;
163	$self->{formFields} = $formFields;
164		730
165	$self->{want} = \%want;	731	$self->{want} = \%want;
166	$self->{must} = \%must;	732	$self->{must} = \%must;
167	$self->{can} = \%can;	733	$self->{can} = \%can;
168	$self->{will} = \%will;	734	$self->{will} = \%will;
169
170	$self->{pg} = $pg;	735	$self->{pg} = $pg;
171	}
172
173	sub if_warnings($$) {
174	my ($self, $arg) = @_;
175	return $self->{pg}->{warnings} ne "";
176	}	736	}
177		737
178	sub if_errors($$) {	738	sub if_errors($$) {
179	my ($self, $arg) = @_;	739	my ($self, $arg) = @_;
		740
		741	if ($self->{isOpen}) {
180	return $self->{pg}->{flags}->{error_flag};	742	return $self->{pg}->{flags}->{error_flag} ? $arg : !$arg;
		743	} else {
		744	return !$arg;
		745	}
181	}	746	}
182		747
183	sub head {	748	sub head {
184	my $self = shift;	749	my ($self) = @_;
185		750
		751	return "" if ( $self->{invalidSet} );
186	return $self->{pg}->{head_text} if $self->{pg}->{head_text};	752	return $self->{pg}->{head_text} if $self->{pg}->{head_text};
187	}	753	}
188		754
189	sub path {	755	sub options {
190	my $self = shift;	756	my ($self) = @_;
191	my $args = $_[-1];	757	#warn "doing options in Problem";
192	my $setName = $self->{set}->id;
193	my $problemNumber = $self->{problem}->id;
194		758
195	my $ce = $self->{courseEnvironment};	759	# don't show options if we don't have anything to show
196	my $root = $ce->{webworkURLs}->{root};	760	return "" if $self->{invalidSet} or $self->{invalidProblem};
197	my $courseName = $ce->{courseName};	761
		762	my $displayMode = $self->{displayMode};
		763	my %can = %{ $self->{can} };
		764
		765	my @options_to_show = "displayMode";
		766	push @options_to_show, "showOldAnswers" if $can{showOldAnswers};
		767	push @options_to_show, "showHints" if $can{showHints};
		768	push @options_to_show, "showSolutions" if $can{showSolutions};
		769
198	return $self->pathMacro($args,	770	return $self->optionsMacro(
199	"Home" => "$root",	771	options_to_show => \@options_to_show,
200	$courseName => "$root/$courseName",	772	extra_params => ["editMode", "sourceFilePath"],
201	$setName => "$root/$courseName/$setName",
202	"Problem $problemNumber" => "",
203	);	773	);
204	}	774	}
205		775
206	sub siblings {	776	sub siblings {
207	my $self = shift;	777	my ($self) = @_;
		778	my $r = $self->r;
		779	my $db = $r->db;
		780	my $urlpath = $r->urlpath;
		781
		782	# can't show sibling problems if the set is invalid
		783	return "" if $self->{invalidSet};
		784
		785	my $courseID = $urlpath->arg("courseID");
208	my $setName = $self->{set}->id;	786	my $setID = $self->{set}->set_id;
209	my $problemNumber = $self->{problem}->id;
210
211	my $ce = $self->{courseEnvironment};
212	my $root = $ce->{webworkURLs}->{root};
213	my $courseName = $ce->{courseName};
214
215	print CGI::strong("Problems"), CGI::br();
216
217	my $wwdb = $self->{wwdb};
218	my $effectiveUser = $self->{r}->param("effectiveUser");	787	my $eUserID = $r->param("effectiveUser");
219	my @problems;	788	my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID);
220	push @problems, $wwdb->getProblem($effectiveUser, $setName, $_)	789
221	foreach ($wwdb->getProblems($effectiveUser, $setName));	790	print CGI::start_div({class=>"info-box", id=>"fisheye"});
222	foreach my $problem (sort { $a->id <=> $b->id } @problems) {	791	print CGI::h2($r->maketext("Problems"));
223	print CGI::a({-href=>"$root/$courseName/$setName/".$problem->id."/?"	792	#print CGI::start_ul({class=>"LinksMenu"});
224	. $self->url_authen_args . "&displayMode=" . $self->{displayMode}},	793	#print CGI::start_li();
225	"Problem ".$problem->id), CGI::br();	794	#print CGI::span({style=>"font-size:larger"}, "Problems");
		795	print CGI::start_ul();
		796
		797	foreach my $problemID (@problemIDs) {
		798	my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem", $r,
		799	courseID => $courseID, setID => $setID, problemID => $problemID);
		800	print CGI::li(CGI::a( {href=>$self->systemLink($problemPage,
		801	params=>{ displayMode => $self->{displayMode},
		802	showOldAnswers => $self->{will}->{showOldAnswers}
		803	})}, $r->maketext("Problem [_1]",$problemID))
		804	);
226	}	805	}
		806
		807	print CGI::end_ul();
		808	#print CGI::end_li();
		809	#print CGI::end_ul();
		810	print CGI::end_div();
		811
		812	return "";
227	}	813	}
228		814
229	sub nav {	815	sub nav {
230	my $self = shift;	816	my ($self, $args) = @_;
231	my $args = $_[-1];	817	my $r = $self->r;
232	my $setName = $self->{set}->id;	818	my $db = $r->db;
233	my $problemNumber = $self->{problem}->id;	819	my $urlpath = $r->urlpath;
234		820
235	my $ce = $self->{courseEnvironment};	821	return "" if ( $self->{invalidSet} );
236	my $root = $ce->{webworkURLs}->{root};	822
237	my $courseName = $ce->{courseName};	823	my $courseID = $urlpath->arg("courseID");
238		824	my $setID = $self->{set}->set_id if !($self->{invalidSet});
239	my $wwdb = $self->{wwdb};	825	my $problemID = $self->{problem}->problem_id if !($self->{invalidProblem});
240	my $effectiveUser = $self->{r}->param("effectiveUser");	826	my $eUserID = $r->param("effectiveUser");
241	my $tail = "&displayMode=".$self->{displayMode};	827
242		828	my ($prevID, $nextID);
243	my @links = ("Problem List" => "$root/$courseName/$setName");	829
244		830	if (!$self->{invalidProblem}) {
245	my $prevProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber-1);	831	my @problemIDs = $db->listUserProblems($eUserID, $setID);
246	my $nextProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber+1);	832	foreach my $id (@problemIDs) {
247	unshift @links, "Previous Problem" => $prevProblem	833	$prevID = $id if $id < $problemID
248	? "$root/$courseName/$setName/".$prevProblem->id	834	and (not defined $prevID or $id > $prevID);
249	: "";	835	$nextID = $id if $id > $problemID
250	push @links, "Next Problem" => $nextProblem	836	and (not defined $nextID or $id < $nextID);
251	? "$root/$courseName/$setName/".$nextProblem->id	837	}
252	: "";	838	}
253		839
		840	my @links;
		841
		842	if ($prevID) {
		843	my $prevPage = $urlpath->newFromModule(__PACKAGE__, $r,
		844	courseID => $courseID, setID => $setID, problemID => $prevID);
		845	push @links, $r->maketext("Previous Problem"), $r->location . $prevPage->path, $r->maketext("navPrev");
		846	} else {
		847	push @links, $r->maketext("Previous Problem"), "", $r->maketext("navPrevGrey");
		848	}
		849
		850	if (defined($setID) && $setID ne 'Undefined_Set') {
		851	push @links, $r->maketext("Problem List"), $r->location . $urlpath->parent->path, $r->maketext("navProbList");
		852	} else {
		853	push @links, $r->maketext("Problem List"), "", $r->maketext("navProbListGrey");
		854	}
		855
		856	if ($nextID) {
		857	my $nextPage = $urlpath->newFromModule(__PACKAGE__, $r,
		858	courseID => $courseID, setID => $setID, problemID => $nextID);
		859	push @links, $r->maketext("Next Problem"), $r->location . $nextPage->path, $r->maketext("navNext");
		860	} else {
		861	push @links, $r->maketext("Next Problem"), "", $r->maketext("navNextGrey");
		862	}
		863
		864	my $tail = "";
		865
		866	$tail .= "&displayMode=".$self->{displayMode} if defined $self->{displayMode};
		867	$tail .= "&showOldAnswers=".$self->{will}->{showOldAnswers}
		868	if defined $self->{will}->{showOldAnswers};
254	return $self->navMacro($args, $tail, @links);	869	return $self->navMacro($args, $tail, @links);
255	}	870	}
256		871
257	sub title {	872	sub title {
258	my $self = shift;	873	my ($self) = @_;
259	my $setName = $self->{set}->id;	874	my $r = $self->r;
260	my $problemNumber = $self->{problem}->id;	875	# using the url arguments won't break if the set/problem are invalid
261		876	my $setID = WeBWorK::ContentGenerator::underscore2nbsp($self->r->urlpath->arg("setID"));
262	return "$setName : Problem $problemNumber";	877	my $problemID = $self->r->urlpath->arg("problemID");
263	}
264		878
		879	return $r->maketext("[_1]: Problem [_2]",$setID, $problemID);
		880	}
		881
		882
		883	# now altered to outsource most output operations to the template, main functions now are simply error checking and answer processing - ghe3
265	sub body {	884	sub body {
266	my $self = shift;	885	my $self = shift;
267
268	# unpack some useful variables
269	my $r = $self->{r};
270	my $wwdb = $self->{wwdb};
271	my $set = $self->{set};	886	my $set = $self->{set};
272	my $problem = $self->{problem};	887	my $problem = $self->{problem};
273	my $permissionLevel = $self->{permissionLevel};
274	my $submitAnswers = $self->{submitAnswers};
275	my $checkAnswers = $self->{checkAnswers};
276	my $previewAnswers = $self->{previewAnswers};
277	my %want = %{ $self->{want} };
278	my %can = %{ $self->{can} };
279	my %must = %{ $self->{must} };
280	my %will = %{ $self->{will} };
281	my $pg = $self->{pg};	888	my $pg = $self->{pg};
		889
		890	my $valid = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::check_invalid($self);
		891	unless($valid eq "valid"){
		892	return $valid;
		893	}
		894
		895	# my $editorLink = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_editorLink($self);
		896	# if($editorLink eq "permission_error"){
		897	# return "";
		898	# }
		899
		900	##### answer processing #####
		901	debug("begin answer processing");
		902	# if answers were submitted:
		903	my $scoreRecordedMessage = WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::process_and_log_answer($self);
		904	debug("end answer processing");
		905
		906	##### javaScripts #############
		907	# WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_JS($self);
		908
		909	##### output #####
		910	# WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_summary($self);
		911
		912	###########################
		913	# print style sheet for correct and incorrect answers
		914	###########################
		915
		916	# WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_CSS($self);
		917
		918	###########################
		919	# main form
		920	###########################
		921
		922	# WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_main_form($self,$editorLink);
		923
		924	# WeBWorK::ContentGenerator::ProblemUtil::ProblemUtil::output_footer($self);
		925
		926	# debugging stuff
		927	if (0) {
		928	print
		929	CGI::hr(),
		930	CGI::h2("debugging information"),
		931	CGI::h3("form fields"),
		932	ref2string($self->{formFields}),
		933	CGI::h3("user object"),
		934	ref2string($self->{user}),
		935	CGI::h3("set object"),
		936	ref2string($set),
		937	CGI::h3("problem object"),
		938	ref2string($problem),
		939	CGI::h3("PG object"),
		940	ref2string($pg, {'WeBWorK::PG::Translator' => 1});
		941	}
		942	debug("leaving body of Problem.pm");
		943	return "";
		944	}
		945
		946	# output_form_start subroutine
		947
		948	# prints out the beginning of the main form, and the necessary hidden authentication fields
		949
		950	sub output_form_start{
		951	my $self = shift;
		952	my $r = $self->r;
		953	print CGI::start_form(-method=>"POST", -action=> $r->uri,-name=>"problemMainForm", onsubmit=>"submitAction()");
		954	print $self->hidden_authen_fields;
		955	return "";
		956	}
		957
		958	# output_problem_body subroutine
		959
		960	# prints out the body of the current problem
		961
		962	sub output_problem_body{
		963	my $self = shift;
		964	my $pg = $self->{pg};
		965
		966	print "\n";
		967	print CGI::p($pg->{body_text});
		968	return "";
		969	}
		970
		971	# output_message subroutine
		972
		973	# prints out a message about the problem
		974
		975	sub output_message{
		976	my $self = shift;
		977	my $pg = $self->{pg};
		978
		979	print CGI::p(CGI::b("Note: "). CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg};
		980	return "";
		981	}
		982
		983	# output_editorLink subroutine
		984
		985	# processes and prints out the correct link to the editor of the current problem
		986
		987	sub output_editorLink{
		988
		989	my $self = shift;
		990
		991	my $set = $self->{set};
		992	my $problem = $self->{problem};
		993	my $pg = $self->{pg};
		994
		995	my $r = $self->r;
		996
		997	my $authz = $r->authz;
		998	my $urlpath = $r->urlpath;
		999	my $user = $r->param('user');
		1000
		1001	my $courseName = $urlpath->arg("courseID");
		1002
		1003	# FIXME: move editor link to top, next to problem number.
		1004	# format as "[edit]" like we're doing with course info file, etc.
		1005	# add edit link for set as well.
		1006	my $editorLink = "";
		1007	# if we are here without a real homework set, carry that through
		1008	my $forced_field = [];
		1009	$forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if
		1010	($set->set_id eq 'Undefined_Set');
		1011	if ($authz->hasPermissions($user, "modify_problem_sets")) {
		1012	my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor", $r,
		1013	courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id);
		1014	my $editorURL = $self->systemLink($editorPage, params=>$forced_field);
		1015	$editorLink = CGI::p(CGI::a({href=>$editorURL,target =>'WW_Editor'}, "Edit this problem"));
		1016	}
282		1017
283	##### translation errors? #####	1018	##### translation errors? #####
284		1019
285	if ($pg->{flags}->{error_flag}) {	1020	if ($pg->{flags}->{error_flag}) {
286	return translationError($pg->{errors}, $pg->{body_text});	1021	if ($authz->hasPermissions($user, "view_problem_debugging_info")) {
		1022	print $self->errorOutput($pg->{errors}, $pg->{body_text});
		1023	} else {
		1024	print $self->errorOutput($pg->{errors}, "You do not have permission to view the details of this error.");
287	}	1025	}
		1026	print "";
		1027	}
		1028	else{
		1029	print $editorLink;
		1030	}
		1031	return "";
		1032	}
		1033
		1034	# output_checkboxes subroutine
		1035
		1036	# prints out the checkbox input elements that are available for the current problem
		1037
		1038	sub output_checkboxes{
		1039	my $self = shift;
		1040	my %can = %{ $self->{can} };
		1041	my %will = %{ $self->{will} };
		1042
		1043	if ($can{showCorrectAnswers}) {
		1044	print WeBWorK::CGI_labeled_input(
		1045	-type => "checkbox",
		1046	-id => "showCorrectAnswers_id",
		1047	-label_text => "Show correct answers",
		1048	-input_attr => $will{showCorrectAnswers} ?
		1049	{
		1050	-name => "showCorrectAnswers",
		1051	-checked => "checked",
		1052	-value => 1,
		1053	}
		1054	:
		1055	{
		1056	-name => "showCorrectAnswers",
		1057	-value => 1,
		1058	}
		1059	);
		1060	}
		1061	if ($can{showHints}) {
		1062	print CGI::div({style=>"color:red"},
		1063	WeBWorK::CGI_labeled_input(
		1064	-type => "checkbox",
		1065	-id => "showHints_id",
		1066	-label_text => "Show Hints",
		1067	-input_attr => $will{showHints} ?
		1068	{
		1069	-name => "showHints",
		1070	-checked => "checked",
		1071	-value => 1,
		1072	}
		1073	:
		1074	{
		1075	-name => "showCorrectAnswers",
		1076	-value => 1,
		1077	}
		1078	)
		1079	);
		1080	}
		1081	if ($can{showSolutions}) {
		1082	print WeBWorK::CGI_labeled_input(
		1083	-type => "checkbox",
		1084	-id => "showSolutions_id",
		1085	-label_text => "Show Solutions",
		1086	-input_attr => $will{showSolutions} ?
		1087	{
		1088	-name => "showSolutions",
		1089	-checked => "checked",
		1090	-value => 1,
		1091	}
		1092	:
		1093	{
		1094	-name => "showCorrectAnswers",
		1095	-value => 1,
		1096	}
		1097	);
		1098	}
288		1099
289	##### answer processing #####	1100	if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) {
		1101	print CGI::br();
		1102	}
290		1103
291	# if answers were submitted:	1104	return "";
292	if ($submitAnswers) {	1105	}
293	# store answers in DB for sticky answers	1106
294	my %answersToStore;	1107	# output_submit_buttons
295	my %answerHash = %{ $pg->{answers} };	1108
296	$answersToStore{$_} = $answerHash{$_}->{original_student_ans}	1109	# prints out the submit button input elements that are available for the current problem
297	foreach (keys %answerHash);	1110
298	my $answerString = encodeAnswers(%answersToStore,	1111	sub output_submit_buttons{
299	@{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });	1112	my $self = shift;
300	$problem->last_answer($answerString);	1113	my $r = $self->r;
301	$wwdb->setProblem($problem);	1114	my %can = %{ $self->{can} };
		1115
		1116	my $user = $r->param('user');
		1117	my $effectiveUser = $r->param('effectiveUser');
		1118
		1119	print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"previewAnswers_id", -input_attr=>{-name=>"previewAnswers", -value=>"Preview Answers"});
		1120	if ($can{checkAnswers}) {
		1121	print WeBWorK::CGI_labeled_input(-type=>"submit", -id=>"checkAnswers_id", -input_attr=>{-name=>"checkAnswers", -value=>"Check Answers"});
		1122	}
		1123	if ($can{getSubmitButton}) {
		1124	if ($user ne $effectiveUser) {
		1125	# if acting as a student, make it clear that answer submissions will
		1126	# apply to the student's records, not the professor's.
		1127	print CGI::submit(-name=>"submitAnswers", -label=>$r->maketext("Submit answers for [_1]",$effectiveUser));
		1128	} else {
		1129	#print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers", -onclick=>"alert('submit button clicked')");
		1130	print CGI::submit(-name=>"submitAnswers", -label=>$r->maketext("Submit answers"), -onclick=>"");
		1131	# FIXME for unknown reasons the -onclick label seems to have to be there in order to allow the forms onsubmit to trigger
		1132	# WTF???
302		1133	}
303	# store state in DB if it makes sense	1134	}
304	if ($will{recordAnswers}) {	1135
		1136	return "";
		1137	}
		1138
		1139	# output_score_summary subroutine
		1140
		1141	# prints out a summary of the student's current progress and status on the current problem
		1142
		1143	sub output_score_summary{
		1144	my $self = shift;
		1145	my $r = $self->r;
		1146	my $problem = $self->{problem};
		1147	my $set = $self->{set};
		1148	my $pg = $self->{pg};
		1149	my $scoreRecordedMessage = "";
		1150	unless(defined $self->{scoreRecordedMessage}){
		1151	$scoreRecordedMessage = $self->{scoreRecordedMessage};
		1152	}
		1153	my $submitAnswers = $self->{submitAnswers};
		1154
		1155	# score summary
		1156	my $attempts = $problem->num_correct + $problem->num_incorrect;
		1157	#my $attemptsNoun = $attempts != 1 ? $r->maketext("times") : $r->maketext("time");
		1158	my $problem_status = $problem->status \|\| 0;
		1159	my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number
		1160	#my ($attemptsLeft, $attemptsLeftNoun);
		1161	my $attemptsLeft = $problem->max_attempts - $attempts;
		1162	# if ($problem->max_attempts == -1) {
		1163	# # unlimited attempts
		1164	# $attemptsLeft = $r->maketext("unlimited");
		1165	# $attemptsLeftNoun = $r->maketext("attempts");
		1166	# } else {
		1167	# $attemptsLeft = $problem->max_attempts - $attempts;
		1168	# $attemptsLeftNoun = $attemptsLeft == 1 ? $r->maketext("attempt") : $r->maketext("attempts");
		1169	# }
		1170
		1171	my $setClosed = 0;
		1172	my $setClosedMessage;
		1173	if (before($set->open_date) or after($set->due_date)) {
		1174	$setClosed = 1;
		1175	if (before($set->open_date)) {
		1176	$setClosedMessage = $r->maketext("This homework set is not yet open.");
		1177	} elsif (after($set->due_date)) {
		1178	$setClosedMessage = $r->maketext("This homework set is closed.");
		1179	}
		1180	}
		1181	#if (before($set->open_date) or after($set->due_date)) {
		1182	# $setClosed = 1;
		1183	# $setClosedMessage = "This homework set is closed.";
		1184	# if ($authz->hasPermissions($user, "view_answers")) {
		1185	# $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded.";
		1186	# } else {
		1187	# $setClosedMessage .= " Additional attempts will not be recorded.";
		1188	# }
		1189	#}
		1190	unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) {
		1191	my $notCountedMessage = ($problem->value) ? "" : $r->maketext("(This problem will not count towards your grade.)");
		1192	print CGI::p(join("",
		1193	$submitAnswers ? $scoreRecordedMessage . CGI::br() : "",
		1194	$r->maketext("You have attempted this problem [quant,_1,time,times].",$attempts), CGI::br(),
		1195	$submitAnswers ? $r->maketext("You received a score of [_1] for this attempt.",sprintf("%.0f%%", $pg->{result}->{score} * 100)) . CGI::br():'',
305	$problem->attempted(1);	1196	$problem->attempted
306	$problem->status($pg->{state}->{recorded_score});	1197	? $r->maketext("Your overall recorded score is [_1]. [_2]",$lastScore,$notCountedMessage) . CGI::br()
307	$problem->num_correct($pg->{state}->{num_of_correct_ans});	1198	: "",
308	$problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});	1199	# $setClosed ? $setClosedMessage : $r->maketext("You have [_1] [_2] remaining.",$attemptsLeft,$attemptsLeftNoun)
309	$wwdb->setProblem($problem);	1200	$setClosed ? $setClosedMessage : $r->maketext("You have [negquant,_1,unlimited attempts,attempt,attempts] remaining.",$attemptsLeft)
310	# write to the transaction log, just to make sure
311	writeLog($self->{courseEnvironment}, "transaction",
312	$problem->id."\t".
313	$problem->set_id."\t".
314	$problem->login_id."\t".
315	$problem->source_file."\t".
316	$problem->value."\t".
317	$problem->max_attempts."\t".
318	$problem->problem_seed."\t".
319	$problem->status."\t".
320	$problem->attempted."\t".
321	$problem->last_answer."\t".
322	$problem->num_correct."\t".
323	$problem->num_incorrect
324	);	1201	));
		1202	}else {
		1203	print CGI::p($pg->{state}->{state_summary_msg});
325	}	1204	}
326	}
327		1205
328	##### output #####	1206	return "";
		1207	}
		1208
		1209	# output_misc subroutine
		1210
		1211	# prints out other necessary elements
		1212
		1213	sub output_misc{
		1214
		1215	my $self = shift;
		1216	my $r = $self->r;
		1217	my $ce = $r->ce;
		1218	my $db = $r->db;
		1219	my $pg = $self->{pg};
		1220	my %will = %{ $self->{will} };
		1221	my $user = $r->param('user');
		1222
		1223	print CGI::start_div();
		1224
		1225	my $pgdebug = join(CGI::br(), @{$pg->{pgcore}->{flags}->{DEBUG_messages}} );
		1226	my $pgwarning = join(CGI::br(), @{$pg->{pgcore}->{flags}->{WARNING_messages}} );
		1227	my $pginternalerrors = join(CGI::br(), @{$pg->{pgcore}->get_internal_debug_messages} );
		1228	my $pgerrordiv = $pgdebug\|\|$pgwarning\|\|$pginternalerrors; # is 1 if any of these are non-empty
		1229
		1230	print CGI::p({style=>"color:red;"}, "Checking additional error messages") if $pgerrordiv ;
		1231	print CGI::p("pg debug<br/> $pgdebug" ) if $pgdebug ;
		1232	print CGI::p("pg warning<br/>$pgwarning" ) if $pgwarning ;
		1233	print CGI::p("pg internal errors<br/> $pginternalerrors") if $pginternalerrors;
		1234	print CGI::end_div() if $pgerrordiv ;
		1235
		1236	# save state for viewOptions
		1237	print CGI::hidden(
		1238	-name => "showOldAnswers",
		1239	-value => $will{showOldAnswers}
		1240	),
		1241
		1242	CGI::hidden(
		1243	-name => "displayMode",
		1244	-value => $self->{displayMode}
		1245	);
		1246	print( CGI::hidden(
		1247	-name => 'editMode',
		1248	-value => $self->{editMode},
		1249	)
		1250	) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile';
		1251
		1252	# this is a security risk -- students can use this to find the source code for the problem
		1253
		1254	my $permissionLevel = $db->getPermissionLevel($user)->permission;
		1255	my $professorPermissionLevel = $ce->{userRoles}->{professor};
		1256	print( CGI::hidden(
		1257	-name => 'sourceFilePath',
		1258	-value => $self->{problem}->{source_file}
		1259	)) if defined($self->{problem}->{source_file}) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors
		1260
		1261	print( CGI::hidden(
		1262	-name => 'problemSeed',
		1263	-value => $r->param("problemSeed")
		1264	)) if defined($r->param("problemSeed")) and $permissionLevel>= $professorPermissionLevel; # only allow this for professors
		1265
		1266	return "";
		1267	}
		1268
		1269	# output_summary subroutine
		1270
		1271	# prints out the summary of the questions that the student has answered for the current problem, along with available information about correctness
		1272
		1273	sub output_summary{
		1274
		1275	my $self = shift;
		1276
		1277	my $editMode = $self->{editMode};
		1278	my $problem = $self->{problem};
		1279	my $pg = $self->{pg};
		1280	my $submitAnswers = $self->{submitAnswers};
		1281	my %will = %{ $self->{will} };
		1282	my $checkAnswers = $self->{checkAnswers};
		1283	my $previewAnswers = $self->{previewAnswers};
		1284
		1285	my $r = $self->r;
		1286
		1287	my $authz = $r->authz;
		1288	my $user = $r->param('user');
329		1289
330	# attempt summary	1290	# attempt summary
331	if ($submitAnswers or $will{showCorrectAnswers}) {	1291	#FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything.
		1292	# until after the due date
		1293	# do I need to check $will{showCorrectAnswers} to make preflight work??
		1294	if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) {
332	# print this if user submitted answers OR requested correct answers	1295	# print this if user submitted answers OR requested correct answers
		1296
333	print $self->attemptResults($pg, $submitAnswers,	1297	print $self->attemptResults($pg, 1,
334	$will{showCorrectAnswers},	1298	$will{showCorrectAnswers},
335	$pg->{flags}->{showPartialCorrectAnswers}, 0);	1299	$pg->{flags}->{showPartialCorrectAnswers}, 1, 1);
336	} elsif ($checkAnswers) {	1300	} elsif ($checkAnswers) {
337	# print this if user previewed answers	1301	# print this if user previewed answers
338	print $self->attemptResults($pg, 1, 0, 1, 0);	1302	print CGI::div({class=>'ResultsWithError'},"ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED"), CGI::br();
		1303	print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1);
339	# show attempt answers	1304	# show attempt answers
340	# don't show correct answers	1305	# show correct answers if asked
341	# show attempt results (correctness)	1306	# show attempt results (correctness)
342	# don't show attempt previews	1307	# show attempt previews
343	} elsif ($previewAnswers) {	1308	} elsif ($previewAnswers) {
344	# print this if user previewed answers	1309	# print this if user previewed answers
345	print $self->attemptResults($pg, 1, 0, 0, 1);	1310	print CGI::div({class=>'ResultsWithError'},"PREVIEW ONLY -- ANSWERS NOT RECORDED"),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1);
346	# show attempt answers	1311	# show attempt answers
347	# don't show correct answers	1312	# don't show correct answers
348	# don't show attempt results (correctness)	1313	# don't show attempt results (correctness)
349	# show attempt previews	1314	# show attempt previews
350	}	1315	}
351		1316
352	# score summary	1317	return "";
353	my $attempts = $problem->num_correct + $problem->num_incorrect;	1318	}
354	my $attemptsNoun = $attempts != 1 ? "times" : "time";	1319
355	my $lastScore = int ($problem->status * 100) . "%";	1320	# output_custom_edit_message
356	my ($attemptsLeft, $attemptsLeftNoun);	1321
357	if ($problem->max_attempts == -1) {	1322	# prints out a custom edit message
358	# unlimited attempts	1323
359	$attemptsLeft = "unlimited";	1324	sub output_custom_edit_message{
360	$attemptsLeftNoun = "attempts";	1325	my $self = shift;
361	} else {	1326	my $r = $self->r;
362	$attemptsLeft = $problem->max_attempts - $attempts;	1327	my $authz = $r->authz;
363	$attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";	1328	my $user = $r->param('user');
		1329	my $editMode = $self->{editMode};
		1330	my $problem = $self->{problem};
		1331
		1332	# custom message for editor
		1333	if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) {
		1334	if ($editMode eq "temporaryFile") {
		1335	print CGI::p(CGI::div({class=>'temporaryFile'}, "Viewing temporary file: ", $problem->source_file));
		1336	} elsif ($editMode eq "savedFile") {
		1337	# taken care of in the initialization phase
364	}	1338	}
365	my $setClosedMessage;
366	if (time < $set->open_date or time > $set->due_date) {
367	$setClosedMessage = "This problem set is closed.";
368	if ($permissionLevel > 0) {
369	$setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded.";
370	} else {
371	$setClosedMessage .= " Additional attempts will not be recorded.";
372	}	1339	}
		1340
		1341	return "";
		1342	}
		1343
		1344	# output_JS subroutine
		1345
		1346	# prints out the wz_tooltip.js script for the current site.
		1347
		1348	sub output_wztooltip_JS{
		1349
		1350	my $self = shift;
		1351	my $r = $self->r;
		1352	my $ce = $r->ce;
		1353
		1354	my $site_url = $ce->{webworkURLs}->{htdocs};
		1355
		1356	print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/wz_tooltip.js"}), CGI::end_script();
		1357	return "";
		1358	}
		1359
		1360	# output_CSS subroutine
		1361
		1362	# prints the CSS scripts to page. Does some PERL trickery to form the styles for the correct answers and the incorrect answers (which may be substituted with JS sometime in the future).
		1363
		1364	sub output_CSS{
		1365
		1366	my $self = shift;
		1367	my $r = $self->r;
		1368	my $ce = $r->ce;
		1369	my $pg = $self->{pg};
		1370
		1371	# always show colors for checkAnswers
		1372	# show colors for submit answer if
		1373	if (($self->{checkAnswers}) or ($self->{submitAnswers} and $pg->{flags}->{showPartialCorrectAnswers}) ) {
		1374	print CGI::start_style({type=>"text/css"});
		1375	print '#'.join(', #', @{ $self->{correct_ids} }), $ce->{pg}{options}{correct_answer} if ref( $self->{correct_ids} )=~/ARRAY/; #correct green
		1376	print '#'.join(', #', @{ $self->{incorrect_ids} }), $ce->{pg}{options}{incorrect_answer} if ref( $self->{incorrect_ids})=~/ARRAY/; #incorrect reddish
		1377	print CGI::end_style();
373	}	1378	}
374	print CGI::p(	1379
375	"You have attempted this problem $attempts $attemptsNoun.", CGI::br(),	1380	return "";
376	$problem->attempted	1381	}
377	? "Your recorded score is $lastScore." . CGI::br()	1382
378	: "",	1383	# output_past_answer_button
379	"You have $attemptsLeft $attemptsLeftNoun remaining.", CGI::br(),	1384
380	$setClosedMessage,	1385	# prints out the "Show Past Answers" button
		1386
		1387	sub output_past_answer_button{
		1388	my $self = shift;
		1389	my $r = $self->r;
		1390	my $problem = $self->{problem};
		1391
		1392	my $authz = $r->authz;
		1393	my $urlpath = $r->urlpath;
		1394	my $user = $r->param('user');
		1395
		1396	my $courseName = $urlpath->arg("courseID");
		1397
		1398	my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers", $r,
		1399	courseID => $courseName);
		1400	my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action
		1401
		1402	# print answer inspection button
		1403	if ($authz->hasPermissions($user, "view_answers")) {
		1404	print "\n",
		1405	CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"WW_Info"),"\n",
		1406	$self->hidden_authen_fields,"\n",
		1407	CGI::hidden(-name => 'courseID', -value=>$courseName), "\n",
		1408	CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n",
		1409	CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n",
		1410	CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n",
		1411	CGI::p( {-align=>"left"},
		1412	CGI::submit(-name => 'action', -value=>$r->maketext("Show Past Answers"))
		1413	), "\n",
		1414	CGI::endform();
		1415	}
		1416
		1417	return "";
		1418	}
		1419
		1420	# output_email_instructor subroutine
		1421
		1422	# prints out the "Email Instructor" button
		1423
		1424	sub output_email_instructor{
		1425	my $self = shift;
		1426	my $problem = $self->{problem};
		1427	my %will = %{ $self->{will} };
		1428	my $pg = $self->{pg};
		1429
		1430	print $self->feedbackMacro(
		1431	module => __PACKAGE__,
		1432	set => $self->{set}->set_id,
		1433	problem => $problem->problem_id,
		1434	displayMode => $self->{displayMode},
		1435	showOldAnswers => $will{showOldAnswers},
		1436	showCorrectAnswers => $will{showCorrectAnswers},
		1437	showHints => $will{showHints},
		1438	showSolutions => $will{showSolutions},
		1439	pg_object => $pg,
381	);	1440	);
382		1441
383	print CGI::hr();
384
385	# main form
386	print
387	CGI::startform("POST", $r->uri),
388	$self->hidden_authen_fields,
389	CGI::p(CGI::i($pg->{result}->{msg})),
390	CGI::p($pg->{body_text}),
391	CGI::p(
392	($can{recordAnswers}
393	? CGI::submit(-name=>"submitAnswers",
394	-label=>"Submit Answers")
395	: ""),
396	($can{recordAnswers}
397	? CGI::submit(-name=>"checkAnswers",
398	-label=>"Check Answers")
399	: ""),
400	CGI::submit(-name=>"previewAnswers",
401	-label=>"Preview Answers"),
402	),
403	$self->viewOptions(),
404	CGI::endform();
405
406	# feedback form
407	my $ce = $self->{courseEnvironment};
408	my $root = $ce->{webworkURLs}->{root};
409	my $courseName = $ce->{courseName};
410	my $feedbackURL = "$root/$courseName/feedback/";
411	print
412	CGI::startform("POST", $feedbackURL),
413	$self->hidden_authen_fields,
414	CGI::hidden("module", __PACKAGE__),
415	CGI::hidden("set", $set->id),
416	CGI::hidden("problem", $problem->id),
417	CGI::hidden("displayMode", $self->{displayMode}),
418	CGI::hidden("showOldAnswers", $will{showOldAnswers}),
419	CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),
420	CGI::hidden("showHints", $will{showHints}),
421	CGI::hidden("showSolutions", $will{showSolutions}),
422	CGI::p({-align=>"right"},
423	CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback")
424	),
425	CGI::endform();
426
427	# warning output
428	if ($pg->{warnings} ne "") {
429	print CGI::hr(), warningOutput($pg->{warnings});
430	}
431
432	# debugging stuff
433	#print
434	# CGI::hr(),
435	# CGI::h2("debugging information"),
436	# CGI::h3("form fields"),
437	# ref2string($self->{formFields}),
438	# CGI::h3("user object"),
439	# ref2string($self->{user}),
440	# CGI::h3("set object"),
441	# ref2string($set),
442	# CGI::h3("problem object"),
443	# ref2string($problem),
444	# CGI::h3("PG object"),
445	# ref2string($pg, {'WeBWorK::PG::Translator' => 1});
446
447	return "";
448	}
449
450	##### output utilities #####
451
452	# this is used by ProblemSet.pm too, so don't fuck it up
453	sub translationError($$) {
454	my ($error, $details) = @_;
455	return	1442	return "";
456	CGI::h2("Software Error"),
457	CGI::p(<<EOF),
458	WeBWorK has encountered a software error while attempting to process this problem.
459	It is likely that there is an error in the problem itself.
460	If you are a student, contact your professor to have the error corrected.
461	If you are a professor, please consut the error output below for more informaiton.
462	EOF
463	CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)),
464	CGI::h3("Error context"), CGI::blockquote(CGI::pre($details));
465	}	1443	}
466		1444
467	# this is used by ProblemSet.pm too, so don't fuck it up	1445	# output_hidden_info subroutine
468	sub warningOutput($) {
469	my $warnings = shift;
470
471	return
472	CGI::h2("Software Warnings"),
473	CGI::p(<<EOF),
474	WeBWorK has encountered warnings while attempting to process this problem.
475	It is likely that this indicates an error or ambiguity in the problem itself.
476	If you are a student, contact your professor to have the problem corrected.
477	If you are a professor, please consut the error output below for more informaiton.
478	EOF
479	CGI::h3("Warning messages"),
480	CGI::blockquote(CGI::pre($warnings)),
481	;
482	}
483		1446
484	sub attemptResults($$$$$) {	1447	# outputs the hidden fields required for the form
485	my $self = shift;	1448
		1449	sub output_hidden_info{
486	my $pg = shift;	1450	my $self = shift;
487	my $showAttemptAnswers = shift;
488	my $showCorrectAnswers = shift;
489	my $showAttemptResults = $showAttemptAnswers && shift;
490	my $showAttemptPreview = shift \|\| 0;
491	my $problemResult = $pg->{result}; # the overall result of the problem
492	my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
493		1451
494	my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;	1452	if(defined $self->{correct_ids}){
495		1453	my $correctRef = $self->{correct_ids};
496	my $header = CGI::th("part");	1454	my @correct = @$correctRef;
497	$header .= $showAttemptAnswers ? CGI::th("entered") : "";	1455	foreach(@correct){
498	$header .= $showAttemptPreview ? CGI::th("preview") : "";	1456	print CGI::hidden(-name=>"correct_ids", -value=>$_."_val");
499	$header .= $showCorrectAnswers ? CGI::th("correct") : "";
500	$header .= $showAttemptResults ? CGI::th("result") : "";
501	$header .= $showMessages ? CGI::th("messages") : "";
502	my @tableRows = ( $header );
503	my $numCorrect;
504	foreach my $name (@answerNames) {
505	my $answerResult = $pg->{answers}->{$name};
506	my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
507	my $preview = ($showAttemptPreview
508	? $self->previewAnswer($answerResult)
509	: "");
510	my $correctAnswer = $answerResult->{correct_ans};
511	my $answerScore = $answerResult->{score};
512	my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
513
514	$numCorrect += $answerScore > 0;
515	my $resultString = $answerScore ? "correct" : "incorrect";
516
517	# get rid of the goofy prefix on the answer names (supposedly, the format
518	# of the answer names is changeable. this only fixes it for "AnSwEr"
519	$name =~ s/^AnSwEr//;
520
521	my $row = CGI::td($name);
522	$row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
523	$row .= $showAttemptPreview ? CGI::td($preview) : "";
524	$row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
525	$row .= $showAttemptResults ? CGI::td($resultString) : "";
526	$row .= $answerMessage ? CGI::td($answerMessage) : "";
527	push @tableRows, $row;
528	}
529
530	my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions";
531	my $scorePercent = int ($problemResult->{score} * 100) . "\%";
532	my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of "
533	. scalar @answerNames . " correct, for a score of $scorePercent.";
534	return CGI::table({-border=>1}, CGI::Tr(\@tableRows)) . CGI::p($summary);
535	}
536
537	sub viewOptions($) {
538	my $self = shift;
539	my $displayMode = $self->{displayMode};
540	my %must = %{ $self->{must} };
541	my %can = %{ $self->{can} };
542	my %will = %{ $self->{will} };
543
544	my $optionLine;
545	$can{showOldAnswers} and $optionLine .= join "",
546	"Show:  ",
547	CGI::checkbox(
548	-name => "showOldAnswers",
549	-checked => $will{showOldAnswers},
550	-label => "Saved answers",
551	), "  ";
552	$can{showCorrectAnswers} and $optionLine .= join "",
553	CGI::checkbox(
554	-name => "showCorrectAnswers",
555	-checked => $will{showCorrectAnswers},
556	-label => "Correct answers",
557	), "  ";
558	$can{showHints} and $optionLine .= join "",
559	CGI::checkbox(
560	-name => "showHints",
561	-checked => $will{showHints},
562	-label => "Hints",
563	), "  ";
564	$can{showSolutions} and $optionLine .= join "",
565	CGI::checkbox(
566	-name => "showSolutions",
567	-checked => $will{showSolutions},
568	-label => "Solutions",
569	), "  ";
570	$optionLine and $optionLine .= join "", CGI::br();
571
572	return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
573	"View equations as:  ",
574	CGI::radio_group(
575	-name => "displayMode",
576	-values => ['plainText', 'formattedText', 'images'],
577	-default => $displayMode,
578	-labels => {
579	plainText => "plain text",
580	formattedText => "formatted text",
581	images => "images",
582	}	1457	}
583	), CGI::br(),
584	$optionLine,
585	CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
586	);
587	}
588
589	sub previewAnswer($$) {
590	my ($self, $answerResult) = @_;
591	my $ce = $self->{courseEnvironment};
592	my $effectiveUser = $self->{effectiveUser};
593	my $set = $self->{set};
594	my $problem = $self->{problem};
595	my $displayMode = $self->{displayMode};
596
597	# note: right now, we have to do things completely differently when we are
598	# rendering math from INSIDE the translator and from OUTSIDE the translator.
599	# so we'll just deal with each case explicitly here. there's some code
600	# duplication that can be dealt with later by abstracting out tth/dvipng/etc.
601
602	my $tex = $answerResult->{preview_latex_string};
603
604	if ($displayMode eq "plainText") {
605	return $tex;
606	} elsif ($displayMode eq "formattedText") {
607	my $tthCommand = $ce->{externalPrograms}->{tth}
608	. " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
609	. "\$$tex\$\n"
610	. "END_OF_INPUT\n";
611
612
613	# call tth
614	my $result = `$tthCommand`;
615	if ($?) {
616	return "<b>[tth failed: $? $@]</b>";
617	}	1458	}
618	return $result;	1459	if(defined $self->{incorrect_ids}){
619	} elsif ($displayMode eq "images") {	1460	my $incorrectRef = $self->{incorrect_ids};
620	# how are we going to name this?	1461	my @incorrect = @$incorrectRef;
621	my $targetPathCommon = "/png/"	1462	foreach(@incorrect){
622	. $effectiveUser->id . "."	1463	print CGI::hidden(-name=>"incorrect_ids", -value=>$_."_val");
623	. $set->id . "."
624	. $problem->id . "."
625	. $answerResult->{ans_name} . ".png";
626
627	# figure out where to put things
628	my $wd = tempdir("webwork-dvipng-XXXXXXXX", DIR => $ce->{courseDirs}->{html_temp});
629	my $latex = $ce->{externalPrograms}->{latex};
630	my $dvipng = $ce->{externalPrograms}->{dvipng};
631	my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
632	# should use surePathToTmpFile, but we have to
633	# isolate it from the problem enivronment first
634	my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
635
636	# call dvipng to generate a preview
637	dvipng($wd, $latex, $dvipng, $tex, $targetPath);
638	if (-e $targetPath) {
639	return "<img src=\"$targetURL\" alt=\"$tex\" />";
640	} else {
641	return "<b>[math2img failed]</b>";
642	}
643	}	1464	}
		1465	}
		1466
		1467	return "";
644	}	1468	}
645		1469
646	##### permission queries #####	1470	# output_JS subroutine
647		1471
648	# this stuff should be abstracted out into the permissions system	1472	# outputs all of the Javascript needed for this page.
649	# however, the permission system only knows about things in the
650	# course environment and the username. hmmm...
651		1473
652	# also, i should fix these so that they have a consistent calling	1474	sub output_JS{
653	# format -- perhaps:	1475	my $self = shift;
654	# canPERM($courseEnv, $user, $set, $problem, $permissionLevel)	1476	my $r = $self->r;
		1477	my $ce = $r->ce;
655		1478
656	sub canShowCorrectAnswers($$) {	1479	my $site_url = $ce->{webworkURLs}->{htdocs};
657	my ($permissionLevel, $answerDate) = @_;	1480	print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/addOnLoadEvent.js"}), CGI::end_script();
658	return $permissionLevel > 0 \|\| time > $answerDate;	1481	print CGI::start_script({type=>"text/javascript", src=>"$site_url/js/color.js"}), CGI::end_script();
		1482	return "";
659	}	1483	}
660		1484
661	sub canShowSolutions($$) {	1485	# Simply here to indicate to the template that this page has body part methods which can be called
662	my ($permissionLevel, $answerDate) = @_;
663	return canShowCorrectAnswers($permissionLevel, $answerDate);
664	}
665		1486
666	sub canRecordAnswers($$$$$) {	1487	sub can_body_parts{
667	my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;	1488	return "";
668	my $permHigh = $permissionLevel > 0;
669	my $timeOK = time >= $openDate && time <= $dueDate;
670	my $attemptsOK = $maxAttempts == -1 \|\| $attempts <= $maxAttempts;
671	my $recordAnswers = $permHigh \|\| ($timeOK && $attemptsOK);
672	return $recordAnswers;
673	}
674
675	sub mustRecordAnswers($) {
676	my ($permissionLevel) = @_;
677	return $permissionLevel == 0;
678	}	1489	}
679		1490
680	1;	1491	1;

 Legend:



Removed from v.719
 


changed lines


 
Added in v.6967
 Legend:



Removed from v.719
 


changed lines


 
Added in v.6967
-Removed from v.719
+Added in v.6967

aubreyja at gmail dot com	ViewVC Help
Powered by ViewVC 1.0.9