[system] / branches / rel-2-3-dev / webwork-modperl / lib / WeBWorK / ContentGenerator / Problem.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-3-dev/webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm

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

Revision 399 Revision 1665
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.109 2003/12/09 01:12:31 sh002i 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;
2our @ISA = qw(WeBWorK::ContentGenerator); 18use base qw(WeBWorK::ContentGenerator);
19
20=head1 NAME
21
22WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem.
23
24=cut
3 25
4use strict; 26use strict;
5use warnings; 27use warnings;
6use lib '/home/malsyned/xmlrpc/daemon'; 28use CGI qw();
7use lib '/Users/gage/webwork-modperl/lib'; 29use File::Path qw(rmtree);
8use PGtranslator5; 30use WeBWorK::Form;
31use WeBWorK::PG;
9use WeBWorK::ContentGenerator; 32use WeBWorK::PG::ImageGenerator;
10use Apache::Constants qw(:common); 33use WeBWorK::PG::IO;
34use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory);
35use WeBWorK::DB::Utils qw(global2user user2global findDefaults);
36use WeBWorK::Timing;
11 37
38
12############################################################################### 39############################################################
13# Configuration 40#
41# user
42# effectiveUser
43# key
44#
45# displayMode
46# showOldAnswers
47# showCorrectAnswers
48# showHints
49# showSolutions
50#
51# AnSwEr# - answer blanks in problem
52#
53# redisplay - name of the "Redisplay Problem" button
54# submitAnswers - name of "Submit Answers" button
55# checkAnswers - name of the "Check Answers" button
56# previewAnswers - name of the "Preview Answers" button
57#
58# FIXME: this table is heinously out of date
59#
14############################################################################### 60############################################################
15my $USER_DIRECTORY = '/Users/gage';
16my $COURSE_SCRIPTS_DIRECTORY = "$USER_DIRECTORY/webwork/system/courseScripts/";
17my $MACRO_DIRECTORY = "$USER_DIRECTORY/webwork-modperl/courses/demoCourse/templates/macros/";
18my $TEMPLATE_DIRECTORY = "$USER_DIRECTORY/rochester_problib/";
19my $TEMP_URL = "http://127.0.0.1/~gage/rochester_problibtmp/";
20##my $HTML_DIRECTORY = "/Users/gage/Sites/rochester_problib/" #already obtained from courseEnvironment
21my $HTML_URL = "http://127.0.0.1/~gage/rochester_problib/";
22my $TEMP_DIRECTORY = ""; # has to be here... for now
23 61
62# FIXME: what is this?
63sub templateName {
64 "problem";
65}
66
67sub pre_header_initialize {
68 my ($self, $setName, $problemNumber) = @_;
69 my $r = $self->{r};
70 my $courseEnv = $self->{ce};
71 my $db = $self->{db};
72 my $userName = $r->param('user');
73 my $effectiveUserName = $r->param('effectiveUser');
74 my $key = $r->param('key');
75
76 my $user = $db->getUser($userName); # checked
77 die "record for user $userName (real user) does not exist."
78 unless defined $user;
79
80 my $effectiveUser = $db->getUser($effectiveUserName); # checked
81 die "record for user $effectiveUserName (effective user) does not exist."
82 unless defined $effectiveUser;
83
84 my $PermissionLevel = $db->getPermissionLevel($userName); # checked
85 die "permission level record for user $userName does not exist (but the user does? odd...)"
86 unless defined $PermissionLevel;
87 my $permissionLevel = $PermissionLevel->permission;
88
89 # obtain the merged set for $effectiveUser
90 my $set = $db->getMergedSet($effectiveUserName, $setName); # checked
91
92 # obtain the merged problem for $effectiveUser
93 my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked
94
95 my $editMode = $r->param("editMode");
96
97 if ($permissionLevel > 0 and defined $editMode) {
98 # professors are allowed to fabricate sets and problems not
99 # assigned to them (or anyone). this allows them to use the
100 # editor to
101
102 # if that is not yet defined obtain the global set, convert
103 # it to a user set, and add fake user data
104 unless (defined $set) {
105 my $userSetClass = $db->{set_user}->{record};
106 my $globalSet = $db->getGlobalSet($setName); # checked
107 # if the global set doesn't exist either, bail!
108 die "Set $setName does not exist"
109 unless defined $set;
110 $set = global2user($userSetClass, $globalSet);
111 $set->psvn(0);
112 }
113
114 # if that is not yet defined obtain the global problem,
115 # convert it to a user problem, and add fake user data
116 unless (defined $problem) {
117 my $userProblemClass = $db->{problem_user}->{record};
118 my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked
119 # if the global problem doesn't exist either, bail!
120 die "Problem $problemNumber in set $setName does not exist"
121 unless defined $problem;
122 $problem = global2user($userProblemClass, $globalProblem);
123 $problem->user_id($effectiveUserName);
124 $problem->problem_seed(0);
125 $problem->status(0);
126 $problem->attempted(0);
127 $problem->last_answer("");
128 $problem->num_correct(0);
129 $problem->num_incorrect(0);
130 }
131
132 # now we're sure we have valid UserSet and UserProblem objects
133 # yay!
134
135 # now deal with possible editor overrides:
136
137 # if the caller is asking to override the source file, and
138 # editMode calls for a temporary file, do so
139 my $sourceFilePath = $r->param("sourceFilePath");
140 if (defined $sourceFilePath and $editMode eq "temporaryFile") {
141 $problem->source_file($sourceFilePath);
142 }
143
144 # if the caller is asking to override the problem seed, do so
145 my $problemSeed = $r->param("problemSeed");
146 if (defined $problemSeed) {
147 $problem->problem_seed($problemSeed);
148 }
149 } else {
150 # students can't view problems not assigned to them
151 die "Set $setName is not assigned to $effectiveUserName"
152 unless defined $set;
153 die "Problem $problemNumber in set $setName is not assigned to $effectiveUserName"
154 unless defined $problem;
155 }
156
157 $self->{userName} = $userName;
158 $self->{effectiveUserName} = $effectiveUserName;
159 $self->{user} = $user;
160 $self->{effectiveUser} = $effectiveUser;
161 $self->{permissionLevel} = $permissionLevel;
162 $self->{set} = $set;
163 $self->{problem} = $problem;
164 $self->{editMode} = $editMode;
165
166 ##### form processing #####
167
168 # set options from form fields (see comment at top of file for names)
169 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
170 my $redisplay = $r->param("redisplay");
171 my $submitAnswers = $r->param("submitAnswers");
172 my $checkAnswers = $r->param("checkAnswers");
173 my $previewAnswers = $r->param("previewAnswers");
174
175 # fields which may be defined when using Problem Editor
176 #my $override_seed = ($permissionLevel>=10) ? $r->param('problemSeed') : undef;
177 #my $override_problem_source = ($permissionLevel>=10) ? $r->param('sourceFilePath') : undef;
178 #my $editMode = undef;
179 #my $submit_button = $r->param('submit_button');
180 #if ( defined($submit_button ) ) {
181 # $editMode = "temporaryFile" if $submit_button eq 'Refresh';
182 # $editMode = 'savedFile' if $submit_button eq 'Save';
183 #}
184 #
185 ##override using the source file data from the form field
186 #$problem->source_file($override_problem_source) if defined($override_problem_source);
187 #$problem->problem_seed($override_seed) if defined($override_seed);
188 #
189 ## store path to source file for title.
190 #$self->{problem_source_name} = $problem->source_file;
191 #$self->{edit_mode} = $editMode;
192 #$self->{current_problem_source} = (defined($override_problem_source) ) ?
193
194 # coerce form fields into CGI::Vars format
195 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
196
197
198 $self->{displayMode} = $displayMode;
199 $self->{redisplay} = $redisplay;
200 $self->{submitAnswers} = $submitAnswers;
201 $self->{checkAnswers} = $checkAnswers;
202 $self->{previewAnswers} = $previewAnswers;
203 $self->{formFields} = $formFields;
204
205 ##### permissions #####
206
207 # are we allowed to view this problem?
208 $self->{isOpen} = time >= $set->open_date || $permissionLevel > 0;
209 return unless $self->{isOpen};
210
211 # what does the user want to do?
212 my %want = (
213 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
214 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
215 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
216 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
217 recordAnswers => $submitAnswers,
218 checkAnswers => $checkAnswers,
219 );
220
221 # are certain options enforced?
222 my %must = (
223 showOldAnswers => 0,
224 showCorrectAnswers => 0,
225 showHints => 0,
226 showSolutions => 0,
227 recordAnswers => mustRecordAnswers($permissionLevel),
228 checkAnswers => 0,
229 );
230
231 # does the user have permission to use certain options?
232 my %can = (
233 showOldAnswers => 1,
234 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),
235 showHints => 1,
236 showSolutions => canShowSolutions($permissionLevel, $set->answer_date),
237 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
238 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
239 # attempts=num_correct+num_incorrect+1, as this happens before updating $problem
240 checkAnswers => canCheckAnswers($permissionLevel, $set->answer_date),
241 );
24############################################################################### 242 #########################################################
25# End configuration 243 # more complicated logic for showing check answer button:
26############################################################################### 244 #########################################################
245 # checkAnswers button shows up after due date -- once a student can't record anymore
246 # checkAnswers button always shows up when an instructor or TA is acting
247 # as someone else (the $user and $effectiveUserName aren't the same).
248 $can{checkAnswers} = ($can{checkAnswers} && not $can{recordAnswers} ) ||
249 ( defined($userName) and defined($effectiveUserName) and
250 ($userName ne $effectiveUserName)
251 );
252 #########################################################
253 # more complicated logif for showing "submit answer" button
254 #########################################################
255 # We hide the submit answer button if someone is acting as a student
256 # This prevents errors where you accidently submit the answer for a student
257 # Not sure whether this a feature or a bug
258
259 $can{recordAnswers} = ($can{recordAnswers} and not
260 ( defined($userName) and defined($effectiveUserName) and
261 ($userName ne $effectiveUserName)
262 )
263 );
264 # final values for options
265 my %will;
266 foreach (keys %must) {
267 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
268 }
269
270 ##### sticky answers #####
271
272 if (not ($submitAnswers or $previewAnswers or $checkAnswers) and $will{showOldAnswers}) {
273 # do this only if new answers are NOT being submitted
274 my %oldAnswers = decodeAnswers($problem->last_answer);
275 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
276 }
277
278 ##### translation #####
279
280 $WeBWorK::timer->continue("begin pg processing") if defined($WeBWorK::timer);
281 my $pg = WeBWorK::PG->new(
282 $courseEnv,
283 $effectiveUser,
284 $key,
285 $set,
286 $problem,
287 $set->psvn, # FIXME: this field should be removed
288 $formFields,
289 { # translation options
290 displayMode => $displayMode,
291 showHints => $will{showHints},
292 showSolutions => $will{showSolutions},
293 refreshMath2img => $will{showHints} || $will{showSolutions},
294 processAnswers => 1,
295 },
296 );
297
298 $WeBWorK::timer->continue("end pg processing") if defined($WeBWorK::timer);
299 ##### fix hint/solution options #####
300
301 $can{showHints} &&= $pg->{flags}->{hintExists}
302 &&= $pg->{flags}->{showHintLimit}<=$pg->{state}->{num_of_incorrect_ans};
303 $can{showSolutions} &&= $pg->{flags}->{solutionExists};
304
305 ##### store fields #####
306
307 $self->{want} = \%want;
308 $self->{must} = \%must;
309 $self->{can} = \%can;
310 $self->{will} = \%will;
311 $self->{pg} = $pg;
312}
313
314#sub if_warnings($$) {
315# my ($self, $arg) = @_;
316# return 0 unless $self->{isOpen};
317# return $self->{pg}->{warnings} ne "";
318#}
319
320sub if_errors($$) {
321 my ($self, $arg) = @_;
322 return 0 unless $self->{isOpen};
323 return $self->{pg}->{flags}->{error_flag};
324}
325
326sub head {
327 my $self = shift;
328 return "" unless $self->{isOpen};
329 return $self->{pg}->{head_text} if $self->{pg}->{head_text};
330}
331
332sub options {
333 my $self = shift;
334 return join("",
335 CGI::start_form("POST", $self->{r}->uri),
336 $self->hidden_authen_fields,
337 CGI::hr(),
338 CGI::start_div({class=>"viewOptions"}),
339 $self->viewOptions(),
340 CGI::end_div(),
341 CGI::end_form()
342 );
343}
344
345sub path {
346 my $self = shift;
347 my $args = $_[-1];
348 my $setName = $self->{set}->set_id;
349 my $problemNumber = $self->{problem}->problem_id;
350
351 my $ce = $self->{ce};
352 my $root = $ce->{webworkURLs}->{root};
353 my $courseName = $ce->{courseName};
354 return $self->pathMacro($args,
355 "Home" => "$root",
356 $courseName => "$root/$courseName",
357 $setName => "$root/$courseName/$setName",
358 "Problem $problemNumber" => "",
359 );
360}
361
362sub siblings {
363 my $self = shift;
364 my $setName = $self->{set}->set_id;
365 my $problemNumber = $self->{problem}->problem_id;
366
367 my $ce = $self->{ce};
368 my $db = $self->{db};
369 my $root = $ce->{webworkURLs}->{root};
370 my $courseName = $ce->{courseName};
371 print CGI::strong("Problems"), CGI::br();
372
373 my $effectiveUser = $self->{r}->param("effectiveUser");
374 my @problemIDs = $db->listUserProblems($effectiveUser, $setName);
375 foreach my $problem (sort { $a <=> $b } @problemIDs) {
376 print '&nbsp;&nbsp;'.CGI::a({-href=>"$root/$courseName/$setName/".$problem."/?"
377 . $self->url_authen_args . "&displayMode=" . $self->{displayMode}},
378 "Problem ".$problem), CGI::br();
379 }
380
381 return "";
382}
383
384sub nav {
385 $WeBWorK::timer->continue("begin nav subroutine") if defined($WeBWorK::timer);
386 my $self = shift;
387 my $args = $_[-1];
388 my $setName = $self->{set}->set_id;
389 my $problemNumber = $self->{problem}->problem_id;
390
391 my $ce = $self->{ce};
392 my $db = $self->{db};
393 my $root = $ce->{webworkURLs}->{root};
394 my $courseName = $ce->{courseName};
395
396 my $wwdb = $self->{wwdb};
397 my $effectiveUser = $self->{r}->param("effectiveUser");
398 my $tail = "&displayMode=".$self->{displayMode};
399
400 my @links = ("Problem List" , "$root/$courseName/$setName", "navProbList");
401
402 my @problemIDs = $db->listUserProblems($effectiveUser, $setName);
403 my ($prevID, $nextID);
404 foreach my $id (@problemIDs) {
405 $prevID = $id if $id < $problemNumber
406 and (not defined $prevID or $id > $prevID);
407 $nextID = $id if $id > $problemNumber
408 and (not defined $nextID or $id < $nextID);
409 }
410 unshift @links, "Previous Problem" , ($prevID
411 ? "$root/$courseName/$setName/".$prevID
412 : "") , "navPrev";
413 push @links, "Next Problem" , ($nextID
414 ? "$root/$courseName/$setName/".$nextID
415 : "") , "navNext";
416
417 my $result = $self->navMacro($args, $tail, @links);
418 $WeBWorK::timer->continue("end nav subroutine") if defined($WeBWorK::timer);
419 return $result;
420}
27 421
28sub title { 422sub title {
29 my ($self, $problem_set, $problem) = @_; 423 my $self = shift;
424 my $setName = $self->{set}->set_id;
425 my $problemNumber = $self->{problem}->problem_id;
426
427 return "$setName : Problem $problemNumber";
428}
429
430sub body {
431 my $self = shift;
432
433 return CGI::p(CGI::font({-color=>"red"}, "This problem is not available because the problem set that contains it is not yet open."))
434 unless $self->{isOpen};
435
436 # unpack some useful variables
437 my $r = $self->{r};
438 my $db = $self->{db};
30 my $r = $self->{r}; 439 my $ce = $self->{ce};
31 my $user = $r->param('user'); 440 my $root = $ce->{webworkURLs}->{root};
32 return "Problem $problem of problem set $problem_set for $user"; 441 my $courseName = $ce->{courseName};
33} 442 my $set = $self->{set};
34 443 my $problem = $self->{problem};
35############################################################################### 444 my $editMode = $self->{editMode};
36# 445 my $permissionLevel = $self->{permissionLevel};
37# INITIALIZATION 446 my $submitAnswers = $self->{submitAnswers};
38# 447 my $checkAnswers = $self->{checkAnswers};
39# The following code initializes an instantiation of PGtranslator5 in the 448 my $previewAnswers = $self->{previewAnswers};
40# parent process. This initialized object is then share with each of the 449 my %want = %{ $self->{want} };
41# children forked from this parent process by the daemon. 450 my %can = %{ $self->{can} };
42# 451 my %must = %{ $self->{must} };
43# As far as I can tell, the child processes don't share any variable values even 452 my %will = %{ $self->{will} };
44# though their namespaces are the same. 453 my $pg = $self->{pg};
45############################################################################### 454
46# First some dummy values to use for testing. 455
47# These should be available from the problemEnvironment(it might be ok to assume that PG and dangerousMacros 456
48# live in the courseScripts (system level macros) directory. 457 #####create Editor link #####
49 458 # print editor link if the user is an instructor AND the file is not in temporary editing mode
50#print STDERR "Begin intitalization\n"; 459 my $editorLinkMessage = '';
51my $dummy_envir = { courseScriptsDirectory => $COURSE_SCRIPTS_DIRECTORY, 460 # and ( (not defined($self->{editMode})) or $self->{editMode} eq 'savedFile') # FIXME is this needed?
52 displayMode => 'HTML_tth', 461 if ($self->{permissionLevel}>=10 ) {
53 macroDirectory => $MACRO_DIRECTORY, 462 $editorLinkMessage = CGI::a({-href=>$ce->{webworkURLs}->{root}."/$courseName/instructor/pgProblemEditor/".
54 cgiURL => 'foo_cgiURL'}; 463 $set->set_id.'/'.$problem->problem_id.'?'.$self->url_authen_args},'Edit this problem');
55 464 }
56 465 ##### translation errors? #####
57my $PG_PL = "${COURSE_SCRIPTS_DIRECTORY}PG.pl"; 466
58my $DANGEROUS_MACROS_PL = "${COURSE_SCRIPTS_DIRECTORY}dangerousMacros.pl"; 467 if ($pg->{flags}->{error_flag}) {
59my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", 468 return $self->errorOutput($pg->{errors}, $pg->{body_text}.CGI::p($editorLinkMessage));
60 "Circle", "Label", "PGrandom", "Units", "Hermite", 469 }
61 "List", "Match","Multiple", "Select", "AlgParser", 470
62 "AnswerHash", "Fraction", "VectorField", "Complex1", 471 ##### answer processing #####
63 "Complex", "MatrixReal1", "Matrix","Distributions", 472 $WeBWorK::timer->continue("begin answer processing") if defined($WeBWorK::timer);
64 "Regression" 473 # if answers were submitted:
65); 474 my $scoreRecordedMessage;
66my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr", 475 if ($submitAnswers) {
67 "ExprWithImplicitExpand", "AnswerEvaluator", 476 # get a "pure" (unmerged) UserProblem to modify
68 477 # this will be undefined if the problem has not been assigned to this user
69); 478 my $pureProblem = $db->getUserProblem($problem->user_id, $problem->set_id, $problem->problem_id); # checked
70my $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT; 479 if (defined $pureProblem) {
71 DOCUMENT(); 480 # store answers in DB for sticky answers
72 loadMacros( 481 my %answersToStore;
73 "PGbasicmacros.pl", 482 my %answerHash = %{ $pg->{answers} };
74 "PGchoicemacros.pl", 483 $answersToStore{$_} = $self->{formFields}->{$_} #$answerHash{$_}->{original_student_ans} -- this may have been modified for fields with multiple values. Don't use it!!
75 "PGanswermacros.pl", 484 foreach (keys %answerHash);
76 "PGnumericalmacros.pl", 485 # There may be some more answers to store -- one which are auxiliary entries to a primary answer. Evaluating
77 "PGgraphmacros.pl", 486 # matrices works in this way, only the first answer triggers an answer evaluator, the rest are just inputs
78 "PGauxiliaryFunctions.pl", 487 # however we need to store them. Fortunately they are still in the input form.
79 "PGmatrixmacros.pl", 488 my @extra_answer_names = @{ $pg->{flags}->{KEPT_EXTRA_ANSWERS}};
80 "PGcomplexmacros.pl",
81 "PGstatisticsmacros.pl"
82 489
490 $answersToStore{$_} = $self->{formFields}->{$_} foreach (@extra_answer_names);
491
492 # Now let's encode these answers to store them -- append the extra answers to the end of answer entry order
493 my @answer_order = (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}, @extra_answer_names);
494 my $answerString = encodeAnswers(%answersToStore,
495 @answer_order);
496
497 # store last answer to database
498 $problem->last_answer($answerString);
499 $pureProblem->last_answer($answerString);
500 $db->putUserProblem($pureProblem);
501
502 # store state in DB if it makes sense
503 if ($will{recordAnswers}) {
504 $problem->status($pg->{state}->{recorded_score});
505 $problem->attempted(1);
506 $problem->num_correct($pg->{state}->{num_of_correct_ans});
507 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
508 $pureProblem->status($pg->{state}->{recorded_score});
509 $pureProblem->attempted(1);
510 $pureProblem->num_correct($pg->{state}->{num_of_correct_ans});
511 $pureProblem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
512 if ($db->putUserProblem($pureProblem)) {
513 $scoreRecordedMessage = "Your score was recorded.";
514 } else {
515 $scoreRecordedMessage = "Your score was not recorded because there was a failure in storing the problem record to the database.";
516 }
517 # write to the transaction log, just to make sure
518 writeLog($self->{ce}, "transaction",
519 $problem->problem_id."\t".
520 $problem->set_id."\t".
521 $problem->user_id."\t".
522 $problem->source_file."\t".
523 $problem->value."\t".
524 $problem->max_attempts."\t".
525 $problem->problem_seed."\t".
526 $pureProblem->status."\t".
527 $pureProblem->attempted."\t".
528 $pureProblem->last_answer."\t".
529 $pureProblem->num_correct."\t".
530 $pureProblem->num_incorrect
531 );
532 } else {
533 if (time < $set->open_date or time > $set->due_date) {
534 $scoreRecordedMessage = "Your score was not recorded because this problem set is closed.";
535 } else {
536 $scoreRecordedMessage = "Your score was not recorded.";
537 }
538 }
539 } else {
540 $scoreRecordedMessage = "Your score was not recorded because this problem has not been built for you.";
541 }
542 }
543
544 # logging student answers
545
546 my $answer_log = $self->{ce}->{courseFiles}->{logs}->{'answer_log'};
547 if ( defined($answer_log )) {
548 if ($submitAnswers ) {
549 my $answerString = "";
550 my %answerHash = %{ $pg->{answers} };
551 $answerString = $answerString . $answerHash{$_}->{original_student_ans}."\t"
552 foreach (sort keys %answerHash);
553 $answerString = '' unless defined($answerString); # insure string is defined.
554 writeCourseLog($self->{ce}, "answer_log",
555 join("",
556 '|', $problem->user_id,
557 '|', $problem->set_id,
558 '|', $problem->problem_id,
559 '|',"\t",
560 time(),"\t",
561 $answerString,
562 ),
563 );
564
565 }
566 }
567
568 $WeBWorK::timer->continue("end answer processing") if defined($WeBWorK::timer);
569
570 ##### output #####
571
572 print CGI::start_div({class=>"problemHeader"});
573
574 # custom message for editor
575 if ($permissionLevel >= 10 and defined $editMode) {
576 if ($editMode eq "temporaryFile") {
577 print CGI::p(CGI::i("Editing temporary file: ", $problem->source_file));
578 } elsif ($editMode eq "savedFile") {
579 print CGI::p(CGI::i("Problem saved to: ", $problem->source_file));
580 }
581 }
582
583 # attempt summary
584 #FIXME -- the following is a kludge: if showPartialCorrectAnswers is negative don't show anything.
585 # until after the due date
586 # do I need to check $wills{howCorrectAnswers} to make preflight work??
587 if (($pg->{flags}->{showPartialCorrectAnswers}>= 0 and $submitAnswers) ) {
588 # print this if user submitted answers OR requested correct answers
589
590 print $self->attemptResults($pg, 1,
591 $will{showCorrectAnswers},
592 $pg->{flags}->{showPartialCorrectAnswers}, 1, 1);
593 } elsif ($checkAnswers) {
594 # print this if user previewed answers
595 print "ANSWERS ONLY CHECKED -- ",CGI::br(),"ANSWERS NOT RECORDED", CGI::br();
596 print $self->attemptResults($pg, 1, $will{showCorrectAnswers}, 1, 1, 1);
597 # show attempt answers
598 # show correct answers if asked
599 # show attempt results (correctness)
600 # show attempt previews
601 } elsif ($previewAnswers) {
602 # print this if user previewed answers
603 print "PREVIEW ONLY -- NOT RECORDED",CGI::br(),$self->attemptResults($pg, 1, 0, 0, 0, 1);
604 # show attempt answers
605 # don't show correct answers
606 # don't show attempt results (correctness)
607 # show attempt previews
608 }
609
610 print CGI::end_div();
611
612 print CGI::start_div({class=>"problem"});
613
614 # main form
615 print
616 CGI::startform("POST", $r->uri),
617 $self->hidden_authen_fields,
618 CGI::p($pg->{body_text}),
619 CGI::p($pg->{result}->{msg} ? CGI::b("Note: ") : "", CGI::i($pg->{result}->{msg})),
620 CGI::p(
621 ($can{showCorrectAnswers}
622 ? CGI::checkbox(
623 -name => "showCorrectAnswers",
624 -checked => $will{showCorrectAnswers},
625 -label => "Show correct answers",
626 ) ." "
627 : "" ),
628 ($can{showHints}
629 ? '<div style="color:red">'. CGI::checkbox(
630 -name => "showHints",
631 -checked => $will{showHints},
632 -label => "Show Hints",
633 ) . "</div> "
634 : " " ),
635 ($can{showSolutions}
636 ? CGI::checkbox(
637 -name => "showSolutions",
638 -checked => $will{showSolutions},
639 -label => "Show Solutions",
640 ) . " "
641 : " " ),CGI::br(),
642 CGI::submit(-name=>"previewAnswers",
643 -label=>"Preview Answers"),
644 ($can{recordAnswers}
645 ? CGI::submit(-name=>"submitAnswers",
646 -label=>"Submit Answers")
647 : ""),
648 ( $can{checkAnswers}
649 ? CGI::submit(-name=>"checkAnswers",
650 -label=>"Check Answers")
651 : ""),
83 ); 652 );
653 print CGI::end_div();
654
655 print CGI::start_div({class=>"scoreSummary"});
656
657 # score summary
658 my $attempts = $problem->num_correct + $problem->num_incorrect;
659 my $attemptsNoun = $attempts != 1 ? "times" : "time";
660 my $lastScore = sprintf("%.0f%%", $problem->status * 100); # Round to whole number
661 my ($attemptsLeft, $attemptsLeftNoun);
662 if ($problem->max_attempts == -1) {
663 # unlimited attempts
664 $attemptsLeft = "unlimited";
665 $attemptsLeftNoun = "attempts";
666 } else {
667 $attemptsLeft = $problem->max_attempts - $attempts;
668 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
669 }
670
671 my $setClosed = 0;
672 my $setClosedMessage;
673 if (time < $set->open_date or time > $set->due_date) {
674 $setClosed = 1;
675 $setClosedMessage = "This problem set is closed.";
676 if ($permissionLevel > 0) {
677 $setClosedMessage .= " However, since you are a privileged user, additional attempts will be recorded.";
678 } else {
679 $setClosedMessage .= " Additional attempts will not be recorded.";
84 680 }
85 TEXT("Hello world"); 681 }
682 print CGI::p(
683 $submitAnswers ? $scoreRecordedMessage . CGI::br() : "",
684 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
685 $problem->attempted
686 ? "Your recorded score is $lastScore." . CGI::br()
687 : "",
688 $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
689 );
690 print CGI::end_div();
86 691
87 ENDDOCUMENT(); 692 # save state for viewOptions
88 693 print CGI::hidden(
89END_OF_TEXT 694 -name => "showOldAnswers",
90 695 -value => $will{showOldAnswers}
91#These here documents have their drawbacks. KEEP END_OF_TEXT left justified!!!!!! 696 ),
92 697
93############################################################################### 698 CGI::hidden(
94# Now to define the body subroutine which does the hard work. 699 -name => "displayMode",
95############################################################################### 700 -value => $self->{displayMode}
96 701 );
97 702 print( CGI::hidden(
98#my $SOURCE1 = $INITIAL_MACRO_PACKAGES; 703 -name => 'editMode',
99 704 -value => $self->{editMode},
100sub body { 705 )
101 my ($self, $problem_set, $problem) = @_; 706 ) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile';
102 my $r = $self->{r}; 707 print( CGI::hidden(
103 my $courseEnvironment = $self->{courseEnvironment}; 708 -name => 'sourceFilePath',
104 my $user = $r->param('user'); 709 -value => $self->{problem}->{source_file}
105 710 )) if defined($self->{problem}->{source_file});
106 my $rh = {}; # this needs to be set to a hash containing CGI params
107
108
109 my $SOURCE1 = readFile("$problem_set/$problem.pg");
110 print STDERR "SOURCEFILE: \n$SOURCE1\n\n";
111
112 ###########################################################################
113 # The pg problem class should have a method for installing it's problemEnvironment
114 ###########################################################################
115
116 my $problemEnvir_rh = defineProblemEnvir($self);
117
118
119 ##################################################################################
120 # Prime the PGtranslator object and set it loose
121 ##################################################################################
122
123
124 ###############################################################################
125 711
126 ############################################################################### 712 # end of main form
127 #Create the PG translator. 713 print CGI::endform();
128 ###############################################################################
129 714
130 my $pt = new PGtranslator5; #pt stands for problem translator;
131 715
716 print CGI::start_div({class=>"problemFooter"});
132 717
133 # All of these hard coded directories need to be drawn from courseEnvironment. 718 # arguments for answer inspection button
134 # In addition I don't think that PGtranslator uses this stack internally yet. 719 my $prof_url = $ce->{webworkURLs}->{oldProf};
135 # Passing these directories through the problemEnvironment variable is what 720 my $webworkURL = $ce->{webworkURLs}->{root};
136 # is currently being done, but I don't think it is quite right, at least for most 721 my $cgi_url = $prof_url;
137 # of them. 722 $cgi_url=~ s|/[^/]*$||; # clip profLogin.pl
723 my $authen_args = $self->url_authen_args();
724 my $showPastAnswersURL = "$webworkURL/$courseName/instructor/show_answers/";
138 725
726 # print answer inspection button
727 if ($self->{permissionLevel} > 0) {
728 print "\n",
729 CGI::start_form(-method=>"POST",-action=>$showPastAnswersURL,-target=>"information"),"\n",
730 $self->hidden_authen_fields,"\n",
731 CGI::hidden(-name => 'course', -value=>$courseName), "\n",
732 CGI::hidden(-name => 'problemNumber', -value=>$problem->problem_id), "\n",
733 CGI::hidden(-name => 'setName', -value=>$problem->set_id), "\n",
734 CGI::hidden(-name => 'studentUser', -value=>$problem->user_id), "\n",
735 CGI::p( {-align=>"left"},
736 CGI::submit(-name => 'action', -value=>'Show Past Answers')
737 ), "\n",
738 CGI::endform();
739 }
139 740
140 $pt ->rh_directories( { courseScriptsDirectory => $COURSE_SCRIPTS_DIRECTORY, 741 #print CGI::end_div();
141 macroDirectory => $MACRO_DIRECTORY, 742 #
142 , 743 #print CGI::start_div();
143 templateDirectory => $TEMPLATE_DIRECTORY, 744
144 tempDirectory => $TEMP_DIRECTORY, 745 # arguments for feedback form
145 } 746 my $feedbackURL = "$root/$courseName/feedback/";
747
748 #print feedback form
749 print
750 CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n",
751 $self->hidden_authen_fields,"\n",
752 CGI::hidden("module", __PACKAGE__),"\n",
753 CGI::hidden("set", $set->set_id),"\n",
754 CGI::hidden("problem", $problem->problem_id),"\n",
755 CGI::hidden("displayMode", $self->{displayMode}),"\n",
756 CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n",
757 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n",
758 CGI::hidden("showHints", $will{showHints}),"\n",
759 CGI::hidden("showSolutions", $will{showSolutions}),"\n",
760 CGI::p({-align=>"left"},
761 CGI::submit(-name=>"feedbackForm", -label=>"Email instructor")
762 ),
763 CGI::endform(),"\n";
764
765 # FIXME print editor link
766 print $editorLinkMessage; #empty unless it is appropriate to have an editor link.
767
768 print CGI::end_div();
769
770 # warning output
771 #if ($pg->{warnings} ne "") {
772 # print CGI::hr(), $self->warningOutput($pg->{warnings});
773 #}
774
775 # debugging stuff
776 if (0) {
777 print
778 CGI::hr(),
779 CGI::h2("debugging information"),
780 CGI::h3("form fields"),
781 ref2string($self->{formFields}),
782 CGI::h3("user object"),
783 ref2string($self->{user}),
784 CGI::h3("set object"),
785 ref2string($set),
786 CGI::h3("problem object"),
787 ref2string($problem),
788 CGI::h3("PG object"),
789 ref2string($pg, {'WeBWorK::PG::Translator' => 1});
790 }
791
792 return "";
793}
794
795##### output utilities #####
796
797sub attemptResults($$$$$$) {
798 my $self = shift;
799 my $pg = shift;
800 my $showAttemptAnswers = shift;
801 my $showCorrectAnswers = shift;
802 my $showAttemptResults = $showAttemptAnswers && shift;
803 my $showSummary = shift;
804 my $showAttemptPreview = shift || 0;
805 my $ce = $self->{ce};
806 my $problemResult = $pg->{result}; # the overall result of the problem
807 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
808
809 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
810
811 my $basename = "equation-" . $self->{set}->psvn. "." . $self->{problem}->problem_id . "-preview";
812 my $imgGen = WeBWorK::PG::ImageGenerator->new(
813 tempDir => $ce->{webworkDirs}->{tmp},
814 latex => $ce->{externalPrograms}->{latex},
815 dvipng => $ce->{externalPrograms}->{dvipng},
816 useCache => 1,
817 cacheDir => $ce->{webworkDirs}->{equationCache},
818 cacheURL => $ce->{webworkURLs}->{equationCache},
819 cacheDB => $ce->{webworkFiles}->{equationCacheDB},
146 ); 820 );
147 821
148 ############################################################################### 822 my $header;
149 # First we load the modules from courseScripts directory. 823 #$header .= CGI::th("Part");
150 # These do the "heavy lifting" in terms of formatting, creating graphs, and 824 $header .= $showAttemptAnswers ? CGI::th("Entered") : "";
151 # performing other heavy duty algorithms. 825 $header .= $showAttemptPreview ? CGI::th("Answer Preview") : "";
152 # 826 $header .= $showCorrectAnswers ? CGI::th("Correct") : "";
153 ############################################################################### 827 $header .= $showAttemptResults ? CGI::th("Result") : "";
828 $header .= $showMessages ? CGI::th("messages") : "";
829 my @tableRows = ( $header );
830 my $numCorrect;
831 foreach my $name (@answerNames) {
832 my $answerResult = $pg->{answers}->{$name};
833 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
834 my $preview = ($showAttemptPreview
835 ? $self->previewAnswer($answerResult, $imgGen)
836 : "");
837 my $correctAnswer = $answerResult->{correct_ans};
838 my $answerScore = $answerResult->{score};
839 my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
840 #FIXME --Can we be sure that $answerScore is an integer-- could the problem give partial credit?
841 $numCorrect += $answerScore > 0;
842 my $resultString = $answerScore ? "correct" : "incorrect";
843
844 # get rid of the goofy prefix on the answer names (supposedly, the format
845 # of the answer names is changeable. this only fixes it for "AnSwEr"
846 #$name =~ s/^AnSwEr//;
847
848 my $row;
849 #$row .= CGI::td($name);
850 $row .= $showAttemptAnswers ? CGI::td(nbsp($studentAnswer)) : "";
851 $row .= $showAttemptPreview ? CGI::td(nbsp($preview)) : "";
852 $row .= $showCorrectAnswers ? CGI::td(nbsp($correctAnswer)) : "";
853 $row .= $showAttemptResults ? CGI::td(nbsp($resultString)) : "";
854 $row .= $answerMessage ? CGI::td(nbsp($answerMessage)) : "";
855 push @tableRows, $row;
856 }
154 857
155 $pt -> evaluate_modules( @MODULE_LIST); 858 # render equation images
156 $pt -> load_extra_packages( @EXTRA_PACKAGES ); 859 $imgGen->render(refresh => 1);
157 860
158 ############################################################################### 861# my $numIncorrectNoun = scalar @answerNames == 1 ? "question" : "questions";
159 # Load the environment constants. Some are used by the PGtranslator object but 862 my $scorePercent = sprintf("%.0f%%", $problemResult->{score} * 100);
160 # most of them are installed inside the Safe compartment where the problem 863# FIXME -- I left the old code in in case we have to back out.
161 # runs. 864# my $summary = "On this attempt, you answered $numCorrect out of "
162 ############################################################################### 865# . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
163 #$pt -> environment($dummy_envir); 866 my $summary = "";
164 $pt -> environment($problemEnvir_rh); 867 if (scalar @answerNames == 1) {
165 868 if ($numCorrect == scalar @answerNames) {
166 869 $summary .= "The above answer is correct.";
167 # I've forgotten what this does exactly :-) 870 } else {
168 $pt->initialize(); 871 $summary .= "The above answer is NOT correct.";
169
170 ###############################################################################
171 # PG.pl contains the basic code which defines the problem interface, input and output.
172 # dangerousMacros.pl contains subroutines which have access to the hard drive and
173 # and the directory structure. All use of external resources by the problem is supposed
174 # to go through these subroutines. The idea is to put the potentially dangerous
175 # algorithms in on place so they can be watched closely.
176 # These two files are evaluated in the Safe compartment without any restrictions.
177 # They have full use of the perl commands.
178 ###############################################################################
179 my $loadErrors = $pt -> unrestricted_load($PG_PL );
180 print STDERR "$loadErrors\n" if ($loadErrors);
181 $loadErrors = $pt -> unrestricted_load($DANGEROUS_MACROS_PL);
182 print STDERR "$loadErrors\n" if ($loadErrors);
183
184 ###############################################################################
185 # Now set the mask to restrict the operations which can be performed within
186 # a problem or a macro file.
187 ###############################################################################
188 $pt-> set_mask();
189
190 # print "\nPG.pl: $PG_PL<br>\n";
191 # print "DANGEROUS_MACROS_PL: $DANGEROUS_MACROS_PL<br>\n";
192 # print "Print dummy environment<br>\n";
193 # print pretty_print_rh($dummy_envir), "<p>\n\n";
194
195 # Read in the source code for the problem
196
197 #$INITIAL_MACRO_PACKAGES =~ tr /\r/\n/; # change everything to unix line endings.
198 $SOURCE1 =~ tr /\r/\n/;
199 #print STDERR "Source again \n $SOURCE1";
200 $pt->source_string( $SOURCE1 );
201
202 ###############################################################################
203 # Install a safety filter for screening student answers. The default is now the blank
204 # filter since the answer evaluators do a pretty good job of recompiling and screening
205 # student's answers. Still, you could prohibit back ticks, or something of the kind.
206 ###############################################################################
207
208 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter
209
210
211 print STDERR "New PGtranslator object inititialization completed.<br>\n";
212 ################################################################################
213 ## This ends the initialization of the PGtranslator object
214 ################################################################################
215
216
217 ################################################################################
218 # Run the problem (output the html text) but also store it within the object.
219 # The correct answers are also calculated and stored within the object
220 ################################################################################
221 $pt ->translate();
222
223 #print problem output
224 print "Problem goes here<p>\n";
225 print "Problem output <br>\n";
226 print "################################################################################<br><br>";
227 print ${$pt->r_text()};
228 print "<br><br>################################################################################<br>";
229 print "<p>End of problem output<br>";
230
231
232 #print source code
233 print "Source code<pre>\n";
234 print $SOURCE1;
235 print "</pre>End source code<p>";
236 ################################################################################
237 # The format for the output is described here. We'll need a local variable
238 # to handle the warnings. From within the problem the warning command
239 # has been slaved to the __WARNINGS__ routine which is defined in Global.
240 # We'll need to provide an alternate mechanism.
241 # The base64 encoding is only needed for xml transmission.
242 ################################################################################
243 print "################################################################################<br>";
244 print "Warnings output<br>";
245 my $WARNINGS = "Let this be a warning:";
246
247 print $WARNINGS;
248
249 ################################################################################
250 # Install the standard problem grader. See gage/xmlrpc/daemon.pm or processProblem8 for detailed
251 # code on how to choose which problem grader to install, depending on courseEnvironment and problem data.
252 # See also PG.pl which provides for problem by problem overrides.
253 ################################################################################
254
255 $pt->rf_problem_grader($pt->rf_std_problem_grader);
256
257 ################################################################################
258 # creates and stores a hash of answer results inside the object: $rh_answer_results
259 ################################################################################
260 $pt -> process_answers($rh->{envir}->{inputs_ref});
261
262
263 # THE UPDATE AND GRADING LOGIC COULD USE AN OVERHAUL. IT WAS SOMEWHAT CONSTRAINED
264 # BY LEGACY CONDITIONS IN THE ORIGINAL PROCESSPROBLEM8. IT'S NOT BAD
265 # BUT IT COULD PROBABLY BE MADE A LITTLE MORE STRAIGHT FORWARD.
266 ################################################################################
267 # updates the problem state stored by the translator object from the problemEnvironment data
268 ################################################################################
269
270 # $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score},
271 # num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} ,
272 # num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans}
273 # } );
274 ################################################################################
275 # grade the problem (and update the problem state again.)
276 ################################################################################
277
278 # Define an entry order -- the default is the order they are received from the browser.
279 # (Which as I understand it is NOT guaranteed to be the Left->Right Up-> Down order we're
280 # used to in the West.
281
282 my %PG_FLAGS = $pt->h_flags;
283 my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ?
284 $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
285 # Decide whether any answers were submitted.
286 my $answers_submitted = 0;
287 $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted};
288 # If there are answers, grade them
289 my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted,
290 ANSWER_ENTRY_ORDER => $ra_answer_entry_order
291 ); # grades the problem.
292
293 # Output format expected by Webwork.pm (and I believe processProblem8, but check.)
294 my $out = {
295 text => ${$pt ->r_text()}, # encode_base64( ${$pt ->r_text()} ),
296 header_text => $pt->r_header, # encode_base64( ${ $pt->r_header } ),
297 answers => $pt->rh_evaluated_answers,
298 errors => $pt-> errors(),
299 WARNINGS => $WARNINGS, #encode_base64($WARNINGS ),
300 problem_result => $rh_problem_result,
301 problem_state => $rh_problem_state,
302 PG_flag => \%PG_FLAGS
303 }; 872 }
304 ########################################################################################## 873 } else {
305 # Debugging printout of environment tables 874 if ($numCorrect == scalar @answerNames) {
306 ########################################################################################## 875 $summary .= "All of the above answers are correct.";
307 876 } else {
308 print "<P>Request item<P>\n\n"; 877 $summary .= "At least one of the above answers is NOT correct.";
309 print "<TABLE border=\"3\">"; 878 }
310 print $self->print_form_data('<tr><td>','</td><td>','</td></tr>'); 879 }
311 print "</table>\n"; 880 #FIXME there must be a better way to force refresh.
312 print "path info <br>\n"; 881 #my $refresh_warning = 'Hold down shift and click "refresh" or "reload" to update answer preview images.';
313 print $r->path_info(); 882 #return CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows)) .
314 print "<P>\n\ncourseEnvironment<P>\n\n"; 883 #CGI::div({style=>'color:red; font-size:10pt'},$refresh_warning) .
315 print pretty_print_rh($courseEnvironment); 884 #($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
316 print "<P>\n\nproblemEnvironment<P>\n\n"; 885 # ... this has been fixed by equation caching.
317 print pretty_print_rh($problemEnvir_rh); 886 return
318 887 CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows))
319 ########################################################################################## 888 . ($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
320 # End
321 ##########################################################################################
322 "";
323} 889}
324# End the"body" routine for the Problem object. 890sub nbsp {
891 my $str = shift;
892 ($str =~/\S/) ? $str : '&nbsp;' ; # returns non-breaking space for empty strings
893 # tricky cases: $str =0;
894 # $str is a complex number
895}
896sub viewOptions($) {
897 my $self = shift;
898 my $displayMode = $self->{displayMode};
899 my %must = %{ $self->{must} };
900 my %can = %{ $self->{can} };
901 my %will = %{ $self->{will} };
902
903 my $optionLine;
904 $can{showOldAnswers} and $optionLine .= join "",
905 "Show: &nbsp;".CGI::br(),
906 CGI::checkbox(
907 -name => "showOldAnswers",
908 -checked => $will{showOldAnswers},
909 -label => "Saved answers",
910 ), "&nbsp;&nbsp;".CGI::br();
325 911
326 912 $optionLine and $optionLine .= join "", CGI::br();
327sub safetyFilter { 913
328 my $answer = shift; # accepts one answer and checks it 914 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex align: left"},
329 my $submittedAnswer = $answer; 915 "View&nbsp;equations&nbsp;as:&nbsp;&nbsp;&nbsp;&nbsp;".CGI::br(),
330 $answer = '' unless defined $answer; 916 CGI::radio_group(
331 my ($errorno); 917 -name => "displayMode",
332 $answer =~ tr/\000-\037/ /; 918 -values => ['plainText', 'formattedText', 'images'],
333 #### Return if answer field is empty ######## 919 -default => $displayMode,
334 unless ($answer =~ /\S/) { 920 -linebreak=>'true',
335# $errorno = "<BR>No answer was submitted."; 921 -labels => {
336 $errorno = 0; ## don't report blank answer as error 922 plainText => "plain",
337 923 formattedText => "formatted",
338 return ($answer,$errorno); 924 images => "images",
339 } 925 }
340 ######### replace ^ with ** (for exponentiation) 926 ), CGI::br(),CGI::hr(),
341 # $answer =~ s/\^/**/g; 927 $optionLine,
342 ######### Return if forbidden characters are found 928 CGI::submit(-name=>"redisplay", -label=>"Save Options"),
343 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { 929 );
344 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c;
345 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>";
346
347 return ($answer,$errorno);
348 }
349
350 $errorno = 0;
351 return($answer, $errorno);
352} 930}
353 931
354 932sub previewAnswer($$) {
355 933 my ($self, $answerResult, $imgGen) = @_;
356 934 my $ce = $self->{ce};
357######################################################################################## 935 my $effectiveUser = $self->{effectiveUser};
358# This is the problemEnvironment structure that needs to be filled out in order to provide 936 my $set = $self->{set};
359# information to PGtranslator which in turn supports the problem environment 937 my $problem = $self->{problem};
360######################################################################################## 938 my $displayMode = $self->{displayMode};
361
362sub defineProblemEnvir {
363 my $self = shift;
364 my $r = $self->{r};
365 my $courseEnvironment = $self->{courseEnvironment};
366 my %envir=();
367# $envir{'refSubmittedAnswers'} = $refSubmittedAnswers if defined($refSubmittedAnswers);
368 $envir{'psvnNumber'} = 123456789;
369 $envir{'psvn'} = 123456789;
370 $envir{'studentName'} = 'Jane Doe';
371 $envir{'studentLogin'} = 'jd001m';
372 $envir{'studentID'} = 'xxx-xx-4321';
373 $envir{'sectionName'} = 'gage';
374 $envir{'sectionNumber'} = '111foobar';
375 $envir{'recitationName'} = 'gage_recitation';
376 $envir{'recitationNumber'} = '11_foobar recitation';
377 $envir{'setNumber'} = 'setAlgebraicGeometry';
378 $envir{'questionNumber'} = 43;
379 $envir{'probNum'} = 43;
380 $envir{'openDate'} = 3014438528;
381 $envir{'formattedOpenDate'} = '3/4/02';
382 $envir{'dueDate'} = 4014438528;
383 $envir{'formattedDueDate'} = '10/4/04';
384 $envir{'answerDate'} = 4014438528;
385 $envir{'formattedAnswerDate'} = '10/4/04';
386 $envir{'problemValue'} = 1;
387 $envir{'fileName'} = 'problem1';
388 $envir{'probFileName'} = 'problem1';
389 $envir{'languageMode'} = 'HTML_tth';
390 $envir{'displayMode'} = 'HTML_tth';
391 $envir{'outputMode'} = 'HTML_tth';
392 $envir{'courseName'} = $courseEnvironment ->{courseName};
393 $envir{'sessionKey'} = 'asdf';
394
395# initialize constants for PGanswermacros.pl
396 $envir{'numRelPercentTolDefault'} = .1;
397 $envir{'numZeroLevelDefault'} = 1E-14;
398 $envir{'numZeroLevelTolDefault'} = 1E-12;
399 $envir{'numAbsTolDefault'} = .001;
400 $envir{'numFormatDefault'} = '';
401 $envir{'functRelPercentTolDefault'} = .1;
402 $envir{'functZeroLevelDefault'} = 1E-14;
403 $envir{'functZeroLevelTolDefault'} = 1E-12;
404 $envir{'functAbsTolDefault'} = .001;
405 $envir{'functNumOfPoints'} = 3;
406 $envir{'functVarDefault'} = 'x';
407 $envir{'functLLimitDefault'} = .0000001;
408 $envir{'functULimitDefault'} = .9999999;
409 $envir{'functMaxConstantOfIntegration'} = 1E8;
410# kludge check definition of number of attempts again. The +1 is because this is used before the current answer is evaluated.
411 $envir{'numOfAttempts'} = 2; #&getProblemNumOfCorrectAns($probNum,$psvn)
412 # &getProblemNumOfIncorrectAns($probNum,$psvn)+1;
413
414#
415#
416# defining directorys and URLs
417 $envir{'templateDirectory'} = $courseEnvironment ->{courseDirs}->{templates};
418############ $envir{'classDirectory'} = $Global::classDirectory;
419# $envir{'cgiDirectory'} = $Global::cgiDirectory;
420# $envir{'cgiURL'} = getWebworkCgiURL();
421
422# $envir{'scriptDirectory'} = $Global::scriptDirectory;##omit
423 $envir{'webworkDocsURL'} = 'http://webwork.math.rochester.edu';
424 $envir{'externalTTHPath'} = '/usr/local/bin/tth';
425 939
426 940 # note: right now, we have to do things completely differently when we are
427# 941 # rendering math from INSIDE the translator and from OUTSIDE the translator.
428 $envir{'inputs_ref'} = $r->param; 942 # so we'll just deal with each case explicitly here. there's some code
429 $envir{'problemSeed'} = 3245; 943 # duplication that can be dealt with later by abstracting out tth/dvipng/etc.
430 $envir{'displaySolutionsQ'} = 1; 944
431 $envir{'displayHintsQ'} = 1; 945 my $tex = $answerResult->{preview_latex_string};
432 946
433# Directory values -- do we really need them here? 947 return "" unless defined $tex and $tex ne "";
434 $envir{courseScriptsDirectory} = $COURSE_SCRIPTS_DIRECTORY; 948
435 $envir{macroDirectory} = $MACRO_DIRECTORY; 949 if ($displayMode eq "plainText") {
436 $envir{templateDirectory} = $TEMPLATE_DIRECTORY; 950 return $tex;
437 $envir{tempDirectory} = $TEMP_DIRECTORY; 951 } elsif ($displayMode eq "formattedText") {
438 $envir{tempURL} = $TEMP_URL; 952 my $tthCommand = $ce->{externalPrograms}->{tth}
439 $envir{htmlURL} = $HTML_URL; 953 . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
440 $envir{'htmlDirectory'} = $courseEnvironment ->{courseDirectory}->{html}; 954 . "\\(".$tex."\\)\n"
441 # here is a way to pass environment variables defined in webworkCourse.ph 955 . "END_OF_INPUT\n";
442# my $k; 956
443# foreach $k (keys %Global::PG_environment ) { 957 # call tth
444# $envir{$k} = $Global::PG_environment{$k}; 958 my $result = `$tthCommand`;
445# } 959 if ($?) {
446 \%envir; 960 return "<b>[tth failed: $? $@]</b>";
447}
448
449########################################################################################
450# This recursive pretty_print function will print a hash and its sub hashes.
451########################################################################################
452sub pretty_print_rh {
453 my $r_input = shift;
454 my $out = '';
455 if ( not ref($r_input) ) {
456 $out = $r_input; # not a reference
457 } elsif (is_hash_ref($r_input)) {
458 local($^W) = 0;
459 $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
460 foreach my $key (sort keys %$r_input ) {
461 $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print_rh($r_input->{$key}) . "</td></tr>";
462 } 961 }
463 $out .="</table>"; 962 return $result;
464 } elsif (is_array_ref($r_input) ) { 963 } elsif ($displayMode eq "images") {
465 my @array = @$r_input; 964 ## how are we going to name this?
466 $out .= "( " ; 965 #my $targetPathCommon = "/m2i/"
467 while (@array) { 966 # . $effectiveUser->user_id . "."
468 $out .= pretty_print_rh(shift @array) . " , "; 967 # . $set->set_id . "."
469 } 968 # . $problem->problem_id . "."
470 $out .= " )"; 969 # . $answerResult->{ans_name} . ".png";
471 } elsif (ref($r_input) eq 'CODE') { 970 #
472 $out = "$r_input"; 971 ## figure out where to put things
972 #my $wd = makeTempDirectory($ce->{courseDirs}->{html_temp}, "webwork-dvipng");
973 #my $latex = $ce->{externalPrograms}->{latex};
974 #my $dvipng = $ce->{externalPrograms}->{dvipng};
975 #my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
976 # # should use surePathToTmpFile, but we have to
977 # # isolate it from the problem enivronment first
978 #my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
979 #
980 ## call dvipng to generate a preview
981 #dvipng($wd, $latex, $dvipng, $tex, $targetPath);
982 #rmtree($wd, 0, 0);
983 #if (-e $targetPath) {
984 # return "<img src=\"$targetURL\" alt=\"$tex\" />";
473 } else { 985 #} else {
474 $out = $r_input; 986 # return "<b>[math2img failed]</b>";
475 }
476 $out;
477}
478
479sub is_hash_ref {
480 my $in =shift;
481 my $save_SIG_die_trap = $SIG{__DIE__};
482 $SIG{__DIE__} = sub {CORE::die(@_) };
483 my $out = eval{ %{ $in } };
484 $out = ($@ eq '') ? 1 : 0;
485 $@='';
486 $SIG{__DIE__} = $save_SIG_die_trap;
487 $out;
488}
489sub is_array_ref {
490 my $in =shift;
491 my $save_SIG_die_trap = $SIG{__DIE__};
492 $SIG{__DIE__} = sub {CORE::die(@_) };
493 my $out = eval{ @{ $in } };
494 $out = ($@ eq '') ? 1 : 0;
495 $@='';
496 $SIG{__DIE__} = $save_SIG_die_trap;
497 $out;
498}
499
500######
501# Utility for slurping souce files
502#######
503
504sub readFile {
505 my $input = shift; # The set and problem: 'set0/prob1.pg'
506 my $filePath =$TEMPLATE_DIRECTORY .$input;
507 print STDERR "Reading problem from file $filePath \n";
508 print STDERR "<br>Reading problem from file $filePath <br>\n";
509 my $out;
510 print "The file is readable = ", -r $filePath, "\n";
511 if (-r $filePath) {
512 open IN, "<$filePath" or print STDERR "Hey, this file was supposed to be readable\n";
513 local($/)=undef;
514 $out = <IN>;
515 close(IN);
516 } else {
517 print "Could not read file at |$filePath|";
518 print STDERR "Could not read file at |$filePath|";
519 }
520 return($out);
521}
522
523my $foo =0;
524
525# The warning mechanism. This needs to be turned into an object of its own
526###############
527## Error message routines cribbed from CGI
528###############
529
530BEGIN { #error message routines cribbed from CGI
531
532 my $CarpLevel = 0; # How many extra package levels to skip on carp.
533 my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
534
535 sub longmess {
536 my $error = shift;
537 my $mess = "";
538 my $i = 1 + $CarpLevel;
539 my ($pack,$file,$line,$sub,$eval,$require);
540
541 while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
542 if ($error =~ m/\n$/) {
543 $mess .= $error;
544 }
545 else {
546 if (defined $eval) {
547 if ($require) {
548 $sub = "require $eval";
549 }
550 else {
551 $eval =~ s/[\\\']/\\$&/g;
552 if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
553 substr($eval,$MaxEvalLen) = '...';
554 }
555 $sub = "eval '$eval'";
556 }
557 }
558 elsif ($sub eq '(eval)') {
559 $sub = 'eval {...}';
560 }
561
562 $mess .= "\t$sub " if $error eq "called";
563 $mess .= "$error at $file line $line\n";
564 }
565
566 $error = "called";
567 } 987 #}
568 988 $imgGen->add($answerResult->{preview_latex_string});
569 $mess || $error;
570 }
571}
572###############
573### Our error messages for giving maximum feedback to the user for errors within problems.
574###############
575BEGIN {
576 sub PG_floating_point_exception_handler { # 1st argument is signal name
577 my($sig) = @_;
578 print "Content-type: text/html\n\n<H4>There was a floating point arithmetic error (exception SIG$sig )</H4>--perhaps
579 you divided by zero or took the square root of a negative number?
580 <BR>\n Use the back button to return to the previous page and recheck your entries.<BR>\n";
581 exit(0);
582 }
583
584 $SIG{'FPE'} = \&PG_floating_point_exception_handler;
585#!/usr/bin/perl -w
586 sub PG_warnings_handler {
587 my @input = @_;
588 my $msg_string = longmess(@_);
589 my @msg_array = split("\n",$msg_string);
590 my $out_string = '';
591
592 # Extra stack information is provided in this next block
593 # If the warning message does NOT end in \n then a line
594 # number is appended (see Perl manual about warn function)
595 # The presence of the line number is detected below and extra
596 # stack information is added.
597 # To suppress the line number and the extra stack information
598 # add \n to the end of a warn message (in .pl files. In .pg
599 # files add ~~n instead
600
601 if ($input[$#input]=~/line \d*\.\s*$/) {
602 $out_string .= "##More details: <BR>\n----";
603 foreach my $line (@msg_array) {
604 chomp($line);
605 next unless $line =~/\w+\:\:/;
606 $out_string .= "----" .$line . "<BR>\n";
607 }
608 } 989
609
610 $Global::WARNINGS .="* " . join("<BR>",@input) . "<BR>\n" . $out_string .
611 "<BR>\n--------------------------------------<BR>\n<BR>\n";
612 $Global::background_plain_url = $Global::background_warn_url;
613 $Global::bg_color = '#FF99CC'; #for warnings -- this change may come too late
614 }
615
616 $SIG{__WARN__}=\&PG_warnings_handler;
617
618 $SIG{__DIE__} = sub {
619 my $message = longmess(@_);
620 $message =~ s/\n/<BR>\n/;
621 my ($package, $filename, $line) = caller();
622 # use standard die for errors eminating from XML::Parser::Expat
623 # it uses a trapped eval which sometimes fails -- apparently on purpose
624 # and the error is handled by Expat itself. We don't want
625 # to interfer with that.
626
627 if ($package eq 'XML::Parser::Expat') {
628 die @_;
629 }
630 #print "$package $filename $line \n";
631 print
632 "Content-type: text/html\r\n\r\n <h4>Software error</h4> <p>\n\n$message\n<p>\n
633 Please inform the webwork meister.<p>\n
634 In addition to the error message above the following warnings were detected:
635 <HR>
636 $Global::WARNINGS;
637 <HR>
638 It's sometimes hard to tell exactly what has gone wrong since the
639 full error message may have been sent to
640 standard error instead of to standard out.
641 <p> To debug you can
642 <ul>
643 <li> guess what went wrong and try to fix it.
644 <li> call the offending script directly from the command line
645 of unix
646 <li> enable the debugging features by redefining
647 \$cgiURL in Global.pm and checking the redirection scripts in
648 system/cgi. This will force the standard error to be placed
649 in the standard out pipe as well.
650 <li> Run tail -f error_log <br>
651 from the unix command line to see error messages from the webserver.
652 The standard error output is being placed in the error_log file for the apache
653 web server. To run this command you have to be in the directory containing the
654 error_log or enter the full path name of the error_log. <p>
655 In a standard apache installation, this file is at /usr/local/apache/logs/error_log<p>
656 In a RedHat Linux installation, this file is at /var/log/httpd/error_log<p>
657 At Rochester this file is at /ww/logs/error_log.
658 </ul>
659 Good luck.<p>\n" ;
660 }; 990 }
991}
661 992
993##### logging subroutine ####
662 994
663 995
996
997##### permission queries #####
998
999# this stuff should be abstracted out into the permissions system
1000# however, the permission system only knows about things in the
1001# course environment and the username. hmmm...
1002
1003# also, i should fix these so that they have a consistent calling
1004# format -- perhaps:
1005# canPERM($courseEnv, $user, $set, $problem, $permissionLevel)
1006
1007sub canShowCorrectAnswers($$) {
1008 my ($permissionLevel, $answerDate) = @_;
1009 return $permissionLevel > 0 || time > $answerDate;
1010}
1011
1012sub canShowSolutions($$) {
1013 my ($permissionLevel, $answerDate) = @_;
1014 return canShowCorrectAnswers($permissionLevel, $answerDate);
1015}
1016
1017sub canRecordAnswers($$$$$) {
1018 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
1019 my $permHigh = $permissionLevel > 0;
1020 my $timeOK = time >= $openDate && time <= $dueDate;
1021 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
1022 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK);
1023 return $recordAnswers;
1024}
1025
1026sub canCheckAnswers($$) {
1027 my ($permissionLevel, $answerDate) = @_;
1028 my $permHigh = $permissionLevel > 0;
1029 my $timeOK = time >= $answerDate;
1030 my $recordAnswers = $permHigh || $timeOK;
1031 return $recordAnswers;
1032}
1033
1034sub mustRecordAnswers($) {
1035 my ($permissionLevel) = @_;
1036 return $permissionLevel == 0;
664} 1037}
665 1038
6661; 10391;
Legend:
Removed from v.399  
changed lines
  Added in v.1665
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9