[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator / Problem.pm Repository:
ViewVC logotype

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

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

Revision 399 Revision 704
1################################################################################
2# WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
3# $Id$
4################################################################################
5
1package WeBWorK::ContentGenerator::Problem; 6package WeBWorK::ContentGenerator::Problem;
2our @ISA = qw(WeBWorK::ContentGenerator); 7
8=head1 NAME
9
10WeBWorK::ContentGenerator::Problem - Allow a student to interact with a problem.
11
12=cut
3 13
4use strict; 14use strict;
5use warnings; 15use warnings;
6use lib '/home/malsyned/xmlrpc/daemon';
7use lib '/Users/gage/webwork-modperl/lib';
8use PGtranslator5;
9use WeBWorK::ContentGenerator; 16use base qw(WeBWorK::ContentGenerator);
10use Apache::Constants qw(:common); 17use CGI qw();
18use File::Temp qw(tempdir);
19use WeBWorK::Form;
20use WeBWorK::PG;
21use WeBWorK::PG::IO;
22use WeBWorK::Utils qw(writeLog encodeAnswers decodeAnswers ref2string);
11 23
12############################################################################### 24############################################################
13# Configuration 25#
26# user
27# effectiveUser
28# key
29#
30# displayMode
31# showOldAnswers
32# showCorrectAnswers
33# showHints
34# showSolutions
35#
36# AnSwEr# - answer blanks in problem
37#
38# redisplay - name of the "Redisplay Problem" button
39# submitAnswers - name of "Submit Answers" button
40#
14############################################################################### 41############################################################
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 42
24############################################################################### 43sub pre_header_initialize {
25# End configuration 44 my ($self, $setName, $problemNumber) = @_;
26############################################################################### 45 my $courseEnv = $self->{courseEnvironment};
46 my $r = $self->{r};
47 my $userName = $r->param('user');
48 my $effectiveUserName = $r->param('effectiveUser');
49
50 ##### database setup #####
51
52 my $cldb = WeBWorK::DB::Classlist->new($courseEnv);
53 my $wwdb = WeBWorK::DB::WW->new($courseEnv);
54 my $authdb = WeBWorK::DB::Auth->new($courseEnv);
55
56 my $user = $cldb->getUser($userName);
57 my $effectiveUser = $cldb->getUser($effectiveUserName);
58 my $set = $wwdb->getSet($effectiveUserName, $setName);
59 my $problem = $wwdb->getProblem($effectiveUserName, $setName, $problemNumber);
60 my $psvn = $wwdb->getPSVN($effectiveUserName, $setName);
61 my $permissionLevel = $authdb->getPermissions($userName);
62
63 ##### form processing #####
64
65 # set options from form fields (see comment at top of file for names)
66 my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
67 my $redisplay = $r->param("redisplay");
68 my $submitAnswers = $r->param("submitAnswers");
69 my $previewAnswers = $r->param("previewAnswers");
70
71 # coerce form fields into CGI::Vars format
72 my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
73
74 ##### permissions #####
75
76 # what does the user want to do?
77 my %want = (
78 showOldAnswers => $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers},
79 showCorrectAnswers => $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers},
80 showHints => $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints},
81 showSolutions => $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions},
82 recordAnswers => $r->param("recordAnswers") || 1,
83 );
84
85 # are certain options enforced?
86 my %must = (
87 showOldAnswers => 0,
88 showCorrectAnswers => 0,
89 showHints => 0,
90 showSolutions => 0,
91 recordAnswers => mustRecordAnswers($permissionLevel),
92 );
93
94 # does the user have permission to use certain options?
95 my %can = (
96 showOldAnswers => 1,
97 showCorrectAnswers => canShowCorrectAnswers($permissionLevel, $set->answer_date),
98 showHints => 1,
99 showSolutions => canShowSolutions($permissionLevel, $set->answer_date),
100 recordAnswers => canRecordAnswers($permissionLevel, $set->open_date, $set->due_date,
101 $problem->max_attempts, $problem->num_correct + $problem->num_incorrect + 1),
102 # num_correct+num_incorrect+1 -- as this happens before updating $problem
103 );
104
105 # final values for options
106 my %will;
107 foreach (keys %must) {
108 $will{$_} = $can{$_} && ($want{$_} || $must{$_});
109 }
110
111 ##### sticky answers #####
112
113 if (not $submitAnswers and $will{showOldAnswers}) {
114 # do this only if new answers are NOT being submitted
115 my %oldAnswers = decodeAnswers($problem->last_answer);
116 $formFields->{$_} = $oldAnswers{$_} foreach keys %oldAnswers;
117 }
118
119 ##### translation #####
120
121 my $pg = WeBWorK::PG->new(
122 $courseEnv,
123 $effectiveUser,
124 $r->param('key'),
125 $set,
126 $problem,
127 $psvn,
128 $formFields,
129 { # translation options
130 displayMode => $displayMode,
131 showHints => $will{showHints},
132 showSolutions => $will{showSolutions},
133 refreshMath2img => $will{showHints} || $will{showSolutions},
134 processAnswers => 1,
135 },
136 );
137
138 ##### fix hint/solution options #####
139
140 $can{showHints} &&= $pg->{flags}->{hintExists};
141 $can{showSolutions} &&= $pg->{flags}->{solutionExists};
142
143 ##### store fields #####
144
145 $self->{cldb} = $cldb;
146 $self->{wwdb} = $wwdb;
147 $self->{authdb} = $authdb;
148
149 $self->{userName} = $userName;
150 $self->{user} = $user;
151 $self->{effectiveUser} = $effectiveUser;
152 $self->{set} = $set;
153 $self->{problem} = $problem;
154 $self->{permissionLevel} = $permissionLevel;
155
156 $self->{displayMode} = $displayMode;
157 $self->{redisplay} = $redisplay;
158 $self->{submitAnswers} = $submitAnswers;
159 $self->{previewAnswers} = $previewAnswers;
160 $self->{formFields} = $formFields;
161
162 $self->{want} = \%want;
163 $self->{must} = \%must;
164 $self->{can} = \%can;
165 $self->{will} = \%will;
166
167 $self->{pg} = $pg;
168}
169
170sub if_warnings($$) {
171 my ($self, $arg) = @_;
172 return $self->{pg}->{warnings} ne "";
173}
174
175sub if_errors($$) {
176 my ($self, $arg) = @_;
177 return $self->{pg}->{flags}->{error_flag};
178}
179
180sub head {
181 my $self = shift;
182
183 return $self->{pg}->{head_text} if $self->{pg}->{head_text};
184}
185
186sub path {
187 my $self = shift;
188 my $args = $_[-1];
189 my $setName = $self->{set}->id;
190 my $problemNumber = $self->{problem}->id;
191
192 my $ce = $self->{courseEnvironment};
193 my $root = $ce->{webworkURLs}->{root};
194 my $courseName = $ce->{courseName};
195 return $self->pathMacro($args,
196 "Home" => "$root",
197 $courseName => "$root/$courseName",
198 $setName => "$root/$courseName/$setName",
199 "Problem $problemNumber" => "",
200 );
201}
202
203sub siblings {
204 my $self = shift;
205 my $setName = $self->{set}->id;
206 my $problemNumber = $self->{problem}->id;
207
208 my $ce = $self->{courseEnvironment};
209 my $root = $ce->{webworkURLs}->{root};
210 my $courseName = $ce->{courseName};
211
212 print CGI::strong("Problems"), CGI::br();
213
214 my $wwdb = $self->{wwdb};
215 my $effectiveUser = $self->{r}->param("effectiveUser");
216 my @problems;
217 push @problems, $wwdb->getProblem($effectiveUser, $setName, $_)
218 foreach ($wwdb->getProblems($effectiveUser, $setName));
219 foreach my $problem (sort { $a->id <=> $b->id } @problems) {
220 print CGI::a({-href=>"$root/$courseName/$setName/".$problem->id."/?"
221 . $self->url_authen_args . "&displayMode=" . $self->{displayMode}},
222 "Problem ".$problem->id), CGI::br();
223 }
224}
225
226sub nav {
227 my $self = shift;
228 my $args = $_[-1];
229 my $setName = $self->{set}->id;
230 my $problemNumber = $self->{problem}->id;
231
232 my $ce = $self->{courseEnvironment};
233 my $root = $ce->{webworkURLs}->{root};
234 my $courseName = $ce->{courseName};
235
236 my $wwdb = $self->{wwdb};
237 my $effectiveUser = $self->{r}->param("effectiveUser");
238 my $tail = "&displayMode=".$self->{displayMode};
239
240 my @links = ("Problem List" => "$root/$courseName/$setName");
241
242 my $prevProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber-1);
243 my $nextProblem = $wwdb->getProblem($effectiveUser, $setName, $problemNumber+1);
244 unshift @links, "Previous Problem" => $prevProblem
245 ? "$root/$courseName/$setName/".$prevProblem->id
246 : "";
247 push @links, "Next Problem" => $nextProblem
248 ? "$root/$courseName/$setName/".$nextProblem->id
249 : "";
250
251 return $self->navMacro($args, $tail, @links);
252}
27 253
28sub title { 254sub title {
29 my ($self, $problem_set, $problem) = @_; 255 my $self = shift;
30 my $r = $self->{r}; 256 my $setName = $self->{set}->id;
31 my $user = $r->param('user'); 257 my $problemNumber = $self->{problem}->id;
32 return "Problem $problem of problem set $problem_set for $user"; 258
259 return "$setName : Problem $problemNumber";
33} 260}
34 261
35############################################################################### 262sub body {
36# 263 my $self = shift;
37# INITIALIZATION 264
38# 265 # unpack some useful variables
39# The following code initializes an instantiation of PGtranslator5 in the 266 my $r = $self->{r};
40# parent process. This initialized object is then share with each of the 267 my $wwdb = $self->{wwdb};
41# children forked from this parent process by the daemon. 268 my $set = $self->{set};
42# 269 my $problem = $self->{problem};
43# As far as I can tell, the child processes don't share any variable values even 270 my $permissionLevel = $self->{permissionLevel};
44# though their namespaces are the same. 271 my $submitAnswers = $self->{submitAnswers};
45############################################################################### 272 my $previewAnswers = $self->{previewAnswers};
46# First some dummy values to use for testing. 273 my %will = %{ $self->{will} };
47# These should be available from the problemEnvironment(it might be ok to assume that PG and dangerousMacros 274 my $pg = $self->{pg};
48# live in the courseScripts (system level macros) directory. 275
49 276 ##### translation errors? #####
50#print STDERR "Begin intitalization\n"; 277
51my $dummy_envir = { courseScriptsDirectory => $COURSE_SCRIPTS_DIRECTORY, 278 if ($pg->{flags}->{error_flag}) {
52 displayMode => 'HTML_tth', 279 return translationError($pg->{errors}, $pg->{body_text});
53 macroDirectory => $MACRO_DIRECTORY, 280 }
54 cgiURL => 'foo_cgiURL'}; 281
55 282 ##### answer processing #####
56 283
57my $PG_PL = "${COURSE_SCRIPTS_DIRECTORY}PG.pl"; 284 # if answers were submitted:
58my $DANGEROUS_MACROS_PL = "${COURSE_SCRIPTS_DIRECTORY}dangerousMacros.pl"; 285 if ($submitAnswers) {
59my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", 286 # store answers in DB for sticky answers
60 "Circle", "Label", "PGrandom", "Units", "Hermite", 287 my %answersToStore;
61 "List", "Match","Multiple", "Select", "AlgParser", 288 my %answerHash = %{ $pg->{answers} };
62 "AnswerHash", "Fraction", "VectorField", "Complex1", 289 $answersToStore{$_} = $answerHash{$_}->{original_student_ans}
63 "Complex", "MatrixReal1", "Matrix","Distributions", 290 foreach (keys %answerHash);
64 "Regression" 291 my $answerString = encodeAnswers(%answersToStore,
65); 292 @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} });
66my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr", 293 $problem->last_answer($answerString);
67 "ExprWithImplicitExpand", "AnswerEvaluator", 294 $wwdb->setProblem($problem);
68
69);
70my $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT;
71 DOCUMENT();
72 loadMacros(
73 "PGbasicmacros.pl",
74 "PGchoicemacros.pl",
75 "PGanswermacros.pl",
76 "PGnumericalmacros.pl",
77 "PGgraphmacros.pl",
78 "PGauxiliaryFunctions.pl",
79 "PGmatrixmacros.pl",
80 "PGcomplexmacros.pl",
81 "PGstatisticsmacros.pl"
82 295
296 # store state in DB if it makes sense
297 if ($will{recordAnswers}) {
298 $problem->attempted(1);
299 $problem->status($pg->{state}->{recorded_score});
300 $problem->num_correct($pg->{state}->{num_of_correct_ans});
301 $problem->num_incorrect($pg->{state}->{num_of_incorrect_ans});
302 $wwdb->setProblem($problem);
303 # write to the transaction log, just to make sure
304 writeLog($self->{courseEnvironment}, "transaction",
305 $problem->id."\t".
306 $problem->set_id."\t".
307 $problem->login_id."\t".
308 $problem->source_file."\t".
309 $problem->value."\t".
310 $problem->max_attempts."\t".
311 $problem->problem_seed."\t".
312 $problem->status."\t".
313 $problem->attempted."\t".
314 $problem->last_answer."\t".
315 $problem->num_correct."\t".
316 $problem->num_incorrect
83 ); 317 );
318 }
319 }
320
321 ##### output #####
322
323 # attempt summary
324 if ($submitAnswers or $will{showCorrectAnswers}) {
325 # print this if user submitted answers OR requested correct answers
326 print $self->attemptResults($pg, $submitAnswers, $will{showCorrectAnswers},
327 $pg->{flags}->{showPartialCorrectAnswers}, 0);
328 } elsif ($previewAnswers) {
329 # print this if user previewed answers
330 print $self->attemptResults($pg, 1, 0, 0, 1);
331 # don't show correctness
332 # don't show correct answers
333 }
334
335 # score summary
336 my $attempts = $problem->num_correct + $problem->num_incorrect;
337 my $attemptsNoun = $attempts != 1 ? "times" : "time";
338 my $lastScore = int ($problem->status * 100) . "%";
339 my ($attemptsLeft, $attemptsLeftNoun);
340 if ($problem->max_attempts == -1) {
341 # unlimited attempts
342 $attemptsLeft = "unlimited";
343 $attemptsLeftNoun = "attempts";
344 } else {
345 $attemptsLeft = $problem->max_attempts - $attempts;
346 $attemptsLeftNoun = $attemptsLeft == 1 ? "attempt" : "attempts";
347 }
348 my $setClosedMessage;
349 if (time < $set->open_date or time > $set->due_date) {
350 $setClosedMessage = "This problem set is closed.";
351 if ($permissionLevel > 0) {
352 $setClosedMessage .= " Since you are a privileged user, additional attempts will be recorded.";
353 } else {
354 $setClosedMessage .= " Additional attempts will not be recorded.";
355 }
356 }
357 print CGI::p(
358 "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
359 $problem->attempted
360 ? "Your recorded score is $lastScore." . CGI::br()
361 : "",
362 "You have $attemptsLeft $attemptsLeftNoun remaining.", CGI::br(),
363 $setClosedMessage,
364 );
365
366 print CGI::hr();
367
368 # main form
369 print
370 CGI::startform("POST", $r->uri),
371 $self->hidden_authen_fields,
372 CGI::p(CGI::i($pg->{result}->{msg})),
373 CGI::p($pg->{body_text}),
374 CGI::p(
375 CGI::submit(-name=>"submitAnswers", -label=>"Submit Answers"),
376 CGI::submit(-name=>"previewAnswers", -label=>"Preview Answers"),
377 ),
378 $self->viewOptions(),
379 CGI::endform();
380
381 # feedback form
382 my $ce = $self->{courseEnvironment};
383 my $root = $ce->{webworkURLs}->{root};
384 my $courseName = $ce->{courseName};
385 my $feedbackURL = "$root/$courseName/feedback/";
386 print
387 CGI::startform("POST", $feedbackURL),
388 $self->hidden_authen_fields,
389 CGI::hidden("module", __PACKAGE__),
390 CGI::hidden("set", $set->id),
391 CGI::hidden("problem", $problem->id),
392 CGI::hidden("displayMode", $self->{displayMode}),
393 CGI::hidden("showOldAnswers", $will{showOldAnswers}),
394 CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),
395 CGI::hidden("showHints", $will{showHints}),
396 CGI::hidden("showSolutions", $will{showSolutions}),
397 CGI::p({-align=>"right"},
398 CGI::submit(-name=>"feedbackForm", -label=>"Send Feedback")
399 ),
400 CGI::endform();
401
402 # warning output
403 if ($pg->{warnings} ne "") {
404 print CGI::hr(), warningOutput($pg->{warnings});
405 }
406
407 # debugging stuff
408 #print
409 # CGI::hr(),
410 # CGI::h2("debugging information"),
411 # CGI::h3("form fields"),
412 # ref2string($self->{formFields}),
413 # CGI::h3("user object"),
414 # ref2string($self->{user}),
415 # CGI::h3("set object"),
416 # ref2string($set),
417 # CGI::h3("problem object"),
418 # ref2string($problem),
419 # CGI::h3("PG object"),
420 # ref2string($pg, {'WeBWorK::PG::Translator' => 1});
421
422 return "";
423}
424
425##### output utilities #####
426
427# this is used by ProblemSet.pm too, so don't fuck it up
428sub translationError($$) {
429 my ($error, $details) = @_;
430 return
431 CGI::h2("Software Error"),
432 CGI::p(<<EOF),
433WeBWorK has encountered a software error while attempting to process this problem.
434It is likely that there is an error in the problem itself.
435If you are a student, contact your professor to have the error corrected.
436If you are a professor, please consut the error output below for more informaiton.
437EOF
438 CGI::h3("Error messages"), CGI::blockquote(CGI::pre($error)),
439 CGI::h3("Error context"), CGI::blockquote(CGI::pre($details));
440}
441
442# this is used by ProblemSet.pm too, so don't fuck it up
443sub warningOutput($) {
444 my $warnings = shift;
445
446 return
447 CGI::h2("Software Warnings"),
448 CGI::p(<<EOF),
449WeBWorK has encountered warnings while attempting to process this problem.
450It is likely that this indicates an error or ambiguity in the problem itself.
451If you are a student, contact your professor to have the problem corrected.
452If you are a professor, please consut the error output below for more informaiton.
453EOF
454 CGI::h3("Warning messages"),
455 CGI::blockquote(CGI::pre($warnings)),
456 ;
457}
458
459sub attemptResults($$$$$) {
460 my $self = shift;
461 my $pg = shift;
462 my $showAttemptAnswers = shift;
463 my $showCorrectAnswers = shift;
464 my $showAttemptResults = $showAttemptAnswers && shift;
465 my $showAttemptPreview = shift || 0;
466 my $problemResult = $pg->{result}; # the overall result of the problem
467 my @answerNames = @{ $pg->{flags}->{ANSWER_ENTRY_ORDER} };
468
469 my $showMessages = $showAttemptAnswers && grep { $pg->{answers}->{$_}->{ans_message} } @answerNames;
470
471 my $header = CGI::th("part");
472 $header .= $showAttemptAnswers ? CGI::th("entered") : "";
473 $header .= $showAttemptPreview ? CGI::th("preview") : "";
474 $header .= $showCorrectAnswers ? CGI::th("correct") : "";
475 $header .= $showAttemptResults ? CGI::th("result") : "";
476 $header .= $showMessages ? CGI::th("messages") : "";
477 my @tableRows = ( $header );
478 my $numCorrect;
479 foreach my $name (@answerNames) {
480 my $answerResult = $pg->{answers}->{$name};
481 my $studentAnswer = $answerResult->{student_ans}; # original_student_ans
482 my $preview = ($showAttemptPreview
483 ? $self->previewAnswer($answerResult)
484 : "");
485 my $correctAnswer = $answerResult->{correct_ans};
486 my $answerScore = $answerResult->{score};
487 my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
84 488
85 TEXT("Hello world"); 489 $numCorrect += $answerScore > 0;
490 my $resultString = $answerScore ? "correct" : "incorrect";
86 491
87 ENDDOCUMENT(); 492 # get rid of the goofy prefix on the answer names (supposedly, the format
88 493 # of the answer names is changeable. this only fixes it for "AnSwEr"
89END_OF_TEXT 494 $name =~ s/^AnSwEr//;
495
496 my $row = CGI::td($name);
497 $row .= $showAttemptAnswers ? CGI::td($studentAnswer) : "";
498 $row .= $showAttemptPreview ? CGI::td($preview) : "";
499 $row .= $showCorrectAnswers ? CGI::td($correctAnswer) : "";
500 $row .= $showAttemptResults ? CGI::td($resultString) : "";
501 $row .= $answerMessage ? CGI::td($answerMessage) : "";
502 push @tableRows, $row;
503 }
90 504
91#These here documents have their drawbacks. KEEP END_OF_TEXT left justified!!!!!! 505 my $numCorrectNoun = $numCorrect == 1 ? "question" : "questions";
506 my $scorePercent = int ($problemResult->{score} * 100) . "\%";
507 my $summary = "On this attempt, you answered $numCorrect $numCorrectNoun out of "
508 . scalar @answerNames . " correct, for a score of $scorePercent.";
509 return CGI::table({-border=>1}, CGI::Tr(\@tableRows)) . CGI::p($summary);
510}
92 511
93############################################################################### 512sub viewOptions($) {
94# Now to define the body subroutine which does the hard work. 513 my $self = shift;
95############################################################################### 514 my $displayMode = $self->{displayMode};
96 515 my %must = %{ $self->{must} };
97 516 my %can = %{ $self->{can} };
98#my $SOURCE1 = $INITIAL_MACRO_PACKAGES; 517 my %will = %{ $self->{will} };
99
100sub body {
101 my ($self, $problem_set, $problem) = @_;
102 my $r = $self->{r};
103 my $courseEnvironment = $self->{courseEnvironment};
104 my $user = $r->param('user');
105 518
106 my $rh = {}; # this needs to be set to a hash containing CGI params 519 my $optionLine;
520 $can{showOldAnswers} and $optionLine .= join "",
521 "Show: &nbsp;",
522 CGI::checkbox(
523 -name => "showOldAnswers",
524 -checked => $will{showOldAnswers},
525 -label => "Saved answers",
526 ), "&nbsp;&nbsp;";
527 $can{showCorrectAnswers} and $optionLine .= join "",
528 CGI::checkbox(
529 -name => "showCorrectAnswers",
530 -checked => $will{showCorrectAnswers},
531 -label => "Correct answers",
532 ), "&nbsp;&nbsp;";
533 $can{showHints} and $optionLine .= join "",
534 CGI::checkbox(
535 -name => "showHints",
536 -checked => $will{showHints},
537 -label => "Hints",
538 ), "&nbsp;&nbsp;";
539 $can{showSolutions} and $optionLine .= join "",
540 CGI::checkbox(
541 -name => "showSolutions",
542 -checked => $will{showSolutions},
543 -label => "Solutions",
544 ), "&nbsp;&nbsp;";
545 $optionLine and $optionLine .= join "", CGI::br();
107 546
108 547 return CGI::div({-style=>"border: thin groove; padding: 1ex; margin: 2ex"},
109 my $SOURCE1 = readFile("$problem_set/$problem.pg"); 548 "View equations as: &nbsp;",
110 print STDERR "SOURCEFILE: \n$SOURCE1\n\n"; 549 CGI::radio_group(
111 550 -name => "displayMode",
112 ########################################################################### 551 -values => ['plainText', 'formattedText', 'images'],
113 # The pg problem class should have a method for installing it's problemEnvironment 552 -default => $displayMode,
114 ########################################################################### 553 -labels => {
115 554 plainText => "plain text",
116 my $problemEnvir_rh = defineProblemEnvir($self); 555 formattedText => "formatted text",
117 556 images => "images",
118
119 ##################################################################################
120 # Prime the PGtranslator object and set it loose
121 ##################################################################################
122
123
124 ###############################################################################
125 557 }
126 ############################################################################### 558 ), CGI::br(),
127 #Create the PG translator. 559 $optionLine,
128 ############################################################################### 560 CGI::submit(-name=>"redisplay", -label=>"Redisplay Problem"),
129
130 my $pt = new PGtranslator5; #pt stands for problem translator;
131
132
133 # All of these hard coded directories need to be drawn from courseEnvironment.
134 # In addition I don't think that PGtranslator uses this stack internally yet.
135 # Passing these directories through the problemEnvironment variable is what
136 # is currently being done, but I don't think it is quite right, at least for most
137 # of them.
138
139
140 $pt ->rh_directories( { courseScriptsDirectory => $COURSE_SCRIPTS_DIRECTORY,
141 macroDirectory => $MACRO_DIRECTORY,
142 ,
143 templateDirectory => $TEMPLATE_DIRECTORY,
144 tempDirectory => $TEMP_DIRECTORY,
145 }
146 ); 561 );
147
148 ###############################################################################
149 # First we load the modules from courseScripts directory.
150 # These do the "heavy lifting" in terms of formatting, creating graphs, and
151 # performing other heavy duty algorithms.
152 #
153 ###############################################################################
154
155 $pt -> evaluate_modules( @MODULE_LIST);
156 $pt -> load_extra_packages( @EXTRA_PACKAGES );
157
158 ###############################################################################
159 # Load the environment constants. Some are used by the PGtranslator object but
160 # most of them are installed inside the Safe compartment where the problem
161 # runs.
162 ###############################################################################
163 #$pt -> environment($dummy_envir);
164 $pt -> environment($problemEnvir_rh);
165
166
167 # I've forgotten what this does exactly :-)
168 $pt->initialize();
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 };
304 ##########################################################################################
305 # Debugging printout of environment tables
306 ##########################################################################################
307
308 print "<P>Request item<P>\n\n";
309 print "<TABLE border=\"3\">";
310 print $self->print_form_data('<tr><td>','</td><td>','</td></tr>');
311 print "</table>\n";
312 print "path info <br>\n";
313 print $r->path_info();
314 print "<P>\n\ncourseEnvironment<P>\n\n";
315 print pretty_print_rh($courseEnvironment);
316 print "<P>\n\nproblemEnvironment<P>\n\n";
317 print pretty_print_rh($problemEnvir_rh);
318
319 ##########################################################################################
320 # End
321 ##########################################################################################
322 "";
323} 562}
324# End the"body" routine for the Problem object.
325 563
326 564sub previewAnswer($$) {
327sub safetyFilter { 565 my ($self, $answerResult) = @_;
328 my $answer = shift; # accepts one answer and checks it
329 my $submittedAnswer = $answer;
330 $answer = '' unless defined $answer;
331 my ($errorno);
332 $answer =~ tr/\000-\037/ /;
333 #### Return if answer field is empty ########
334 unless ($answer =~ /\S/) {
335# $errorno = "<BR>No answer was submitted.";
336 $errorno = 0; ## don't report blank answer as error
337
338 return ($answer,$errorno);
339 }
340 ######### replace ^ with ** (for exponentiation)
341 # $answer =~ s/\^/**/g;
342 ######### Return if forbidden characters are found
343 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) {
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}
353
354
355
356
357########################################################################################
358# This is the problemEnvironment structure that needs to be filled out in order to provide
359# information to PGtranslator which in turn supports the problem environment
360########################################################################################
361
362sub defineProblemEnvir {
363 my $self = shift;
364 my $r = $self->{r};
365 my $courseEnvironment = $self->{courseEnvironment}; 566 my $ce = $self->{courseEnvironment};
366 my %envir=(); 567 my $user = $self->{user};
367# $envir{'refSubmittedAnswers'} = $refSubmittedAnswers if defined($refSubmittedAnswers); 568 my $set = $self->{set};
368 $envir{'psvnNumber'} = 123456789; 569 my $problem = $self->{problem};
369 $envir{'psvn'} = 123456789; 570 my $displayMode = $self->{displayMode};
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 571
426 572 # note: right now, we have to do things completely differently when we are
427# 573 # rendering math from INSIDE the translator and from OUTSIDE the translator.
428 $envir{'inputs_ref'} = $r->param; 574 # so we'll just deal with each case explicitly here. there's some code
429 $envir{'problemSeed'} = 3245; 575 # duplication that can be dealt with later by abstracting out tth/dvipng/etc.
430 $envir{'displaySolutionsQ'} = 1; 576
431 $envir{'displayHintsQ'} = 1; 577 my $tex = $answerResult->{preview_latex_string};
432 578
433# Directory values -- do we really need them here? 579 if ($displayMode eq "plainText") {
434 $envir{courseScriptsDirectory} = $COURSE_SCRIPTS_DIRECTORY; 580 return $tex;
435 $envir{macroDirectory} = $MACRO_DIRECTORY; 581 } elsif ($displayMode eq "formattedText") {
436 $envir{templateDirectory} = $TEMPLATE_DIRECTORY; 582 my $tthCommand = $ce->{externalPrograms}->{tth}
437 $envir{tempDirectory} = $TEMP_DIRECTORY; 583 . " -L -f5 -r 2> /dev/null <<END_OF_INPUT; echo > /dev/null\n"
438 $envir{tempURL} = $TEMP_URL; 584 . "\\($tex\\)\n"
439 $envir{htmlURL} = $HTML_URL; 585 . "END_OF_INPUT\n";
440 $envir{'htmlDirectory'} = $courseEnvironment ->{courseDirectory}->{html}; 586
441 # here is a way to pass environment variables defined in webworkCourse.ph 587
442# my $k; 588 # call tth
443# foreach $k (keys %Global::PG_environment ) { 589 my $result = `$tthCommand`;
444# $envir{$k} = $Global::PG_environment{$k}; 590 if ($?) {
445# } 591 return "<b>[tth failed: $? $@]</b>";
446 \%envir;
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 } 592 }
463 $out .="</table>"; 593 return $result;
464 } elsif (is_array_ref($r_input) ) { 594 } elsif ($displayMode eq "images") {
465 my @array = @$r_input; 595 # how are we going to name this?
466 $out .= "( " ; 596 my $targetPathCommon = "/png/"
467 while (@array) { 597 . $user->id . "."
468 $out .= pretty_print_rh(shift @array) . " , "; 598 . $set->id . "."
599 . $problem->id . "."
600 . $answerResult->{ans_name} . ".png";
601
602 # figure out where to put things
603 my $wd = tempdir("webwork-dvipng-XXXXXXXX", DIR => $ce->{courseDirs}->{html_temp});
604 my $latex = $ce->{externalPrograms}->{latex};
605 my $dvipng = $ce->{externalPrograms}->{dvipng};
606 my $targetPath = $ce->{courseDirs}->{html_temp} . $targetPathCommon;
607 # should use surePathToTmpFile, but we have to
608 # isolate it from the problem enivronment first
609 my $targetURL = $ce->{courseURLs}->{html_temp} . $targetPathCommon;
610
611 # call dvipng to generate a preview
612 dvipng($wd, $latex, $dvipng, $tex, $targetPath);
613 if (-e $targetPath) {
614 return "<img src=\"$targetURL\" alt=\"$tex\" />";
615 } else {
616 return "<b>[math2img failed]</b>";
469 } 617 }
470 $out .= " )";
471 } elsif (ref($r_input) eq 'CODE') {
472 $out = "$r_input";
473 } else {
474 $out = $r_input;
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 } 618 }
568
569 $mess || $error;
570 }
571} 619}
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 }
609 620
610 $Global::WARNINGS .="* " . join("<BR>",@input) . "<BR>\n" . $out_string . 621##### permission queries #####
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 622
616 $SIG{__WARN__}=\&PG_warnings_handler; 623# this stuff should be abstracted out into the permissions system
617 624# however, the permission system only knows about things in the
618 $SIG{__DIE__} = sub { 625# course environment and the username. hmmm...
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 };
661 626
627# also, i should fix these so that they have a consistent calling
628# format -- perhaps:
629# canPERM($courseEnv, $user, $set, $problem, $permissionLevel)
662 630
631sub canShowCorrectAnswers($$) {
632 my ($permissionLevel, $answerDate) = @_;
633 return $permissionLevel > 0 || time > $answerDate;
634}
663 635
636sub canShowSolutions($$) {
637 my ($permissionLevel, $answerDate) = @_;
638 return canShowCorrectAnswers($permissionLevel, $answerDate);
639}
640
641sub canRecordAnswers($$$$$) {
642 my ($permissionLevel, $openDate, $dueDate, $maxAttempts, $attempts) = @_;
643 my $permHigh = $permissionLevel > 0;
644 my $timeOK = time >= $openDate && time <= $dueDate;
645 my $attemptsOK = $maxAttempts == -1 || $attempts <= $maxAttempts;
646 my $recordAnswers = $permHigh || ($timeOK && $attemptsOK);
647 return $recordAnswers;
648}
649
650sub mustRecordAnswers($) {
651 my ($permissionLevel) = @_;
652 return $permissionLevel == 0;
664} 653}
665 654
6661; 6551;
Legend:
Removed from v.399  
changed lines
  Added in v.704
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9