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

Diff of /trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm

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

Revision 429 Revision 3391
1################################################################################
2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v 1.176 2005/07/14 13:15:25 glarose 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.
15################################################################################
16
1package WeBWorK::ContentGenerator::Problem; 17package WeBWorK::ContentGenerator::Problem;
2use base qw(WeBWorK::ContentGenerator); 18use base qw(WeBWorK::ContentGenerator);
3 19
20=head1 NAME
21
22WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem.
23
24=cut
25
4use strict; 26use strict;
5use warnings; 27use warnings;
6use CGI qw(:html :form); 28use CGI qw();
7use WeBWorK::Utils qw(ref2string encodeAnswers decodeAnswers); 29use File::Path qw(rmtree);
30use WeBWorK::Form;
8use WeBWorK::PG; 31use WeBWorK::PG;
32use WeBWorK::PG::ImageGenerator;
33use WeBWorK::PG::IO;
34use WeBWorK::Utils qw(readFile writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory);
35use WeBWorK::DB::Utils qw(global2user user2global findDefaults);
9use WeBWorK::Form; 36use WeBWorK::Timing;
37use URI::Escape;
10 38
11# user 39use WeBWorK::Utils::Tasks qw(fake_set fake_problem);
12# key 40
41################################################################################
42# CGI param interface to this module (up-to-date as of v1.153)
43################################################################################
44
45# Standard params:
13# 46#
14# displayMode 47# user - user ID of real user
15# showOldAnswers 48# key - session key
16# showCorrectAnswers 49# effectiveUser - user ID of effective user
17# showHints
18# showSolutions
19# 50#
20# AnSwEr# - answer blanks in problem 51# Integration with PGProblemEditor:
21# 52#
53# editMode - if set, indicates alternate problem source location.
54# can be "temporaryFile" or "savedFile".
55#
56# sourceFilePath - path to file to be edited
57# problemSeed - force problem seed to value
58# success - success message to display
59# failure - failure message to display
60#
61# Rendering options:
62#
63# displayMode - name of display mode to use
64#
65# showOldAnswers - request that last entered answer be shown (if allowed)
66# showCorrectAnswers - request that correct answers be shown (if allowed)
67# showHints - request that hints be shown (if allowed)
68# showSolutions - request that solutions be shown (if allowed)
69#
70# Problem interaction:
71#
72# AnSwEr# - answer blanks in problem
73#
22# redisplay - name of the "Redisplay Problem" button 74# redisplay - name of the "Redisplay Problem" button
23# submitAnswers - name of "Submit Answers" button 75# submitAnswers - name of "Submit Answers" button
76# checkAnswers - name of the "Check Answers" button
77# previewAnswers - name of the "Preview Answers" button
24 78
25sub title { 79################################################################################
26 my ($self, $setName, $problemNumber) = @_; 80# "can" methods
27 my $userName = $self->{r}->param('user'); 81################################################################################
28 return "Problem $problemNumber of problem set $setName for $userName";
29}
30 82
31# TODO: 83# Subroutines to determine if a user "can" perform an action. Each subroutine is
32# :) enforce permissions for showCorrectAnswers and showSolutions 84# called with the following arguments:
33# (use $PRIV = $mustPRIV || ($canPRIV && $wantPRIV) -- cool syntax!) 85#
34# 2. if answers were not submitted and there are student answers in the DB, 86# ($self, $User, $EffectiveUser, $Set, $Problem)
35# decode them and put them into $formFields for the translator
36# 3. Latex2HTML massaging code
37# 4. store submitted answers hash in database for sticky answers
38# 5. deal with the results of answer evaluation and grading :p
39# :) introduce a recordAnswers option, which works on the same principle as
40# the other permission-based options
41# 7. make warnings work
42 87
43sub body { 88# Note that significant parts of the "can" methods are lifted into the
44 my ($self, $setName, $problemNumber) = @_; 89# GatewayQuiz module. It isn't direct, however, because of the necessity
45 my $courseEnv = $self->{courseEnvironment}; 90# of dealing with versioning there.
46 my $r = $self->{r}; 91
47 my $userName = $r->param('user'); 92sub can_showOldAnswers {
93 #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
48 94
49 # fix format of setName and problem
50 $setName =~ s/^set//;
51 $problemNumber =~ s/^prob//;
52
53 ##### database setup #####
54
55 my $classlist = WeBWorK::DB::Classlist->new($courseEnv);
56 my $wwdb = WeBWorK::DB::WW->new($courseEnv);
57 my $authdb = WeBWorK::DB::Auth->new($courseEnv);
58
59 my $user = $classlist->getUser($userName);
60 my $set = $wwdb->getSet($userName, $setName);
61 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
62 my $psvn = $wwdb->getPSVN($userName, $setName);
63 my $permissionLevel = $authdb->getPermissions($userName);
64
65 ##### form processing #####
66
67 # set options from form fields (see comment at top of file for names)
68 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
69 my $redisplay = $r->param("redisplay");
70 my $submitAnswers = $r->param("submitAnswers");
71
72 my $wantShowOldAnswers = $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers};
73 my $wantShowCorrectAnswers = $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers};
74 my $wantShowHints = $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints};
75 my $wantShowSolutions = $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions};
76 my $wantRecordAnswers = $r->param("recordAnswers") || 1;
77
78 # coerce form fields into CGI::Vars format
79 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
80
81 ##### permissions #####
82
83 # does the user have permission to use certain options?
84 my $canShowOldAnswers = 1;
85 my $canShowCorrectAnswers = canShowCorrectAnswers($permissionLevel, $set->answer_date);
86 my $canShowHints = 1;
87 my $canShowSolutions = canShowSolutions($permissionLevel, $set->answer_date);
88 my $canRecordAnswers = canRecordAnswers($permissionLevel, $set->open_date, $set->due_date);
89
90 # are certain options enforced?
91 my $mustShowOldAnswers = 0;
92 my $mustShowCorrectAnswers = 0;
93 my $mustShowHints = 0;
94 my $mustShowSolutions = 0;
95 my $mustRecordAnswers = mustRecordAnswers($permissionLevel);
96
97 # final values for options
98 my $showOldAnswers = $mustShowOldAnswers || ($canShowOldAnswers && $wantShowOldAnswers );
99 my $showCorrectAnswers = $mustShowCorrectAnswers || ($canShowCorrectAnswers && $wantShowCorrectAnswers);
100 my $showHints = $mustShowHints || ($canShowHints && $wantShowHints );
101 my $showSolutions = $mustShowSolutions || ($canShowSolutions && $wantShowSolutions );
102 my $recordAnswers = $mustRecordAnswers || ($canRecordAnswers && $wantRecordAnswers );
103
104 ##### sticky answers #####
105
106 # [TODO #2]
107
108 if (not $submitAnswers and $showOldAnswers) {
109 # only do this if new answers are NOT being submitted
110 my %oldAnswers = decodeAnswers($problem->last_answer);
111 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
112 }
113
114 ##### translation #####
115
116 my $pg = WeBWorK::PG->new(
117 $courseEnv,
118 $r->param('user'),
119 $r->param('key'),
120 $setName,
121 $problemNumber,
122 { # translation options
123 displayMode => $displayMode,
124 showHints => $showHints,
125 showSolutions => $showSolutions,
126 # try leaving processAnswers on all the time:
127 processAnswers => 1, #$submitAnswers ? 1 : 0,
128 },
129 $formFields
130 );
131
132 # handle any errors in translation
133 if ($pg->{flags}->{error_flag}) {
134 # there was an error in translation
135 print
136 h2("Software Error"),
137 translationError($pg->{errors}, $pg->{body_text});
138
139 return "";
140 }
141
142 # massage LaTeX2HTML [TODO #3]
143
144 ##### answer processing #####
145
146 # if answers were submitted:
147 if ($submitAnswers) {
148 # store answers in DB for sticky answers [TODO #4]
149 my %answersToStore;
150 my %answerHash = %{ $pg->{answers} };
151 $answersToStore{$_} = $answerHash{$_}->{original_student_ans}
152 foreach (keys %answerHash);
153 my $answerString = encodeAnswers(%answersToStore,
154 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
155 $problem->last_answer($answerString);
156 $wwdb->setProblem($problem);
157
158 # store score in DB if it makes sense [TODO #5]
159
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 }
167
168 ##### output #####
169
170 # view options
171 # what i'd really like to do here is:
172 # - preserve the answers currently in the form fields
173 # - display the answer summary box
174 # - NOT record answers UNDER ANY CIRCUMSTANCES!
175
176 # main form
177 print
178 startform("POST", $r->uri),
179 $self->hidden_authen_fields,
180 p($pg->{body_text}),
181 p(submit(-name=>"submitAnswers", -label=>"Submit Answers")),
182 viewOptions($displayMode, $showOldAnswers, $showCorrectAnswers,
183 $showHints, $showSolutions),
184 endform(),
185 hr();
186
187 # debugging stuff
188 print
189 h2("debugging information"),
190 h3("form fields"),
191 ref2string($formFields),
192 h3("user object"),
193 ref2string($user),
194 h3("set object"),
195 ref2string($set),
196 h3("problem object"),
197 ref2string($problem),
198 h3("PG object"),
199 ref2string($pg, {'WeBWorK::PG::Translator' => 1});
200
201 return ""; 95 return 1;
202} 96}
203 97
204# ----- 98sub can_showCorrectAnswers {
205 99 my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
206sub translationError($$) { 100 my $authz = $self->r->authz;
207 my ($error, $details) = @_; 101
208 return 102 return
209 p(<<EOF), 103 after($Set->answer_date)
210WeBWorK has encountered a software error while attempting to process this problem. 104 ||
211It is likely that there is an error in the problem itself. 105 $authz->hasPermissions($User->user_id, "show_correct_answers_before_answer_date")
212If you are a student, contact your professor to have the error corrected. 106 ;
213If you are a professor, please consut the error output below for more informaiton.
214EOF
215 h3("Error messages"), blockquote(pre($error)),
216 h3("Error context"), blockquote(pre($details));
217} 107}
218 108
109sub can_showHints {
110 #my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
111
112 return 1;
113}
114
115sub can_showSolutions {
116 my ($self, $User, $EffectiveUser, $Set, $Problem) = @_;
117 my $authz = $self->r->authz;
118
119 return
120 after($Set->answer_date)
121 ||
122 $authz->hasPermissions($User->user_id, "show_solutions_before_answer_date")
123 ;
124}
125
126sub can_recordAnswers {
127 my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_;
128 my $authz = $self->r->authz;
129 my $thisAttempt = $submitAnswers ? 1 : 0;
130 if ($User->user_id ne $EffectiveUser->user_id) {
131 return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student");
132 }
133 if (before($Set->open_date)) {
134 return $authz->hasPermissions($User->user_id, "record_answers_before_open_date");
135 } elsif (between($Set->open_date, $Set->due_date)) {
136 my $max_attempts = $Problem->max_attempts;
137 my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt;
138 if ($max_attempts == -1 or $attempts_used < $max_attempts) {
139 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_with_attempts");
140 } else {
141 return $authz->hasPermissions($User->user_id, "record_answers_after_open_date_without_attempts");
142 }
143 } elsif (between($Set->due_date, $Set->answer_date)) {
144 return $authz->hasPermissions($User->user_id, "record_answers_after_due_date");
145 } elsif (after($Set->answer_date)) {
146 return $authz->hasPermissions($User->user_id, "record_answers_after_answer_date");
147 }
148}
149
150sub can_checkAnswers {
151 my ($self, $User, $EffectiveUser, $Set, $Problem, $submitAnswers) = @_;
152 my $authz = $self->r->authz;
153 my $thisAttempt = $submitAnswers ? 1 : 0;
154
155 if (before($Set->open_date)) {
156 return $authz->hasPermissions($User->user_id, "check_answers_before_open_date");
157 } elsif (between($Set->open_date, $Set->due_date)) {
158 my $max_attempts = $Problem->max_attempts;
159 my $attempts_used = $Problem->num_correct + $Problem->num_incorrect + $thisAttempt;
160 if ($max_attempts == -1 or $attempts_used < $max_attempts) {
161 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_with_attempts");
162 } else {
163 return $authz->hasPermissions($User->user_id, "check_answers_after_open_date_without_attempts");
164 }
165 } elsif (between($Set->due_date, $Set->answer_date)) {
166 return $authz->hasPermissions($User->user_id, "check_answers_after_due_date");
167 } elsif (after($Set->answer_date)) {
168 return $authz->hasPermissions($User->user_id, "check_answers_after_answer_date");
169 }
170}
171
172# Helper functions for calculating times
173sub before { return time <= $_[0] }
174sub after { return time >= $_[0] }
175sub between { my $t = time; return $t > $_[0] && $t < $_[1] }
176
177################################################################################
178# output utilities
179################################################################################
180
181# Note: the substance of attemptResults is lifted into GatewayQuiz.pm,
182# with some changes to the output format
183
219sub attemptResults($$$) { 184sub attemptResults {
185 my $self = shift;
220 my $pg = shift; 186 my $pg = shift;
187 my $showAttemptAnswers = shift;
221 my $showCorrectAnswers = shift; 188 my $showCorrectAnswers = shift;
189 my $showAttemptResults = $showAttemptAnswers && shift;
190 my $showSummary = shift;
222 my $showAttemptResults = shift; 191 my $showAttemptPreview = shift || 0;
192
193 my $ce = $self->r->ce;
194
223 my $problemResult = $pg->{result}; # the overall result of the problem 195 my $problemResult = $pg->{result}; # the overall result of the problem
224 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 196 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
225 197
226 my $header = th("answer") . th("attempt"); 198 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
199
200 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview";
201
202 # to make grabbing these options easier, we'll pull them out now...
203 my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}};
204
205 my $imgGen = WeBWorK::PG::ImageGenerator->new(
206 tempDir => $ce->{webworkDirs}->{tmp},
207 latex => $ce->{externalPrograms}->{latex},
208 dvipng => $ce->{externalPrograms}->{dvipng},
209 useCache => 1,
210 cacheDir => $ce->{webworkDirs}->{equationCache},
211 cacheURL => $ce->{webworkURLs}->{equationCache},
212 cacheDB => $ce->{webworkFiles}->{equationCacheDB},
213 dvipng_align => $imagesModeOptions{dvipng_align},
214 dvipng_depth_db => $imagesModeOptions{dvipng_depth_db},
215 );
216
217 my $header;
218 #$header .= CGI::th("Part");
219 $header .= $showAttemptAnswers ? CGI::th("Entered") : "";
220 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : "";
227 $header .= $showCorrectAnswers ? th("correct") : ""; 221 $header .= $showCorrectAnswers ? CGI::th("Correct") : "";
228 $header .= $showAttemptResults ? th("result") : ""; 222 $header .= $showAttemptResults ? CGI::th("Result") : "";
229 $header .= th("messages"); 223 $header .= $showMessages ? CGI::th("Messages") : "";
224 my $fully = '';
230 my @tableRows = ( $header ); 225 my @tableRows = ( $header );
231 my $numCorrect; 226 my $numCorrect = 0;
227 my $numBlanks =0;
228 my $tthPreambleCache;
232 foreach my $name (@answerNames) { 229 foreach my $name (@answerNames) {
233 my $answerResult = $pg->{answers}->{$name}; 230 my $answerResult = $pg->{answers}->{$name};
234 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans 231 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
232 my $preview = ($showAttemptPreview
233 ? $self->previewAnswer($answerResult, $imgGen, \$tthPreambleCache)
234 : "");
235 my $correctAnswer = $answerResult->{correct_ans}; 235 my $correctAnswer = $answerResult->{correct_ans};
236 my $answerScore = $answerResult->{score}; 236 my $answerScore = $answerResult->{score};
237 my $answerMessage = $answerResult->{ans_message}; 237 my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
238 238 $answerMessage =~ s/\n/<BR>/g;
239 $numCorrect += $answerScore > 0; 239 $numCorrect += $answerScore >= 1;
240 $numBlanks++ unless $studentAnswer =~/\S/; # unless student answer contains entry
240 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 241 my $resultString = $answerScore >= 1 ? "correct" :
242 $answerScore > 0 ? int($answerScore*100)."% correct" :
243 "incorrect";
244 $fully = 'completely ' if $answerScore >0 and $answerScore < 1;
241 245
242 my $row = td($name) . td($studentAnswer); 246 # get rid of the goofy prefix on the answer names (supposedly, the format
247 # of the answer names is changeable. this only fixes it for "AnSwEr"
248 #$name =~ s/^AnSwEr//;
249
250 my $row;
251 #$row .= CGI::td($name);
252 $row .= $showAttemptAnswers ? CGI::td($self->nbsp($studentAnswer)) : "";
253 $row .= $showAttemptPreview ? CGI::td($self->nbsp($preview)) : "";
243 $row .= $showCorrectAnswers ? td($correctAnswer) : ""; 254 $row .= $showCorrectAnswers ? CGI::td($self->nbsp($correctAnswer)) : "";
244 $row .= $showAttemptResults ? td($resultString) : ""; 255 $row .= $showAttemptResults ? CGI::td($self->nbsp($resultString)) : "";
245 $row .= $answerMessage ? td($answerMessage) : ""; 256 $row .= $showMessages ? CGI::td({-class=>"Message"},$self->nbsp($answerMessage)) : "";
246 push @tableRows, $row; 257 push @tableRows, $row;
247 } 258 }
248 259
260 # render equation images
261 $imgGen->render(refresh => 1);
262
263# my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
249 my $scorePercent = int ($problemResult->{score} * 100) . "\%"; 264 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100);
250 my $message = i($problemResult->{msg}); 265# FIXME -- I left the old code in in case we have to back out.
251 my $summary = "You answered $numCorrect questions out of " 266# my $summary = "On this attempt, you answered $numCorrect out of "
252 . scalar @answerNames . " correct, for a score of $scorePercent."; 267# . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
253 return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary); 268 my $summary = "";
269 unless (defined($problemResult->{summary}) and $problemResult->{summary} =~ /\S/) {
270 if (scalar @answerNames == 1) { #default messages
271 if ($numCorrect == scalar @answerNames) {
272 $summary .= CGI::div({class=>"ResultsWithoutError"},"The above answer is correct.");
273 } else {
274 $summary .= CGI::div({class=>"ResultsWithError"},"The above answer is NOT ${fully}correct.");
275 }
276 } else {
277 if ($numCorrect == scalar @answerNames) {
278 $summary .= CGI::div({class=>"ResultsWithoutError"},"All of the above answers are correct.");
279 }
280 unless ($numCorrect + $numBlanks == scalar( @answerNames)) {
281 $summary .= CGI::div({class=>"ResultsWithError"},"At least one of the above answers is NOT ${fully}correct.");
282 }
283 if ($numBlanks) {
284 my $s = ($numBlanks>1)?'':'s';
285 $summary .= CGI::div({class=>"ResultsAlert"},"$numBlanks of the questions remain$s unanswered.");
286 }
287 }
288 } else {
289 $summary = $problemResult->{summary}; # summary has been defined by grader
290 }
291 return
292 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows))
293 . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
254} 294}
255 295
256sub viewOptions($$$$$) { 296
257 my ($displayMode, $showOldAnswers, $showCorrectAnswers, 297# Note: previewAnswer is lifted into GatewayQuiz.pm
258 $showHints, $showSolutions) = @_; 298
259 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"}, 299sub previewAnswer {
260 "View equations as: &nbsp;", 300 my ($self, $answerResult, $imgGen, $tthPreambleCache) = @_;
261 radio_group( 301 my $ce = $self->r->ce;
262 -name => "displayMode", 302 my $effectiveUser = $self->{effectiveUser};
263 -values => ['plainText', 'formattedText', 'images'], 303 my $set = $self->{set};
264 -default => $displayMode, 304 my $problem = $self->{problem};
265 -labels => { 305 my $displayMode = $self->{displayMode};
266 plainText => "plain text", 306
267 formattedText => "formatted text", 307 # note: right now, we have to do things completely differently when we are
268 images => "images", 308 # rendering math from INSIDE the translator and from OUTSIDE the translator.
309 # so we'll just deal with each case explicitly here. there's some code
310 # duplication that can be dealt with later by abstracting out tth/dvipng/etc.
311
312 my $tex = $answerResult->{preview_latex_string};
313
314 return "" unless defined $tex and $tex ne "";
315
316 if ($displayMode eq "plainText") {
317 return $tex;
318 } elsif ($displayMode eq "formattedText") {
319
320 # read the TTH preamble, or use the cached copy passed in from the caller
321 my $tthPreamble;
322 if (defined $$tthPreambleCache) {
323 $tthPreamble = $$tthPreambleCache;
324 } else {
325 my $tthPreambleFile = $ce->{courseDirs}->{templates} . "/tthPreamble.tex";
326 if (-r $tthPreambleFile) {
327 $tthPreamble = readFile($tthPreambleFile);
328 # thanks to Jim Martino. each line in the definition file should end with
329 #a % to prevent adding supurious paragraphs to output:
330 $tthPreamble =~ s/(.)\n/$1%\n/g;
331 # solves the problem if the file doesn't end with a return:
332 $tthPreamble .="%\n";
333 # store preamble in cache:
334 $$tthPreambleCache = $tthPreamble;
335 } else {
269 } 336 }
270 ), br(), 337 }
271 "Show: &nbsp;", 338
272 checkbox( 339 # construct TTH command line
273 -name => "showOldAnswers", 340 my $tthCommand = $ce->{externalPrograms}->{tth}
274 -checked => $showOldAnswers, 341 . " -L -f5 -u -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
275 -label => "Old answers", 342 . $tthPreamble . "\\[" . $tex . "\\]\n"
276 ), "&nbsp;&nbsp;", 343 . "END_OF_INPUT\n";
277 checkbox( 344
345 # call tth
346 my $result = `$tthCommand`;
347 if ($?) {
348 return "<b>[tth failed: $? $@]</b>";
349 } else {
350 # avoid border problems in tables and remove unneeded initial <br>
351 $result =~ s/(<table [^>]*)>/$1 CLASS="ArrayLayout">/gi;
352 $result =~ s!\s*<br clear="all" />!!;
353 return $result;
354 }
355
356 } elsif ($displayMode eq "images") {
357 $imgGen->add($tex);
358 } elsif ($displayMode eq "jsMath") {
359 return '<SPAN CLASS="math">\\displaystyle{'.$tex.'}</SPAN>';
360 }
361}
362
363################################################################################
364# Template escape implementations
365################################################################################
366
367sub pre_header_initialize {
368 my ($self) = @_;
369 my $r = $self->r;
370 my $ce = $r->ce;
371 my $db = $r->db;
372 my $authz = $r->authz;
373 my $urlpath = $r->urlpath;
374
375 my $setName = $urlpath->arg("setID");
376 my $problemNumber = $r->urlpath->arg("problemID");
377 my $userName = $r->param('user');
378 my $effectiveUserName = $r->param('effectiveUser');
379 my $key = $r->param('key');
380
381 my $user = $db->getUser($userName); # checked
382 die "record for user $userName (real user) does not exist."
383 unless defined $user;
384
385 my $effectiveUser = $db->getUser($effectiveUserName); # checked
386 die "record for user $effectiveUserName (effective user) does not exist."
387 unless defined $effectiveUser;
388
389 # obtain the merged set for $effectiveUser
390 my $set = $db->getMergedSet($effectiveUserName, $setName); # checked
391
392# gateway check here: we want to be sure that someone isn't trying to take
393# a GatewayQuiz through the regular problem/homework mechanism, thereby
394# circumventing the versioning, time limits, etc.
395 die('Invalid access attempt: the Problem ContentGenerator was called ' .
396 'for a GatewayQuiz assignment.')
397 if ( defined($set) && defined( $set->assignment_type() ) &&
398 $set->assignment_type() =~ /gateway/ );
399
400 # Database fix (in case of undefined published values)
401 # this is only necessary because some people keep holding to ww1.9 which did not have a published field
402 # make sure published is set to 0 or 1
403 if ( $set and $set->published ne "0" and $set->published ne "1") {
404 my $globalSet = $db->getGlobalSet($set->set_id);
405 $globalSet->published("1"); # defaults to published
406 $db->putGlobalSet($globalSet);
407 $set = $db->getMergedSet($effectiveUserName, $setName);
408 } else {
409 # don't do anything just yet, maybe we're a professor and we're
410 # fabricating a set or haven't assigned it to ourselves just yet
411 }
412
413 # obtain the merged problem for $effectiveUser
414 my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked
415
416 my $editMode = $r->param("editMode");
417
418 if ($authz->hasPermissions($userName, "modify_problem_sets")) {
419 # professors are allowed to fabricate sets and problems not
420 # assigned to them (or anyone). this allows them to use the
421 # editor to
422
423 # if a User Set does not exist for this user and this set
424 # then we check the Global Set
425 # if that does not exist we create a fake set
426 # if it does, we add fake user data
427 unless (defined $set) {
428 my $userSetClass = $db->{set_user}->{record};
429 my $globalSet = $db->getGlobalSet($setName); # checked
430
431 if (not defined $globalSet) {
432 $set = fake_set($db);
433 } else {
434 $set = global2user($userSetClass, $globalSet);
435 $set->psvn(0);
436 }
437 }
438
439 # if that is not yet defined obtain the global problem,
440 # convert it to a user problem, and add fake user data
441 unless (defined $problem) {
442 my $userProblemClass = $db->{problem_user}->{record};
443 my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked
444 # if the global problem doesn't exist either, bail!
445 if(not defined $globalProblem) {
446 my $sourceFilePath = $r->param("sourceFilePath");
447 # These are problems from setmaker. If declared invalid, they won't come up
448 $self->{invalidProblem} = $self->{invalidSet} = 1 unless defined $sourceFilePath;
449# die "Problem $problemNumber in set $setName does not exist" unless defined $sourceFilePath;
450 $problem = fake_problem($db);
451 $problem->problem_id(1);
452 $problem->source_file($sourceFilePath);
453 $problem->user_id($effectiveUserName);
454 } else {
455 $problem = global2user($userProblemClass, $globalProblem);
456 $problem->user_id($effectiveUserName);
457 $problem->problem_seed(0);
458 $problem->status(0);
459 $problem->attempted(0);
460 $problem->last_answer("");
461 $problem->num_correct(0);
462 $problem->num_incorrect(0);
463 }
464 }
465
466 # now we're sure we have valid UserSet and UserProblem objects
467 # yay!
468
469 # now deal with possible editor overrides:
470
471 # if the caller is asking to override the source file, and
472 # editMode calls for a temporary file, do so
473 my $sourceFilePath = $r->param("sourceFilePath");
474 if (defined $sourceFilePath and
475 (not defined $editMode or $editMode eq "temporaryFile")) {
476 $problem->source_file($sourceFilePath);
477 }
478
479 # if the problem does not have a source file or no source file has been passed in
480 # then this is really an invalid problem (probably from a bad URL)
481 $self->{invalidProblem} = not (defined $sourceFilePath or $problem->source_file);
482
483 # if the caller is asking to override the problem seed, do so
484 my $problemSeed = $r->param("problemSeed");
485 if (defined $problemSeed) {
486 $problem->problem_seed($problemSeed);
487 }
488
489 my $publishedClass = ($set->published) ? "Published" : "Unpublished";
490 my $publishedText = ($set->published) ? "visible to students." : "hidden from students.";
491 $self->addmessage(CGI::p("This set is " . CGI::font({class=>$publishedClass}, $publishedText)));
492
493 # test for additional set validity if it's not already invalid
494 } else {
495 # A set is valid if it exists and if it is either published or the user is privileged.
496 $self->{invalidSet} = !(defined $set and ($set->published || $authz->hasPermissions($userName, "view_unpublished_sets")));
497 $self->{invalidProblem} = !(defined $problem and ($set->published || $authz->hasPermissions($userName, "view_unpublished_sets")));
498
499 $self->addbadmessage(CGI::p("This problem will not count towards your grade.")) if $problem and not $problem->value and not $self->{invalidProblem};
500 }
501
502 $self->{userName} = $userName;
503 $self->{effectiveUserName} = $effectiveUserName;
504 $self->{user} = $user;
505 $self->{effectiveUser} = $effectiveUser;
506 $self->{set} = $set;
507 $self->{problem} = $problem;
508 $self->{editMode} = $editMode;
509
510 ##### form processing #####
511
512 # set options from form fields (see comment at top of file for names)
513 my $displayMode = $r->param("displayMode") || $ce->{pg}->{options}->{displayMode};
514 my $redisplay = $r->param("redisplay");
515 my $submitAnswers = $r->param("submitAnswers");
516 my $checkAnswers = $r->param("checkAnswers");
517 my $previewAnswers = $r->param("previewAnswers");
518
519 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
520
521 $self->{displayMode} = $displayMode;
522 $self->{redisplay} = $redisplay;
523 $self->{submitAnswers} = $submitAnswers;
524 $self->{checkAnswers} = $checkAnswers;
525 $self->{previewAnswers} = $previewAnswers;
526 $self->{formFields} = $formFields;
527
528 # get result and send to message
529 my $status_message = $r->param("status_message");
530 $self->addmessage(CGI::p("$status_message")) if $status_message;
531
532 # now that we've set all the necessary variables quit out if the set or problem is invalid
533 return if $self->{invalidSet} || $self->{invalidProblem};
534
535 ##### permissions #####
536
537 # are we allowed to view this problem?
538 $self->{isOpen} = after($set->open_date) || $authz->hasPermissions($userName, "view_unopened_sets");
539 return unless $self->{isOpen};
540
541 # what does the user want to do?
542 #FIXME There is a problem with checkboxes -- if they are not checked they are invisible. Hence if the default mode in $ce is 1
543 # there is no way to override this. Probably this is ok for the last three options, but it was definitely not ok for showing
544 # saved answers which is normally on, but you want to be able to turn it off! This section should be moved to ContentGenerator
545 # so that you can set these options anywhere. We also need mechanisms for making them sticky.
546 my %want = (
547 showOldAnswers => defined($r->param("showOldAnswers")) ? $r->param("showOldAnswers") : $ce->{pg}->{options}->{showOldAnswers},
548 showCorrectAnswers => $r->param("showCorrectAnswers") || $ce->{pg}->{options}->{showCorrectAnswers},
549 showHints => $r->param("showHints") || $ce->{pg}->{options}->{showHints},
550 showSolutions => $r->param("showSolutions") || $ce->{pg}->{options}->{showSolutions},
551 recordAnswers => $submitAnswers,
552 checkAnswers => $checkAnswers,
553 getSubmitButton => 1,
554 );
555
556 # are certain options enforced?
557 my %must = (
558 showOldAnswers => 0,
559 showCorrectAnswers => 0,
560 showHints => 0,
561 showSolutions => 0,
562 recordAnswers => ! $authz->hasPermissions($userName, "avoid_recording_answers"),
563 checkAnswers => 0,
564 getSubmitButton => 0,
565 );
566
567 # does the user have permission to use certain options?
568 my @args = ($user, $effectiveUser, $set, $problem);
569 my %can = (
570 showOldAnswers => $self->can_showOldAnswers(@args),
571 showCorrectAnswers => $self->can_showCorrectAnswers(@args),
572 showHints => $self->can_showHints(@args),
573 showSolutions => $self->can_showSolutions(@args),
574 recordAnswers => $self->can_recordAnswers(@args, 0),
575 checkAnswers => $self->can_checkAnswers(@args, $submitAnswers),
576 getSubmitButton => $self->can_recordAnswers(@args, $submitAnswers),
577 );
578
579 # final values for options
580 my %will;
581 foreach (keys %must) {
582 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
583 }
584
585 ##### sticky answers #####
586
587 if (not ($submitAnswers or $previewAnswers or $checkAnswers) and $will{showOldAnswers}) {
588 # do this only if new answers are NOT being submitted
589 my %oldAnswers = decodeAnswers($problem->last_answer);
590 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
591 }
592
593 ##### translation #####
594
595 $WeBWorK::timer->continue("begin pg processing") if defined($WeBWorK::timer);
596 my $pg = WeBWorK::PG->new(
597 $ce,
598 $effectiveUser,
599 $key,
600 $set,
601 $problem,
602 $set->psvn, # FIXME: this field should be removed
603 $formFields,
604 { # translation options
605 displayMode => $displayMode,
606 showHints => $will{showHints},
607 showSolutions => $will{showSolutions},
608 refreshMath2img => $will{showHints} || $will{showSolutions},
609 processAnswers => 1,
610 },
611 );
612
613 $WeBWorK::timer->continue("end pg processing") if defined($WeBWorK::timer);
614
615 ##### fix hint/solution options #####
616
617 $can{showHints} &&= $pg->{flags}->{hintExists}
618 &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans};
619 $can{showSolutions} &&= $pg->{flags}->{solutionExists};
620
621 ##### store fields #####
622
623 $self->{want} = \%want;
624 $self->{must} = \%must;
625 $self->{can} = \%can;
626 $self->{will} = \%will;
627 $self->{pg} = $pg;
628}
629
630sub if_errors($$) {
631 my ($self, $arg) = @_;
632
633 if ($self->{isOpen}) {
634 return $self->{pg}->{flags}->{error_flag} ? $arg : !$arg;
635 } else {
636 return !$arg;
637 }
638}
639
640sub head {
641 my ($self) = @_;
642
643 return "" unless $self->{isOpen};
644 return $self->{pg}->{head_text} if $self->{pg}->{head_text};
645}
646
647# sub options {
648# my ($self) = @_;
649# warn "doing options in Problem";
650# return "" if $self->{invalidProblem};
651# my $sourceFilePathfield = '';
652# if($self->r->param("sourceFilePath")) {
653# $sourceFilePathfield = CGI::hidden(-name => "sourceFilePath",
654# -value => $self->r->param("sourceFilePath"));
655# }
656#
657# return join("",
658# CGI::start_form("POST", $self->{r}->uri),
659# $self->hidden_authen_fields,
660# $sourceFilePathfield,
661# CGI::hr(),
662# CGI::start_div({class=>"viewOptions"}),
663# $self->viewOptions(),
664# CGI::end_div(),
665# CGI::end_form()
666# );
667# }
668
669sub siblings {
670 my ($self) = @_;
671 my $r = $self->r;
672 my $db = $r->db;
673 my $urlpath = $r->urlpath;
674
675 # can't show sibling problems if the set is invalid
676 return "" if $self->{invalidSet};
677
678 my $courseID = $urlpath->arg("courseID");
679 my $setID = $self->{set}->set_id;
680 my $eUserID = $r->param("effectiveUser");
681 my @problemIDs = sort { $a <=> $b } $db->listUserProblems($eUserID, $setID);
682
683 print CGI::start_ul({class=>"LinksMenu"});
684 print CGI::start_li();
685 print CGI::span({style=>"font-size:larger"}, "Problems");
686 print CGI::start_ul();
687
688 foreach my $problemID (@problemIDs) {
689 my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Problem",
690 courseID => $courseID, setID => $setID, problemID => $problemID);
691 print CGI::li(CGI::a( {href=>$self->systemLink($problemPage,
692 params=>{ displayMode => $self->{displayMode},
693 showOldAnswers => $self->{will}->{showOldAnswers}
694 })}, "Problem $problemID")
695 );
696 }
697
698 print CGI::end_ul();
699 print CGI::end_li();
700 print CGI::end_ul();
701
702 return "";
703}
704
705sub nav {
706 my ($self, $args) = @_;
707 my $r = $self->r;
708 my $db = $r->db;
709 my $urlpath = $r->urlpath;
710
711 my $courseID = $urlpath->arg("courseID");
712 my $setID = $self->{set}->set_id if !($self->{invalidSet});
713 my $problemID = $self->{problem}->problem_id if !($self->{invalidProblem});
714 my $eUserID = $r->param("effectiveUser");
715
716 my ($prevID, $nextID);
717
718 if (!$self->{invalidProblem}) {
719 my @problemIDs = $db->listUserProblems($eUserID, $setID);
720 foreach my $id (@problemIDs) {
721 $prevID = $id if $id < $problemID
722 and (not defined $prevID or $id > $prevID);
723 $nextID = $id if $id > $problemID
724 and (not defined $nextID or $id < $nextID);
725 }
726 }
727
728 my @links;
729
730 if ($prevID) {
731 my $prevPage = $urlpath->newFromModule(__PACKAGE__,
732 courseID => $courseID, setID => $setID, problemID => $prevID);
733 push @links, "Previous Problem", $r->location . $prevPage->path, "navPrev";
734 } else {
735 push @links, "Previous Problem", "", "navPrev";
736 }
737
738 push @links, "Problem List", $r->location . $urlpath->parent->path, "navProbList";
739
740 if ($nextID) {
741 my $nextPage = $urlpath->newFromModule(__PACKAGE__,
742 courseID => $courseID, setID => $setID, problemID => $nextID);
743 push @links, "Next Problem", $r->location . $nextPage->path, "navNext";
744 } else {
745 push @links, "Next Problem", "", "navNext";
746 }
747
748 my $tail = "&displayMode=".$self->{displayMode}."&showOldAnswers=".$self->{will}->{showOldAnswers};
749 return $self->navMacro($args, $tail, @links);
750}
751
752sub title {
753 my ($self) = @_;
754
755 # using the url arguments won't break if the set/problem are invalid
756 my $setID = $self->r->urlpath->arg("setID");
757 my $problemID = $self->r->urlpath->arg("problemID");
758
759 return "$setID: Problem $problemID";
760}
761
762sub body {
763 my $self = shift;
764 my $r = $self->r;
765 my $ce = $r->ce;
766 my $db = $r->db;
767 my $authz = $r->authz;
768 my $urlpath = $r->urlpath;
769 my $user = $r->param('user');
770 my $effectiveUser = $r->param('effectiveUser');
771
772 if ($self->{invalidSet}) {
773 return CGI::div({class=>"ResultsWithError"},
774 CGI::p("The selected homework set (" . $urlpath->arg("setID") . ") is not a valid set for " . $r->param("effectiveUser") . "."));
775 }
776
777 if ($self->{invalidProblem}) {
778 return CGI::div({class=>"ResultsWithError"},
779 CGI::p("The selected problem (" . $urlpath->arg("problemID") . ") is not a valid problem for set " . $self->{set}->set_id . "."));
780 }
781
782 unless ($self->{isOpen}) {
783 return CGI::div({class=>"ResultsWithError"},
784 CGI::p("This problem is not available because the homework set that contains it is not yet open."));
785 }
786 # unpack some useful variables
787 my $set = $self->{set};
788 my $problem = $self->{problem};
789 my $editMode = $self->{editMode};
790 my $submitAnswers = $self->{submitAnswers};
791 my $checkAnswers = $self->{checkAnswers};
792 my $previewAnswers = $self->{previewAnswers};
793 my %want = %{ $self->{want} };
794 my %can = %{ $self->{can} };
795 my %must = %{ $self->{must} };
796 my %will = %{ $self->{will} };
797 my $pg = $self->{pg};
798
799 my $courseName = $urlpath->arg("courseID");
800
801 # FIXME: move editor link to top, next to problem number.
802 # format as "[edit]" like we're doing with course info file, etc.
803 # add edit link for set as well.
804 my $editorLink = "";
805 # if we are here without a real problem set, carry that through
806 my $forced_field = [];
807 $forced_field = ['sourceFilePath' => $r->param("sourceFilePath")] if
808 ($set->set_id eq 'Undefined_Set');
809 if ($authz->hasPermissions($user, "modify_problem_sets")) {
810 my $editorPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor",
811 courseID => $courseName, setID => $set->set_id, problemID => $problem->problem_id);
812 my $editorURL = $self->systemLink($editorPage, params=>$forced_field);
813 $editorLink = CGI::a({href=>$editorURL}, "Edit this problem");
814 }
815
816 ##### translation errors? #####
817
818 if ($pg->{flags}->{error_flag}) {
819 print $self->errorOutput($pg->{errors}, $pg->{body_text});
820 print $editorLink;
821 return "";
822 }
823
824 ##### answer processing #####
825 $WeBWorK::timer->continue("begin answer processing") if defined($WeBWorK::timer);
826 # if answers were submitted:
827 my $scoreRecordedMessage;
828 my $pureProblem;
829 if ($submitAnswers) {
830 # get a "pure" (unmerged) UserProblem to modify
831 # this will be undefined if the problem has not been assigned to this user
832 $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); # checked
833 if (defined $pureProblem) {
834 # store answers in DB for sticky answers
835 my %answersToStore;
836 my %answerHash = %{ $pg->{answers} };
837 $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!!
838 foreach (keys %answerHash);
839
840 # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating
841 # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs
842 # however we need to store them. Fortunately they are still in the input form.
843 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}};
844 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names);
845
846 # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order
847 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names);
848 my $answerString = encodeAnswers(%answersToStore,
849 @answer_order);
850
851 # store last answer to database
852 $problem->last_answer($answerString);
853 $pureProblem->last_answer($answerString);
854 $db->putUserProblem($pureProblem);
855
856 # store state in DB if it makes sense
857 if ($will{recordAnswers}) {
858 $problem->status($pg->{state}->{recorded_score});
859 $problem->attempted(1);
860 $problem->num_correct($pg->{state}->{num_of_correct_ans});
861 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
862 $pureProblem->status($pg->{state}->{recorded_score});
863 $pureProblem->attempted(1);
864 $pureProblem->num_correct($pg->{state}->{num_of_correct_ans});
865 $pureProblem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
866 if ($db->putUserProblem($pureProblem)) {
867 $scoreRecordedMessage = "Your score was recorded.";
868 } else {
869 $scoreRecordedMessage = "Your score was not recorded because there was a failure in storing the problem record to the database.";
870 }
871 # write to the transaction log, just to make sure
872 writeLog($self->{ce}, "transaction",
873 $problem->problem_id."\t".
874 $problem->set_id."\t".
875 $problem->user_id."\t".
876 $problem->source_file."\t".
877 $problem->value."\t".
878 $problem->max_attempts."\t".
879 $problem->problem_seed."\t".
880 $pureProblem->status."\t".
881 $pureProblem->attempted."\t".
882 $pureProblem->last_answer."\t".
883 $pureProblem->num_correct."\t".
884 $pureProblem->num_incorrect
885 );
886 } else {
887 if (before($set->open_date) or after($set->due_date)) {
888 $scoreRecordedMessage = "Your score was not recorded because this homework set is closed.";
889 } else {
890 $scoreRecordedMessage = "Your score was not recorded.";
891 }
892 }
893 } else {
894 $scoreRecordedMessage = "Your score was not recorded because this problem has not been assigned to you.";
895 }
896 }
897
898 # logging student answers
899
900 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'};
901 if ( defined($answer_log ) and defined($pureProblem)) {
902 if ($submitAnswers && !$authz->hasPermissions($effectiveUser, "dont_log_past_answers")) {
903 my $answerString = ""; my $scores = "";
904 my %answerHash = %{ $pg->{answers} };
905 # FIXME this is the line 552 error. make sure original student ans is defined.
906 # The fact that it is not defined is probably due to an error in some answer evaluator.
907 # But I think it is useful to suppress this error message in the log.
908 foreach (sort keys %answerHash) {
909 my $orig_ans = $answerHash{$_}->{original_student_ans};
910 my $student_ans = defined $orig_ans ? $orig_ans : '';
911 $answerString .= $student_ans."\t";
912 $scores .= $answerHash{$_}->{score} >= 1 ? "1" : "0";
913 }
914 $answerString = '' unless defined($answerString); # insure string is defined.
915 writeCourseLog($self->{ce}, "answer_log",
916 join("",
917 '|', $problem->user_id,
918 '|', $problem->set_id,
919 '|', $problem->problem_id,
920 '|', $scores, "\t",
921 time(),"\t",
922 $answerString,
923 ),
924 );
925
926 }
927 }
928
929 $WeBWorK::timer->continue("end answer processing") if defined($WeBWorK::timer);
930
931 ##### output #####
932 # custom message for editor
933 if ($authz->hasPermissions($user, "modify_problem_sets") and defined $editMode) {
934 if ($editMode eq "temporaryFile") {
935 print CGI::p(CGI::div({class=>'temporaryFile'}, "Viewing temporary file: ", $problem->source_file));
936 } elsif ($editMode eq "savedFile") {
937 # taken care of in the initialization phase
938 }
939 }
940 print CGI::start_div({class=>"problemHeader"});
941
942
943
944 # attempt summary
945 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything.
946 # until after the due date
947 # do I need to check $will{showCorrectAnswers} to make preflight work??
948 if (($pg->{flags}->{showPartialCorrectAnswers} >= 0 and $submitAnswers) ) {
949 # print this if user submitted answers OR requested correct answers
950
951 print $self->attemptResults($pg, 1,
952 $will{showCorrectAnswers},
953 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1);
954 } elsif ($checkAnswers) {
955 # print this if user previewed answers
956 print CGI::div({class=>'ResultsWithError'},"ANSWERS ONLY CHECKED -- ANSWERS NOT RECORDED"), CGI::br();
957 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1);
958 # show attempt answers
959 # show correct answers if asked
960 # show attempt results (correctness)
961 # show attempt previews
962 } elsif ($previewAnswers) {
963 # print this if user previewed answers
964 print CGI::div({class=>'ResultsWithError'},"PREVIEW ONLY -- ANSWERS NOT RECORDED"),CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1);
965 # show attempt answers
966 # don't show correct answers
967 # don't show attempt results (correctness)
968 # show attempt previews
969 }
970
971 print CGI::end_div();
972
973 # main form
974 print CGI::startform("POST", $r->uri);
975 print $self->hidden_authen_fields;
976
977 print CGI::start_div({class=>"problem"});
978 print CGI::p($pg->{body_text});
979 print CGI::p(CGI::b("Note: "), CGI::i($pg->{result}->{msg})) if $pg->{result}->{msg};
980 print CGI::end_div();
981
982 print CGI::start_p();
983
984 if ($can{showCorrectAnswers}) {
985 print CGI::checkbox(
278 -name => "showCorrectAnswers", 986 -name => "showCorrectAnswers",
279 -checked => $showCorrectAnswers, 987 -checked => $will{showCorrectAnswers},
280 -label => "Correct answers", 988 -label => "Show correct answers",
281 ), "&nbsp;&nbsp;", 989 );
990 }
991 if ($can{showHints}) {
992 print CGI::div({style=>"color:red"},
282 checkbox( 993 CGI::checkbox(
283 -name => "showHints", 994 -name => "showHints",
284 -checked => $showHints, 995 -checked => $will{showHints},
285 -label => "Hints", 996 -label => "Show Hints",
286 ), "&nbsp;&nbsp;", 997 )
287 checkbox( 998 );
999 }
1000 if ($can{showSolutions}) {
1001 print CGI::checkbox(
288 -name => "showSolutions", 1002 -name => "showSolutions",
289 -checked => $showSolutions, 1003 -checked => $will{showSolutions},
290 -label => "Solutions", 1004 -label => "Show Solutions",
291 ), br(),
292 submit(-name=>"redisplay", -label=>"Redisplay Problem"),
293 ); 1005 );
294} 1006 }
1007
1008 if ($can{showCorrectAnswers} or $can{showHints} or $can{showSolutions}) {
1009 print CGI::br();
1010 }
1011
1012 print CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers");
1013 if ($can{checkAnswers}) {
1014 print CGI::submit(-name=>"checkAnswers", -label=>"Check Answers");
1015 }
1016 if ($can{getSubmitButton}) {
1017 if ($user ne $effectiveUser) {
1018 # if acting as a student, make it clear that answer submissions will
1019 # apply to the student's records, not the professor's.
1020 print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers for $effectiveUser");
1021 } else {
1022 print CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers");
1023 }
1024 }
1025
1026 print CGI::end_p();
1027
1028 print CGI::start_div({class=>"scoreSummary"});
1029
1030 # score summary
1031 my $attempts = $problem->num_correct + $problem->num_incorrect;
1032 my $attemptsNoun = $attempts != 1 ? "times" : "time";
1033 my $problem_status = $problem->status || 0;
1034 my $lastScore = sprintf("%.0f%%", $problem_status * 100); # Round to whole number
1035 my ($attemptsLeft, $attemptsLeftNoun);
1036 if ($problem->max_attempts == -1) {
1037 # unlimited attempts
1038 $attemptsLeft = "unlimited";
1039 $attemptsLeftNoun = "attempts";
1040 } else {
1041 $attemptsLeft = $problem->max_attempts - $attempts;
1042 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
1043 }
1044
1045 my $setClosed = 0;
1046 my $setClosedMessage;
1047 if (before($set->open_date) or after($set->due_date)) {
1048 $setClosed = 1;
1049 if (before($set->open_date)) {
1050 $setClosedMessage = "This homework set is not yet open.";
1051 } elsif (after($set->due_date)) {
1052 $setClosedMessage = "This homework set is closed.";
1053 }
1054 }
1055 #if (before($set->open_date) or after($set->due_date)) {
1056 # $setClosed = 1;
1057 # $setClosedMessage = "This homework set is closed.";
1058 # if ($authz->hasPermissions($user, "view_answers")) {
1059 # $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded.";
1060 # } else {
1061 # $setClosedMessage .= " Additional attempts will not be recorded.";
1062 # }
1063 #}
1064 unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) {
1065 my $notCountedMessage = ($problem->value) ? "" : "(This problem will not count towards your grade.)";
1066 print CGI::p(
1067 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "",
1068 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
1069 $submitAnswers ?"You received a score of ".sprintf("%.0f%%", $pg->{result}->{score} * 100)." for this attempt.".CGI::br():'',
1070 $problem->attempted
1071 ? "Your overall recorded score is $lastScore. $notCountedMessage" . CGI::br()
1072 : "",
1073 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
1074 );
1075 }else {
1076 print CGI::p($pg->{state}->{state_summary_msg});
1077 }
1078 print CGI::end_div();
1079
1080 # save state for viewOptions
1081 print CGI::hidden(
1082 -name => "showOldAnswers",
1083 -value => $will{showOldAnswers}
1084 ),
295 1085
296# ----- 1086 CGI::hidden(
1087 -name => "displayMode",
1088 -value => $self->{displayMode}
1089 );
1090 print( CGI::hidden(
1091 -name => 'editMode',
1092 -value => $self->{editMode},
1093 )
1094 ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile';
1095 print( CGI::hidden(
1096 -name => 'sourceFilePath',
1097 -value => $self->{problem}->{source_file}
1098 )) if defined($self->{problem}->{source_file});
297 1099
298# this stuff should be abstracted out into the permissions system 1100 print( CGI::hidden(
299# however, the permission system only knows about things in the 1101 -name => 'problemSeed',
300# course environment and the username. hmmm... 1102 -value => $r->param("problemSeed")
301 1103 )) if defined($r->param("problemSeed"));
302sub canShowCorrectAnswers($$) { 1104
303 my ($permissionLevel, $answerDate) = @_; 1105 # end of main form
304 return $permissionLevel > 0 || time > $answerDate; 1106 print CGI::endform();
305} 1107
306 1108 print CGI::start_div({class=>"problemFooter"});
307sub canShowSolutions($$) { 1109
308 my ($permissionLevel, $answerDate) = @_; 1110 ## arguments for answer inspection button
309 return canShowCorrectAnswers($permissionLevel, $answerDate); 1111 #my $prof_url = $ce->{webworkURLs}->{oldProf};
310} 1112 #my $webworkURL = $ce->{webworkURLs}->{root};
311 1113 #my $cgi_url = $prof_url;
312sub canRecordAnswers($$$) { 1114 #$cgi_url=~ s|/[^/]*$||; # clip profLogin.pl
313 my ($permissionLevel, $openDate, $dueDate) = @_; 1115 #my $authen_args = $self->url_authen_args();
314 return $permissionLevel > 0 || (time >= $openDate && time <= $dueDate); 1116 #my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/";
315} 1117
316 1118 my $pastAnswersPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::ShowAnswers",
317sub mustRecordAnswers($) { 1119 courseID => $courseName);
318 my ($permissionLevel) = @_; 1120 my $showPastAnswersURL = $self->systemLink($pastAnswersPage, authen => 0); # no authen info for form action
319 return $permissionLevel == 0; 1121
1122 # print answer inspection button
1123 if ($authz->hasPermissions($user, "view_answers")) {
1124 print "\n",
1125 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n",
1126 $self->hidden_authen_fields,"\n",
1127 CGI::hidden(-name => 'courseID', -value=>$courseName), "\n",
1128 CGI::hidden(-name => 'problemID', -value=>$problem->problem_id), "\n",
1129 CGI::hidden(-name => 'setID', -value=>$problem->set_id), "\n",
1130 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n",
1131 CGI::p( {-align=>"left"},
1132 CGI::submit(-name => 'action', -value=>'Show Past Answers')
1133 ), "\n",
1134 CGI::endform();
1135 }
1136
1137 # feedback form url
1138 my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback",
1139 courseID => $courseName);
1140 my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action
1141
1142 #print feedback form
1143 print
1144 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n",
1145 $self->hidden_authen_fields,"\n",
1146 CGI::hidden("module", __PACKAGE__),"\n",
1147 CGI::hidden("set", $set->set_id),"\n",
1148 CGI::hidden("problem", $problem->problem_id),"\n",
1149 CGI::hidden("displayMode", $self->{displayMode}),"\n",
1150 CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n",
1151 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n",
1152 CGI::hidden("showHints", $will{showHints}),"\n",
1153 CGI::hidden("showSolutions", $will{showSolutions}),"\n",
1154 CGI::p({-align=>"left"},
1155 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor")
1156 ),
1157 CGI::endform(),"\n";
1158
1159 # FIXME print editor link
1160 print $editorLink; #empty unless it is appropriate to have an editor link.
1161
1162 print CGI::end_div();
1163
1164 # debugging stuff
1165 if (0) {
1166 print
1167 CGI::hr(),
1168 CGI::h2("debugging information"),
1169 CGI::h3("form fields"),
1170 ref2string($self->{formFields}),
1171 CGI::h3("user object"),
1172 ref2string($self->{user}),
1173 CGI::h3("set object"),
1174 ref2string($set),
1175 CGI::h3("problem object"),
1176 ref2string($problem),
1177 CGI::h3("PG object"),
1178 ref2string($pg, {'WeBWorK::PG::Translator' => 1});
1179 }
1180
1181 return "";
320} 1182}
321 1183
3221; 11841;
Legend:
Removed from v.429  
changed lines
  Added in v.3391
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9