[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 428 Revision 429
… …
2use base qw(WeBWorK::ContentGenerator); 2use base qw(WeBWorK::ContentGenerator);
3 3
4use strict; 4use strict;
5use warnings; 5use warnings;
6use CGI qw(:html :form); 6use CGI qw(:html :form);
7use WeBWorK::Utils qw(ref2string); 7use WeBWorK::Utils qw(ref2string encodeAnswers decodeAnswers);
8use WeBWorK::PG; 8use WeBWorK::PG;
9use WeBWorK::Form; 9use WeBWorK::Form;
10 10
11# user 11# user
12# key 12# key
… …
17# showHints 17# showHints
18# showSolutions 18# showSolutions
19# 19#
20# AnSwEr# - answer blanks in problem 20# AnSwEr# - answer blanks in problem
21# 21#
22# redisplay - name of the "Redisplay" button 22# redisplay - name of the "Redisplay Problem" button
23# processAnswers - name of "Submit Answers" button 23# submitAnswers - name of "Submit Answers" button
24 24
25sub title { 25sub title {
26 my ($self, $setName, $problemNumber) = @_; 26 my ($self, $setName, $problemNumber) = @_;
27 my $userName = $self->{r}->param('user'); 27 my $userName = $self->{r}->param('user');
28 return "Problem $problemNumber of problem set $setName for $userName"; 28 return "Problem $problemNumber of problem set $setName for $userName";
29} 29}
30
31# TODO:
32# :) enforce permissions for showCorrectAnswers and showSolutions
33# (use $PRIV = $mustPRIV || ($canPRIV && $wantPRIV) -- cool syntax!)
34# 2. if answers were not submitted and there are student answers in the DB,
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
30 42
31sub body { 43sub body {
32 my ($self, $setName, $problemNumber) = @_; 44 my ($self, $setName, $problemNumber) = @_;
33 my $courseEnv = $self->{courseEnvironment}; 45 my $courseEnv = $self->{courseEnvironment};
34 my $r = $self->{r}; 46 my $r = $self->{r};
35 my $userName = $r->param('user'); 47 my $userName = $r->param('user');
36 48
37 # fix format of setName and problem 49 # fix format of setName and problem
38 # (i want dennis to cut "set" and "prob" off before calling me)
39 $setName =~ s/^set//; 50 $setName =~ s/^set//;
40 $problemNumber =~ s/^prob//; 51 $problemNumber =~ s/^prob//;
41 52
42 # get database information 53 ##### database setup #####
54
43 my $classlist = WeBWorK::DB::Classlist->new($courseEnv); 55 my $classlist = WeBWorK::DB::Classlist->new($courseEnv);
44 my $wwdb = WeBWorK::DB::WW->new($courseEnv); 56 my $wwdb = WeBWorK::DB::WW->new($courseEnv);
57 my $authdb = WeBWorK::DB::Auth->new($courseEnv);
58
45 my $user = $classlist->getUser($userName); 59 my $user = $classlist->getUser($userName);
46 my $set = $wwdb->getSet($userName, $setName); 60 my $set = $wwdb->getSet($userName, $setName);
47 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 61 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
48 my $psvn = $wwdb->getPSVN($userName, $setName); 62 my $psvn = $wwdb->getPSVN($userName, $setName);
63 my $permissionLevel = $authdb->getPermissions($userName);
64
65 ##### form processing #####
49 66
50 # set options from form fields (see comment at top of file for names) 67 # set options from form fields (see comment at top of file for names)
51 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode}; 68 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
52 my $showOldAnswers = $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers};
53 my $showCorrectAnswers = $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers};
54 my $showHints = $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints};
55 my $showSolutions = $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions};
56 my $redisplay = $r->param("redisplay"); 69 my $redisplay = $r->param("redisplay");
57 my $processAnswers = $r->param("submitAnswers"); 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;
58 77
59 # coerce form fields into CGI::Vars format 78 # coerce form fields into CGI::Vars format
60 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars }; 79 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
61 80
62 # TODO: 81 ##### permissions #####
63 # 1. enforce privs for showCorrectAnswers and showSolutions 82
64 # (use $PRIV = $canPRIV && $wantPRIV -- cool syntax!) 83 # does the user have permission to use certain options?
65 # 2. if answers were not submitted and there are student answers in the DB, 84 my $canShowOldAnswers = 1;
66 # decode them and put them into $formFields for the translator 85 my $canShowCorrectAnswers = canShowCorrectAnswers($permissionLevel, $set->answer_date);
67 # 3. Latex2HTML massaging code 86 my $canShowHints = 1;
68 # 4. store submitted answers hash in database for sticky answers 87 my $canShowSolutions = canShowSolutions($permissionLevel, $set->answer_date);
69 # 5. deal with the results of answer evaluation and grading :p 88 my $canRecordAnswers = canRecordAnswers($permissionLevel, $set->open_date, $set->due_date);
70 # 6. introduce a recordAnswers option, which works on the same principle as 89
71 # the other priv-based options 90 # are certain options enforced?
72 # 7. make warnings work 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 #####
73 115
74 my $pg = WeBWorK::PG->new( 116 my $pg = WeBWorK::PG->new(
75 $courseEnv, 117 $courseEnv,
76 $r->param('user'), 118 $r->param('user'),
77 $r->param('key'), 119 $r->param('key'),
… …
79 $problemNumber, 121 $problemNumber,
80 { # translation options 122 { # translation options
81 displayMode => $displayMode, 123 displayMode => $displayMode,
82 showHints => $showHints, 124 showHints => $showHints,
83 showSolutions => $showSolutions, 125 showSolutions => $showSolutions,
126 # try leaving processAnswers on all the time:
84 processAnswers => $processAnswers ? 1 : 0, 127 processAnswers => 1, #$submitAnswers ? 1 : 0,
85 }, 128 },
86 $formFields 129 $formFields
87 ); 130 );
88 131
132 # handle any errors in translation
89 if ($pg->{flags}->{error_flag}) { 133 if ($pg->{flags}->{error_flag}) {
90 # there was an error in translation 134 # there was an error in translation
135 print
91 print h2("Software Error"); 136 h2("Software Error"),
92 print p(<<EOF); 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 "";
202}
203
204# -----
205
206sub translationError($$) {
207 my ($error, $details) = @_;
208 return
209 p(<<EOF),
93WeBWorK has encountered a software error while attempting to process this problem. 210WeBWorK has encountered a software error while attempting to process this problem.
94It is likely that there is an error in the problem itself. 211It is likely that there is an error in the problem itself.
95If you are a student, contact your professor to have the error corrected. 212If you are a student, contact your professor to have the error corrected.
96If you are a professor, please consut the error output below for more informaiton. 213If you are a professor, please consut the error output below for more informaiton.
97EOF 214EOF
98 print h3("Error messages"), blockquote(pre($pg->{errors})); 215 h3("Error messages"), blockquote(pre($error)),
99 print h3("Error context"), blockquote(pre($pg->{body_text})); 216 h3("Error context"), blockquote(pre($details));
100 return ""; 217}
218
219sub attemptResults($$$) {
220 my $pg = shift;
221 my $showCorrectAnswers = shift;
222 my $showAttemptResults = shift;
223 my $problemResult = $pg->{result}; # the overall result of the problem
224 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
225
226 my $header = th("answer") . th("attempt");
227 $header .= $showCorrectAnswers ? th("correct") : "";
228 $header .= $showAttemptResults ? th("result") : "";
229 $header .= th("messages");
230 my @tableRows = ( $header );
231 my $numCorrect;
232 foreach my $name (@answerNames) {
233 my $answerResult = $pg->{answers}->{$name};
234 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
235 my $correctAnswer = $answerResult->{correct_ans};
236 my $answerScore = $answerResult->{score};
237 my $answerMessage = $answerResult->{ans_message};
238
239 $numCorrect += $answerScore > 0;
240 my $resultString = $answerScore ? "correct :^)" : "incorrect >:(";
241
242 my $row = td($name) . td($studentAnswer);
243 $row .= $showCorrectAnswers ? td($correctAnswer) : "";
244 $row .= $showAttemptResults ? td($resultString) : "";
245 $row .= $answerMessage ? td($answerMessage) : "";
246 push @tableRows, $row;
101 } 247 }
102 248
103 # Previous answer results 249 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
104 if ($processAnswers) { 250 my $message = i($problemResult->{msg});
105 print h3("Results of your latest attempt"); 251 my $summary = "You answered $numCorrect questions out of "
106 print attemptResults($pg, $showCorrectAnswers, $pg->{flags}->{showPartialCorrectAnswers}); 252 . scalar @answerNames . " correct, for a score of $scorePercent.";
107 print hr(); 253 return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary);
108 } 254}
109 255
110 # main form 256sub viewOptions($$$$$) {
111 print startform("POST", $r->uri); 257 my ($displayMode, $showOldAnswers, $showCorrectAnswers,
112 print $self->hidden_authen_fields; 258 $showHints, $showSolutions) = @_;
113 print $self->hidden_fields(qw(displayMode showOldAnswers showCorrectAnswers showHints showSolutions)); 259 return div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
114 print p($pg->{body_text});
115 print p(submit(-name=>"submitAnswers", -label=>"Submit Answers"));
116 print endform();
117 print hr();
118
119 # view options
120 # what i'd really like to do here is:
121 # - preserve the answers currently in the form fields
122 # - display the answer summary box
123 # - NOT record answers UNDER ANY CIRCUMSTANCES!
124 print startform("POST", $r->uri);
125 #print $self->hidden_fields();
126 print p("View equations as: ", 260 "View equations as: &nbsp;",
127 radio_group( 261 radio_group(
128 -name => "displayMode", 262 -name => "displayMode",
129 -values => ['plainText', 'formattedText', 'images'], 263 -values => ['plainText', 'formattedText', 'images'],
130 -default => $displayMode, 264 -default => $displayMode,
131 -labels => { 265 -labels => {
132 plainText => "plain text", 266 plainText => "plain text",
133 formattedText => "formatted text", 267 formattedText => "formatted text",
134 images => "images", 268 images => "images",
135 } 269 }
136 ), br(), 270 ), br(),
271 "Show: &nbsp;",
137 checkbox( 272 checkbox(
138 -name => "showOldAnswers", 273 -name => "showOldAnswers",
139 -checked => $showOldAnswers, 274 -checked => $showOldAnswers,
140 -label => "Show old answers", 275 -label => "Old answers",
141 ), br(), 276 ), "&nbsp;&nbsp;",
142 checkbox( 277 checkbox(
143 -name => "showCorrectAnswers", 278 -name => "showCorrectAnswers",
144 -checked => $showCorrectAnswers, 279 -checked => $showCorrectAnswers,
145 -label => "Show correct answers", 280 -label => "Correct answers",
146 ), br(), 281 ), "&nbsp;&nbsp;",
147 checkbox( 282 checkbox(
148 -name => "showHints", 283 -name => "showHints",
149 -checked => $showHints, 284 -checked => $showHints,
150 -label => "Show hints", 285 -label => "Hints",
151 ), br(), 286 ), "&nbsp;&nbsp;",
152 checkbox( 287 checkbox(
153 -name => "showSolutions", 288 -name => "showSolutions",
154 -checked => $showSolutions, 289 -checked => $showSolutions,
155 -label => "Show solutions", 290 -label => "Solutions",
156 ), br(), 291 ), br(),
292 submit(-name=>"redisplay", -label=>"Redisplay Problem"),
157 ); 293 );
158 print p(submit(-name=>"redisplay", -label=>"Redisplay Problem"));
159 print endform();
160 print hr();
161
162 # debugging stuff
163 print h2("debugging information");
164 print h3("form fields");
165 print ref2string($formFields);
166 print h3("PG object");
167 print ref2string($pg, {'WeBWorK::PG::Translator' => 1});
168
169 return "";
170} 294}
171 295
172sub attemptResults { 296# -----
173 my $pg = shift; 297
174 my $showCorrectAnswers = shift; 298# this stuff should be abstracted out into the permissions system
175 my $showAttemptResults = shift; 299# however, the permission system only knows about things in the
176 my $problemResult = $pg->{result}; # the overall result of the problem 300# course environment and the username. hmmm...
177 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} }; 301
178 302sub canShowCorrectAnswers($$) {
179 my $header = th("answer") . th("attempt"); 303 my ($permissionLevel, $answerDate) = @_;
180 $header .= $showCorrectAnswers ? th("correct") : ""; 304 return $permissionLevel > 0 || time > $answerDate;
181 $header .= $showAttemptResults ? th("result") : ""; 305}
182 $header .= th("messages"); 306
183 my @tableRows = ( $header ); 307sub canShowSolutions($$) {
184 my $numCorrect; 308 my ($permissionLevel, $answerDate) = @_;
185 foreach my $name (@answerNames) { 309 return canShowCorrectAnswers($permissionLevel, $answerDate);
186 my $answerResult = $pg->{answers}->{$name}; 310}
187 my $studentAnswer = $answerResult->{student_ans}; 311
188 my $correctAnswer = $answerResult->{correct_ans}; 312sub canRecordAnswers($$$) {
189 my $answerScore = $answerResult->{score}; 313 my ($permissionLevel, $openDate, $dueDate) = @_;
190 my $answerMessage = $answerResult->{ans_message}; 314 return $permissionLevel > 0 || (time >= $openDate && time <= $dueDate);
191 315}
192 $numCorrect += $answerScore > 0; 316
193 my $resultString = $answerScore ? "correct :^)" : "incorrect >:("; 317sub mustRecordAnswers($) {
194 318 my ($permissionLevel) = @_;
195 my $row = td($name) . td($studentAnswer); 319 return $permissionLevel == 0;
196 $row .= $showCorrectAnswers ? td($correctAnswer) : "";
197 $row .= $showAttemptResults ? td($resultString) : "";
198 $row .= $answerMessage ? td($answerMessage) : "";
199 push @tableRows, $row;
200 }
201
202 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
203 my $message = i($problemResult->{msg});
204 my $summary = "You answered $numCorrect questions out of "
205 . scalar @answerNames . " correct, for a score of $scorePercent.";
206 return table({-border=>1}, Tr(\@tableRows)) . p($message, br(), $summary);
207} 320}
208 321
2091; 3221;
Legend:
Removed from v.428  
changed lines
  Added in v.429
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9