[system] / trunk / webwork / system / cgi / cgi-scripts / processProblem8.pl Repository:
ViewVC logotype

Annotation of /trunk/webwork/system/cgi/cgi-scripts/processProblem8.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download) (as text)

1 : sam 2 #!/usr/bin/perl
2 :    
3 :     # This file is processProblem8.pl
4 :     # This is a special version of processProblem.pl
5 :     # made to be used as an editor
6 :    
7 :     # It is called from a form with inputs
8 :     # 'user',
9 :     # 'key'
10 :     # 'course'
11 :     # 'probSetKey' and
12 :     # 'probNum'
13 :     # and in addition
14 :     # 'Mode' (for either TeX mode or HTML mode or Latex2HTML mode)
15 :     # 'ShowAns' (asks for answer to be shown -- only available for instructors)
16 :     # 'answer$i' (the answers -- if any --provided to the questions)
17 :     # 'showEdit' (checks if the ShowEditor button should be shown and clicked)
18 :     # 'showSol' (checks if the solution button ishould be shown and clicked)
19 :     # as well as
20 :     # 'source' when an edited source is provided by a web based editor
21 :     # 'seed' when a new seed is provided by a web based editor
22 :     # 'readSourceFromHTMLQ'
23 :     # 'action' which can be 'Save updated version' or 'Read problem from disk' or
24 :     # 'Submit Answers' or 'Preview Answers' or 'Preview Again'
25 :     # 'probFileName'
26 :     # 'languageType'
27 :    
28 :     use strict;
29 :     use lib '/ww/webwork/development/'; # mainWeBWorKDirectory;
30 :    
31 :     use CGI qw(:standard);
32 :     use Net::SMTP;
33 :     use Global;
34 :     use Auth;
35 :     use Safe;
36 :     use MIME::Base64 qw( encode_base64 decode_base64) ;
37 :     use PGtranslator;
38 :     BEGIN {
39 :     # set to 1 to enable timing_log
40 :     # (contains debugging info about time taken by scripts to run)
41 :     $main::logTimingData = 1;
42 :    
43 :     # begin Timing code
44 :     if( $main::logTimingData == 1 ) {
45 :     use Benchmark;
46 :     $main::beginTime = new Benchmark;
47 :     }
48 :     # end Timing code
49 :    
50 :     $main::TIME_OUT_CONSTANT = 60; # one minute wait for on screen problems
51 :     $SIG{'TERM'} = sub {die '[',scalar(localtime),"] Caught a SIGTERM, Error: $! stopped at $0\n";};
52 :     $SIG{'PIPE'} = sub {$main::SIGPIPE = 1, die '[',scalar(localtime),"] Caught a SIGPIPE, Error: $! stopped at $0\n"; };
53 :     $SIG{ALRM} = sub { $main::SIG_TIME_OUT = 1; exit(0) };
54 :    
55 :     # ## ATTENTION: The handlers PG_floating_point_exception_handler and PG_warnings_handler
56 :     # ## have to be installed after CGI::Carp is called since it also
57 :     # ## modifes the die and warn labels. Finding the right warning mechanism using these two
58 :     # ## methods bears further investigation
59 :     # ## They are defined in Global.pm
60 :     $SIG{'FPE'} = \&PG_floating_point_exception_handler;
61 :     $SIG{__WARN__}=\&PG_warnings_handler;
62 :    
63 :     alarm($main::TIME_OUT_CONSTANT);
64 :    
65 :     };
66 :    
67 :    
68 :    
69 :     use vars qw ( $questionNumber $STRINGforOUTPUT $languageMode $ansCount $openDate $cgiURL
70 :     $studentName $pinNumber $submittedAnswers $setNumber $answerDate $dueDate $studentLogin
71 :     $problemValue $safeCompartment $solutionExists $psvnNumber $fileName
72 :     $probNum $sectionName $sectionNumber $recitationName $recitationNumber $sessionKey
73 :     $courseName $modules_to_evaluate $extra_packages_to_be_loaded
74 :     );
75 :    
76 :     eval {
77 :    
78 :     # This hardwires access to these modules/objects.
79 :    
80 :    
81 :     ################################################
82 :    
83 :     #switched to object-oriented interface with CGI
84 :     #DME 6/15/2000
85 :     my $cgi = new CGI;
86 :    
87 :     if( $CGI::VERSION < 2.5 ) {
88 :     die "This version of WeBWorK requires at least version 2.50 of the CGI.pm library";
89 :     }
90 :     my %inputs = $cgi -> Vars();
91 :    
92 :    
93 :     # get information from CGI inputs (see also below for additional information)
94 :     my $Course = $inputs{'course'};
95 :     my $User = $inputs{'user'};
96 :     # define these for the timingLogInfo
97 :     $main::Course = $Course;
98 :     $main::User = $User;
99 :     $main::Action = $inputs{'action'};
100 :    
101 :    
102 :     my $Session_key = $inputs{'key'};
103 :     my $randpsvn = 22222; #int rand(1111,9999);
104 :     my $psvn = $inputs{'probSetKey'}; #psvn stands for Problem Set Version Number
105 :     my $probNum = 1;
106 :     $probNum = $inputs{'probNum'} if defined($inputs{'probNum'});
107 :     my $nextProbNum = $probNum +1 if defined($probNum);
108 :     my $previousProbNum = $probNum -1 if defined($probNum);
109 :     my $mode = "HTML";
110 :     $mode = $inputs{'Mode'} if defined( $inputs{'Mode'} );
111 :     $main::display_mode = $mode; # this is only used for the timing messages.
112 :     my $showEdit = $inputs{'showEdit'};
113 :    
114 :     # verify that information has been received
115 :     unless($Course && $User && $Session_key && $psvn) {
116 :     my $error_msg = $cgi -> remote_host() . ' ' .
117 :     $cgi -> user_agent() . ' ' . $cgi -> query_string();
118 :     &wwerror("$0, missing data",
119 :     "The script did not receive the proper input data.
120 :     Course is $Course, user is $User, session key is $Session_key, psvn is $psvn",'','',$error_msg
121 :     );
122 :     }
123 :    
124 :    
125 :     # establish environment for this script
126 :     &Global::getCourseEnvironment($Course);
127 :     my $macroDirectory = getCourseMacroDirectory();
128 :     my $databaseDirectory = getCourseDatabaseDirectory();
129 :     my $htmlDirectory = getCourseHtmlDirectory();
130 :     my $htmlURL = getCourseHtmlURL();
131 :     my $scriptDirectory = getWebworkScriptDirectory();
132 :     my $templateDirectory = getCourseTemplateDirectory();
133 :     my $courseScriptsDirectory = getCourseScriptsDirectory();
134 :    
135 :    
136 :    
137 :     require "${courseScriptsDirectory}$Global::displayMacros_pl";
138 :     require "${scriptDirectory}$Global::DBglue_pl";
139 :     require "${scriptDirectory}$Global::HTMLglue_pl";
140 :     require "${scriptDirectory}$Global::FILE_pl";
141 :    
142 :     my $permissionsFile = &Global::getCoursePermissionsFile($Course);
143 :     my $permissions = &get_permissions($User,$permissionsFile);
144 :     my $keyFile = &Global::getCourseKeyFile($Course);
145 :    
146 :     ####################################################################
147 :     # load the modules to be used in PGtranslator
148 :     require "${courseScriptsDirectory}PG_module_list.pl" or
149 :     wwerror($0, "Can't read ${courseScriptsDirectory}PG_module_list.pl");
150 :     ####################################################################
151 :    
152 :     # log access
153 :     &Global::log_info('', $cgi -> query_string);
154 :    
155 :     unless ($User eq "practice666" ) {
156 :     #verify session key
157 :     &verify_key($User, $Session_key, "$keyFile", $Course, \%inputs);
158 :     }
159 :    
160 :    
161 :     ##right now $probNum cannot possibly be "", because its default is 1
162 :     ##is that how it should be?
163 :     ###Should problemBank2 be substituted by some Global variable???###
164 :     if($probNum eq "" && ($Course ne "problemBank2") )
165 :     {
166 :     &selectionError;
167 :     die "Content-type: text/html\n\n ERROR: in $Global::processProblem_CGI near &selectionError";
168 :     }
169 :    
170 :    
171 :     # get the rest of the information from the CGI script
172 :     # get language type
173 :     my $displayMode = defined($inputs{'languageType'}) ?$inputs{'languageType'}:'pg';
174 :    
175 :     # get answers
176 :    
177 :     # Decide whether answers have been submitted.
178 :     my $answers_submitted =0;
179 :     $answers_submitted = 1 if defined($inputs{answer_form_submitted}) and 1 == $inputs{answer_form_submitted};
180 :    
181 :     # Decide whether preview_mode has been selected
182 :     my $preview_mode =0;
183 :     $preview_mode = 1 if defined($inputs{'action'}) and
184 :     (( $inputs{'action'} =~ /Preview Answer/ ) or ( $inputs{'action'} =~ /Preview Again/ ));
185 :    
186 :    
187 :     my $answersRequestedQ = 0;
188 :     $answersRequestedQ= $inputs{'ShowAns'} if defined($inputs{'ShowAns'});
189 :    
190 :     my $solutionsRequestedQ= 0;
191 :     $solutionsRequestedQ= $inputs{'ShowSol'} if defined($inputs{'ShowSol'});
192 :    
193 :     my $doNotRecordAnsRequestedQ= 0;
194 :     $doNotRecordAnsRequestedQ= $inputs{'doNotRecordAns'} if defined($inputs{'doNotRecordAns'});
195 :    
196 :    
197 :     #
198 :     # # cache information about the problem set (from the webwork-database)
199 :     # and begin constructing the environment for constructing and displaying the problem
200 :     &attachProbSetRecord($psvn);
201 :    
202 :    
203 :     # Get information from database
204 :     my ($currentTime,$odts,$ddts,$adts);
205 :     $currentTime = time;
206 :     $odts = &getOpenDate($psvn);
207 :     $ddts = &getDueDate($psvn);
208 :     $adts = &getAnswerDate($psvn);
209 :    
210 :    
211 :     my ($setNumber,$numberOfProblems);
212 :     $setNumber = &getSetNumber($psvn);
213 :     $numberOfProblems = &getAllProblemsForProbSetRecord($psvn);
214 :    
215 :    
216 :     # If answers have not been submitted and previous answers have been saved, patch them in
217 :     unless ($answers_submitted) {
218 :     my $student_answers = getProblemStudentAnswer($probNum,$psvn);
219 :     if (defined $student_answers) {
220 :     my $rh_answer_hash = decode_submitted_answers($student_answers);
221 :     my %answer_hash = %$rh_answer_hash;
222 :     my ($label, $value);
223 :     foreach $label (keys %answer_hash) {$inputs{$label} = $answer_hash{$label};}
224 :     }
225 :     }
226 :    
227 :    
228 :     # Determine language from the file extension(e.g. file.pg or file.pz)
229 :     $displayMode = &getProblemFileName($probNum,$psvn);
230 :     $displayMode = $inputs{'probFileName'} if defined($inputs{'probFileName'});
231 :    
232 :     $displayMode =~ s/^.*\.([^\.]*)$/$1/;
233 :    
234 :    
235 :     # get problem name
236 :     my $probFileName = &getProblemFileName($probNum,$psvn);
237 :     $probFileName = $inputs{'probFileName'} if defined($inputs{'probFileName'});
238 :    
239 :     # determine time status.
240 :    
241 :     # check that the psvn corresponds to the user and that it is after the open
242 :     # date. This should only fail if someone is trying to break into WeBWorK.
243 :    
244 :    
245 :     if ( ( ( $User ne &getStudentLogin($psvn)) ||($currentTime < $odts) )
246 :     and ($permissions != $Global::instructor_permissions)
247 :     and ($permissions != $Global::TA_permissions)
248 :     ) {
249 :     &hackerError;
250 :     exit;
251 :     }
252 :    
253 :    
254 :    
255 :     ## check to see if it is after due + answer date, if so, put note by
256 :     ## submit answer button (below)
257 :     my $dueDateNote = "";
258 :     my $answerNote = "";
259 :    
260 :     if($currentTime>$ddts)
261 :     {$dueDateNote=" <EM>Note: it is after the due date.</EM>\n";}
262 :     if($currentTime>$adts)
263 :     {$answerNote= " <EM>Answers available.</EM>\n";}
264 :    
265 :    
266 :     # determine display defaults
267 :     my ($displayCorrectAnswersQ,$displayShowAnswerLineQ);
268 :    
269 :     $displayShowAnswerLineQ = ($permissions == $Global::instructor_permissions) || ($currentTime > $adts) ;
270 :     $displayCorrectAnswersQ = 1 if $answersRequestedQ && ($currentTime > $adts);
271 :     $displayCorrectAnswersQ = 1 if $answersRequestedQ && ($permissions == $Global::instructor_permissions);
272 :    
273 :    
274 :     $main::displaySolutionsQ = 0;
275 :     $main::displaySolutionsQ = 1 if $solutionsRequestedQ && ($currentTime > $adts);
276 :     $main::displaySolutionsQ = 1 if $solutionsRequestedQ && ($permissions == $Global::instructor_permissions);
277 :    
278 :    
279 :     #check if we need to save the updated version of the text
280 :     my $problem_has_been_saved = '';
281 :     if ( defined($inputs{'action'}) &&
282 :     ( $inputs{'action'} eq 'Save updated version' ) &&
283 :     ($permissions == $Global::instructor_permissions) &&
284 :     defined($inputs{'source'}) ) {
285 :     my $temp_source = decodeSource($inputs{'source'});
286 :     $temp_source=~ s/\r\n/\n/g;
287 :     #$temp_source = $cgi -> unescape( $temp_source );
288 :     saveProblem($temp_source, $probFileName);
289 :     $problem_has_been_saved = "<H4>Current version of the problem ${templateDirectory}$probFileName has been saved.</H4>
290 :     <b>The original version has been appended to the file ${templateDirectory}$probFileName.bak . </b><BR>";
291 :    
292 :     undef($inputs{'source'}); # make sure that we read input from the saved version
293 :     }
294 :    
295 :     #check if we need to save the updated version of the text as a new problem
296 :    
297 :     if ( defined($inputs{'action'}) &&
298 :     ( $inputs{'action'} eq 'Save as' ) &&
299 :     ($permissions == $Global::instructor_permissions) &&
300 :     defined($inputs{'source'}) ) {
301 :     my $temp_source = decodeSource( $inputs{'source'} );
302 :    
303 :     $temp_source=~ s/\r\n/\n/g;
304 :     #$temp_source = $cgi -> unescape( $temp_source );
305 :     my $new_file_name = $inputs{'new file name'};
306 :     saveNewProblem($temp_source, $new_file_name);
307 :     $problem_has_been_saved = "<H4>The file ${templateDirectory}$new_file_name has been saved.</H4>
308 :     <b>The new problem must be added to the set definition file and the set must be rebuilt before the new problem
309 :     will be displayed as part of the regular set.</b><BR>";
310 :     }
311 :    
312 :    
313 :     # get the text source of the problem
314 :    
315 :     # first determine whether to load the source (and seed) from the calling HTML form or from the disk
316 :     my $readSourceFromHTMLQ =0;
317 :     $readSourceFromHTMLQ = 1 if ( # load source from HTML if these conditions are met:
318 :     ($permissions == $Global::instructor_permissions || # only instructors can modify the source
319 :     ($User eq "practice666" )) && # practice666 can generate source
320 :     defined($inputs{'source'}) && # there is a source field in the form
321 :     defined($inputs{'seed'}) && # you need a seed field as well
322 :     defined($inputs{'readSourceFromHTMLQ'}) &&
323 :     $inputs{'readSourceFromHTMLQ'} == 1 # and the calling form asks that its source be read
324 :     );
325 :    
326 :     # Over ride button forces reading the source from the disk.
327 :     if (defined($inputs{'action'}) and $inputs{'action'} eq 'Read problem from disk') {
328 :     $readSourceFromHTMLQ = 0;
329 :     $inputs{refreshLatex2HTML} = 1; # force the Latex2HTML rendering to be redone
330 :     }
331 :    
332 :     # Determine whether to insert the source into the outgoing form.
333 :     my $insertSourceIntoFormQ = 0;
334 :     $insertSourceIntoFormQ = 1 if ( # insert the source field into forms only if these conditions are met:
335 :     ($permissions == $Global::instructor_permissions) || # only instructors can modify the source
336 :     ($User eq "practice666" ) # practice666 can also
337 :     );
338 :    
339 :     # Now lets get the source and the seed.
340 :     my $source;
341 :     my $seed;
342 :     if ( $readSourceFromHTMLQ ) {
343 :     # $source = $inputs{'source'};
344 :     $source = decodeSource($inputs{'source'});
345 :     # if ( defined($inputs{'source_encoded_using'}) ) { # the source has been encoded and we need to decode it first
346 :     # if ( $inputs{'source_encoded_using'} eq 'base64_encode' ) {
347 :     # $source = decode_base64($source);
348 :     # }
349 :     # elsif ( $inputs{'source_encoded_using'} eq 'cgi_escape' ) {
350 :     # $source = $cgi -> unescape($source);
351 :     # }
352 :     # elsif ( $inputs{'source_encoded_using'} eq 'none' ) {
353 :     # # no action needed
354 :     #
355 :     # }
356 :     # elsif ( $inputs{'source_encoded_using'} eq 'escaped_returns' ) {
357 :     # $source =~s/&#010;/\n/g; warn "uncoding escaped returns";
358 :     # $source =~s/\r\n/\n/g;
359 :     # }
360 :     # else {
361 :     # warn "Did not recognize the source encoding method $inputs{'source_encoded_using'}";
362 :     # }
363 :     # }
364 :     ##substitute carriage return with a newline
365 :     ##otherwise EndOfText construction does not work
366 :     ##browsers always have \r\n at the end of the line
367 :     $source=~ s/\r\n/\n/g;
368 :    
369 :     # get seed from the appropriate place
370 :     $seed = $inputs{'seed'};
371 :     }
372 :     elsif ($probFileName eq '') {
373 :     $probFileName = "New File";
374 :     $source = '';
375 :     $seed ="11111"; # perhaps we can pick a better initial value for the seed.
376 :     }
377 :     else {
378 :     if (-e "${templateDirectory}$probFileName" ) {
379 :     #print "|$probFileName|<BR>";
380 :     unless (-r "${templateDirectory}$probFileName") {
381 :     wwerror($0, "Can't read ${templateDirectory}$probFileName");
382 :     }
383 :     open(PROB,"<${templateDirectory}$probFileName");
384 :     $source = join('',<PROB>);
385 :     close(PROB);
386 :     }
387 :     else {
388 :     wwerror($0, "<H4>Error: The problem ${templateDirectory}$probFileName could not be found!</H4>");
389 :     }
390 :     $seed = &getProblemSeed($probNum, $psvn);
391 :     }
392 :    
393 :     ##################################################
394 :     # begin processing problem
395 :     ##################################################
396 :    
397 :    
398 :     my %envir=defineProblemEnvir($mode,$probNum,$psvn,$Course);
399 :     #print %envir; #DEBUG
400 :     ##Need to check what language is used here
401 :     #this comes from createDisplayedProblem in displayMacros
402 :     my @printlines;
403 :    
404 :     #this is no longer used DME 6/15/2000
405 :     #my $refSubmittedAnswers=$envir{'refSubmittedAnswers'};
406 :    
407 :     # require "${courseScriptsDirectory}PG_module_list.pl";
408 :     # (Modules are defined by this require statement found near the top of this file, outside the loop.)
409 :     my $pt = new PGtranslator; #pt stands for problem translator;
410 :     $pt -> evaluate_modules( @{main::modules_to_evaluate});
411 :     $pt -> load_extra_packages(@{main::extra_packages_to_be_loaded});
412 :     # The variables in the two preceding lines are defined in PG_module_list.pl at Indiana.
413 :     $pt -> environment(\%envir);
414 :     $pt -> initialize();
415 :     $pt -> set_mask();
416 :     $pt -> source_string($source);
417 :     $pt -> unrestricted_load("${courseScriptsDirectory}PG.pl");
418 :     $pt -> unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl");
419 :     $pt -> rf_safety_filter( \&safetyFilter); # install blank safety filter
420 :     $pt -> translate();
421 :    
422 :     # dereference some flags returned by createPGtext;
423 :     if ( defined( $pt ->rh_flags ) ) {
424 :     $main::showPartialCorrectAnswers = $pt ->rh_flags->{'showPartialCorrectAnswers'};
425 :     $main::recordSubmittedAnswers = $pt ->rh_flags->{'recordSubmittedAnswers'};
426 :     $main::solutionExists = $pt ->rh_flags->{'solutionExists'};
427 :     }
428 :    
429 :     # massage problem text if necessary.
430 :     if($mode eq "HTML" || $mode eq 'HTML_tth' || $pt ->rh_flags->{'error_flag'}) {
431 :     @printlines=@{ $pt->ra_text() };
432 :     }
433 :     elsif ($mode eq 'Latex2HTML') {
434 :     my %PG_flags = %{ $pt->rh_flags() };
435 :     $PG_flags{'refreshLatex2HTML'} = $inputs{'refreshLatex2HTML'};
436 :     $PG_flags{'ShowHint'} = $inputs{'ShowHint'};
437 :     @printlines = &createDisplayedProblem($setNumber,$probNum,$psvn,$pt->ra_text(),\%PG_flags );
438 :    
439 :     @printlines = &l2h_sticky_answers($envir{'inputs_ref'}, \@printlines, $pt->rh_flags() );
440 :    
441 :     # @printlines = &l2h_update_keys($envir{'sessionKey'}, \@printlines);
442 :     } elsif ($mode eq "TeX") { #TEMPORARY KLUDGE
443 :     @printlines = @{$pt->ra_text() };
444 :    
445 :     } else {
446 :     @printlines="$0: Error: Mode |$mode| is not HTML, HTML_tth or Latex2HTML.";
447 :     }
448 :    
449 :    
450 :    
451 :     # Determine the problem_state
452 :    
453 :    
454 :     # Determine the recorded score
455 :     my $recorded_score = getProblemStatus($probNum, $psvn);
456 :    
457 :    
458 :     # Initialize the variables reporting the answers
459 :     my $rh_answer_results = {};
460 :     my $rh_problem_result = {};
461 :     my $rh_problem_state = {};
462 :     my $record_problem_message = '';
463 :     my $answer_line_text = '';
464 :     my $preview_text = '';
465 :     my $expected_answer_count = keys( %{ $pt -> rh_correct_answers() } ); # count the number of correct answers
466 :    
467 :     # Determine which problem grader to use
468 :     #$pt->rf_problem_grader($pt->rf_std_problem_grader); #this is the default
469 :     my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE};
470 :    
471 :     if ( defined($problem_grader_to_use) and $problem_grader_to_use ) { # if defined and non-empty
472 :     if ($problem_grader_to_use eq 'std_problem_grader') {
473 :     # Reset problem grader to standard problem grader.
474 :     $pt->rf_problem_grader($pt->rf_std_problem_grader);
475 :     }
476 :     elsif ($problem_grader_to_use eq 'avg_problem_grader') {
477 :     # Reset problem grader to average problem grader.
478 :     $pt->rf_problem_grader($pt->rf_avg_problem_grader);
479 :     }
480 :     elsif (ref($problem_grader_to_use) eq 'CODE') {
481 :     # Set problem grader to instructor defined problem grader -- use cautiously.
482 :     $pt->rf_problem_grader($problem_grader_to_use)
483 :     }
484 :     else {
485 :     warn "Error: Could not understand problem grader flag $problem_grader_to_use";
486 :     #this is the default set by the translator and used if the flag is not understood
487 :     #$pt->rf_problem_grader($pt->rf_std_problem_grader);
488 :     }
489 :    
490 :     }
491 :     else {#this is the default set by the translator and used if no flag is set.
492 :     #$pt->rf_problem_grader($pt->rf_std_problem_grader); }
493 :     }
494 :    
495 :     # creates and stores a hash of answer results: $rh_answer_results
496 :     $pt -> process_answers(\%inputs);
497 :    
498 :     ####################################################################
499 :     # If preview mode has been selected, build the preview page and exit
500 :     ####################################################################
501 :    
502 :     if (($preview_mode ==1) and ($answers_submitted ==1)) {
503 :    
504 :     my $ra_answer_entry_order = ( defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ?
505 :     $pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
506 :    
507 :     $preview_text = preview_answers(
508 :     $pt->rh_evaluated_answers,
509 :     $rh_problem_result,
510 :     {
511 :     ANSWER_ENTRY_ORDER => $ra_answer_entry_order,
512 :     ANSWER_PREFIX => ($pt->{PG_FLAGS_REF}->{ANSWER_PREFIX}) ? $pt->{PG_FLAGS_REF}->{ANSWER_PREFIX} :'AnSwEr'
513 :    
514 :     }
515 :     );
516 :     build_preview_page();
517 :     exit(0);
518 :     }
519 :    
520 :    
521 :    
522 :     ####################################################################
523 :     # set the problem state.
524 :     # Record the grade and report the answer results
525 :     ####################################################################
526 :    
527 :    
528 :     $pt->rh_problem_state({ recorded_score => $recorded_score ,
529 :     num_of_correct_ans => &getProblemNumOfCorrectAns($probNum,$psvn) ,
530 :     num_of_incorrect_ans => &getProblemNumOfIncorrectAns($probNum,$psvn)
531 :     } );
532 :    
533 :     my $ra_answer_entry_order = ( defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ?
534 :     $pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
535 :    
536 :     ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted,
537 :     ANSWER_ENTRY_ORDER => $ra_answer_entry_order
538 :     ); # grades the problem.
539 :     # If there was a syntax error, do not report partial correct answers:
540 :     $main::showPartialCorrectAnswers = 0 if defined($rh_problem_result->{show_partial_correct_answers})
541 :     and $rh_problem_result->{show_partial_correct_answers} == 0;
542 :    
543 :     if ($answers_submitted == 1) {
544 :    
545 :     # Store the answers an an encoded form in the database
546 :    
547 :     my $saved_submitted_answers_string = encode_submitted_answers($ra_answer_entry_order);
548 :    
549 :    
550 :    
551 :     # If an answer form has been submitted format answer message,
552 :     # record problem status and format the record_problem_message
553 :     # check if before due date and number of incorrect attempts is
554 :     # below limit (if any). If so, record answer
555 :    
556 :     $record_problem_message = '';
557 :     my $attemptsRemaining = getProblemMaxNumOfIncorrectAttemps($probNum,$psvn)
558 :     - getProblemNumOfCorrectAns($probNum,$psvn)
559 :     - getProblemNumOfIncorrectAns($probNum,$psvn);
560 :    
561 :     ## Professors and TA's are allowed to submit answers without results being recorded
562 :     my $doNotRecordAnswers = 0;
563 :     if (($permissions == $Global::instructor_permissions) or ($permissions == $Global::TA_permissions)) {
564 :     $doNotRecordAnswers = 1 if $doNotRecordAnsRequestedQ;
565 :     }
566 :    
567 :     if ( (not $doNotRecordAnswers) and ($currentTime<=$ddts) and
568 :     ( ( getProblemMaxNumOfIncorrectAttemps($probNum,$psvn) < 0 ) or ( $attemptsRemaining >= 1 )) ) {
569 :     &save_problem_state($saved_submitted_answers_string,$rh_problem_state,$probNum,$inputs{'user'},$psvn);
570 :     }
571 :     else {
572 :     if ($doNotRecordAnswers){
573 :     $record_problem_message = "<STRONG>Note: Answer not recorded.</STRONG><BR>";
574 :     }
575 :     elsif ($currentTime>$ddts){
576 :     $record_problem_message = "<STRONG>Note: Answer not recorded - it is after the due date.</STRONG><BR>";
577 :     }
578 :     else {
579 :     $record_problem_message = "<STRONG>Note: Answer not recorded - You have already attempted this problem the maximum allowed number of times.</STRONG><BR>";
580 :     }
581 :     }
582 :     ####################################################################
583 :     # Format the answer section of the displayed problem
584 :     ####################################################################
585 :     my $ra_answer_entry_order = ( defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ?
586 :     $pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
587 :    
588 :     $answer_line_text = display_answers(
589 :     $pt->rh_evaluated_answers,
590 :     $rh_problem_result,
591 :     { displayCorrectAnswersQ => $displayCorrectAnswersQ,
592 :     showPartialCorrectAnswers => $main::showPartialCorrectAnswers,
593 :     ANSWER_ENTRY_ORDER => $ra_answer_entry_order,
594 :     ANSWER_PREFIX => ($pt->{PG_FLAGS_REF}->{ANSWER_PREFIX}) ? $pt->{PG_FLAGS_REF}->{ANSWER_PREFIX} :'AnSwEr'
595 :     }
596 :     );
597 :    
598 :    
599 :    
600 :    
601 :    
602 :     }
603 :    
604 :    
605 :     ####################################################################
606 :     ### format problem status message ###
607 :     ####################################################################
608 :     my $status = getProblemStatus($probNum,$psvn);
609 :     my $attempted = getProblemAttempted($probNum,$psvn);
610 :    
611 :     my $problemStatusMessage = '';
612 :     if ( !$attempted) {
613 :     $problemStatusMessage = "Our records show problem $probNum of set $setNumber has not been attempted."; # default value
614 :     }
615 :     elsif ($status >= 0 and $status <=1) {
616 :     my $percentCorr = int(100*$status+.5);
617 :     my $problemValue = &getProblemValue($probNum,$psvn);
618 :     my $score = round_score($status*$problemValue);
619 :     my $pts = 'points';
620 :     if ($score == 1) {$pts = 'point';}
621 :     $problemStatusMessage = "Our records show problem $probNum of set $setNumber has a score of ${percentCorr}\% ($score $pts).";
622 :     }
623 :     else {
624 :     $problemStatusMessage = "Our records show problem $probNum of set $setNumber has an unknown status.";
625 :     }
626 :     ########## end format problem status message #######
627 :    
628 :     ##########################################################
629 :     ###### format messages about number of attempts remaining.
630 :     ##########################################################
631 :     my $maxNumOfIncorrectAttempts = &getProblemMaxNumOfIncorrectAttemps($probNum,$psvn);
632 :     my $numOfCorrectAns = &getProblemNumOfCorrectAns($probNum,$psvn);
633 :     my $numOfIncorrectAns = &getProblemNumOfIncorrectAns($probNum,$psvn);
634 :     my $numOfAttempts = $numOfCorrectAns + $numOfIncorrectAns;
635 :     my $maxAttemptNote = "";
636 :     my $attemptsRemaining = $maxNumOfIncorrectAttempts -$numOfAttempts;
637 :    
638 :    
639 :     #
640 :    
641 :    
642 :    
643 :     #################################################
644 :     # begin printing the HTML text #
645 :     #################################################
646 :     my $Edited = '';
647 :     my $bg_color = undef;
648 :     $bg_color = $Global::bg_color if $Global::WARNINGS ;
649 :     $Edited = "EDITED " if $readSourceFromHTMLQ;
650 :     $Edited = "NEW FILE " if (defined($inputs{'action'}) and ($inputs{'action'} eq 'Save as'));
651 :     print &processProblem_htmlTOP("${Edited}Problem $probNum",
652 :     ${ $pt->r_header },
653 :     $bg_color # background color
654 :     ); #see subroutines at the bottom of this file
655 :     #this allows the use of a small gif for the webwork logo
656 :     #and takes up less screen real estate.
657 :    
658 :     #text in case the problem has been saved
659 :     print $problem_has_been_saved;
660 :    
661 :     ################print Navigation Bar ###########
662 :    
663 :     print &format_navigation_bar($previousProbNum,$nextProbNum,$numberOfProblems);
664 :    
665 :     ##############print warning about setting the Encoding properly###############
666 :     my $browser = $cgi -> user_agent();
667 :     # browser contains a string such as: |Mozilla/4.07 (Macintosh; I; PPC, Nav) |
668 :     $browser =~ m|Mozilla/([\d.]+)|;
669 :     my $version = $1;
670 :     print( qq!<FONT COLOR="#ff0000"><P> <B>WARNING:</B> Versions of Netscape before 4.0 running on a Macintosh computer
671 :     will not be able to display all the math symbols correctly in formatted text mode. Square root and integral
672 :     signs may disappear entirely. Please use
673 :     another mode.
674 :     <P>
675 :     When using Netscape 4 or greater on a Macintosh computer, set your fonts by choosing
676 :     <BR>View --&gt;Encoding--&gt;Western(MacRoman) from the menu. This will make square root signs
677 :     and integral signs display correctly.
678 :     </P></FONT>!) if ($mode eq 'HTML_tth' && $browser =~/Macintosh/ && $version < "4");
679 :    
680 :     ###############begin Answer Section###########
681 :    
682 :     if ($answers_submitted ==1) {
683 :     # print "<BR>Problem grader message is:<BR> " , $rh_problem_result->{msg} if defined($rh_problem_result->{msg});
684 :    
685 :     print $answer_line_text,
686 :     $record_problem_message;
687 :    
688 :     print( "<BR>Problem grader errors are " . $rh_problem_result->{errors} ) if $rh_problem_result->{errors};
689 :     }
690 :    
691 :     print "\r\n<!-- BEGIN_PG_PROBLEM_FORM -->\r\n";
692 :    
693 :     ################begin Problem Text ###########
694 :     print "\n",$cgi -> startform(-action=>"$Global::processProblem_CGI"),"\n\n";
695 :     print "\r\n<!-- BEGIN_PG_PROBLEM_TEXT -->\r\n";
696 :     print @printlines;
697 :     print "\r\n<!-- END_PG_PROBLEM_TEXT -->\r\n";
698 :     print "<P>";
699 :    
700 :    
701 :     ################print Submit button and display check boxes###########
702 :    
703 :     print "<EM><B>Note:</B>" . $pt->rh_problem_result->{msg} . "</EM><p>" if ($pt->rh_problem_result->{msg});
704 :     my $s = '';
705 :     if( $expected_answer_count > 1) {
706 :     $s = 's'; #makes the Answer button plural (purely cosmetic)
707 :     }
708 :    
709 :     # Decide whether the Do not save answers is visible
710 :     if (($User ne &getStudentLogin($psvn)) and
711 :     ( ($permissions == $Global::instructor_permissions) or ($permissions == $Global::TA_permissions) ) ) {
712 :    
713 :     print $cgi -> checkbox(-name=>'doNotRecordAns',
714 :     -value=>1,
715 :     -label=>"Do Not Record Answer$s",
716 :     -checked,
717 :     -override => 1), "\n\t";
718 :     } else {
719 :     print $cgi -> hidden(-name=>'doNotRecordAns',
720 :     -value => 0,override => 1), "\n\t";
721 :     }
722 :     # Decide whether the showAnswer line is visible
723 :    
724 :     if (defined($displayShowAnswerLineQ) and $displayShowAnswerLineQ) {
725 :     print $cgi -> checkbox(-name=>'ShowAns',
726 :     -value=>1,
727 :     -label=>"Show Correct Answer$s",
728 :     -override => 1), "\n\t";
729 :     } else {
730 :     print $cgi -> hidden(-name=>'ShowAns',
731 :     -value => 0,override => 1), "\n\t";
732 :     }
733 :    
734 :    
735 :    
736 :     # Decide whether the showSolution line is visible
737 :    
738 :     if (defined($displayShowAnswerLineQ) and $displayShowAnswerLineQ and defined($pt ->rh_flags->{'solutionExists'}) and $pt ->rh_flags->{'solutionExists'} ==1) {
739 :     print $cgi -> checkbox(-name=>'ShowSol',
740 :     -value=>1,
741 :     -label=>"Show Solution$s",
742 :     -override => 1);
743 :     } else {
744 :     print $cgi -> hidden(-name=>'ShowSol', -value=>0);
745 :     }
746 :    
747 :    
748 :     ## check to see if $numOfAttempts is approaching or at the limit
749 :     ## $maxNumOfIncorrectAttempts. If so, put note by
750 :     ## submit answer button (below)
751 :     ## $maxNumOfIncorrectAttempts = -1 means unlimited attempts
752 :     my $plural = '';
753 :     $plural = 's' if $attemptsRemaining > 1;
754 :    
755 :     if(($maxNumOfIncorrectAttempts >= 0) and ($attemptsRemaining <= 0) and ($currentTime<=$ddts)) {
756 :     $maxAttemptNote = " <EM>Note: You have already attempted this problem the
757 :     maximum allowed number of times.</EM>\n";
758 :     }
759 :     elsif (($maxNumOfIncorrectAttempts >= 0) and
760 :     ($attemptsRemaining <= $Global::maxAttemptsWarningLevel) and
761 :     ($currentTime<=$ddts)
762 :     ) {
763 :     $maxAttemptNote = " <EM>Note: You are allowed only $attemptsRemaining more
764 :     attempt$plural at this problem.</EM>\n";
765 :    
766 :     }
767 :    
768 :     ############# print hidden information about problem and set
769 :    
770 :     print $cgi -> hidden( -name => 'probNum', -value => $probNum ), "\n\t",
771 :     $cgi -> hidden( -name => 'probSetKey', -value => $psvn ), "\n\t",
772 :     $cgi -> hidden( -name => 'answer_form_submitted', -value => 1 ); # alerts the problem to show answers.
773 :    
774 :     #sessionKeyInputs() in scripts/HTMLglue.pl
775 :     print &sessionKeyInputs(\%inputs),
776 :     "<BR>",
777 :     $cgi -> submit( -name => 'action', -value=>"Submit Answer$s"), # -onClick=>"submitProblem()" # this javaScript call caused problems on some older browsers -- removed temporarily while we find a fix
778 :    
779 :     "\n\t",
780 :     $cgi -> submit( -name => 'action', -value=>"Preview Answer$s"),"\n\t",
781 :     qq!$maxAttemptNote $dueDateNote $answerNote!;
782 :     if ($mode ne 'TeX') { #TEMPORARY KLUDGE
783 :     my $displayMode_hidden_inputs = displaySelectModeLine_string($mode);
784 :     $displayMode_hidden_inputs =~ s/<BR>//g; # remove returns to get one line display
785 :     print "<BR>$displayMode_hidden_inputs<BR>";
786 :     }
787 :    
788 :     # $source =~ s/([^\r])\n/$1\r\n/g; # replace any bare \n by \r\n
789 :     # $source =~ s/\n/&#010;/g;
790 :     # my $sourceAsHTMLEncodingMethod = 'escaped_returns'; # this makes iCab work properly
791 :     my $sourceAsHTMLEncodingMethod = 'base64_encode';
792 :     my $sourceAsHTML = encode_base64($source);
793 :     if ($readSourceFromHTMLQ ) { # reading from source is a sticky option.
794 :     print $cgi -> hidden(-name => 'readSourceFromHTMLQ', -value => "1" );
795 :     print "<BR>\r\n",
796 :     $cgi -> hidden(-name => 'source_encoded_using', -value => $sourceAsHTMLEncodingMethod, -override => 1),
797 :     "<BR>\r\n",
798 :     $cgi -> hidden(-name => 'source', -value => $sourceAsHTML, -override => 1),
799 :     "<BR>\r\n",
800 :     $cgi -> hidden(-name => 'seed', -value => "$seed" );
801 :     }
802 :     print "\r\n<!-- BEGIN_PG_READ_FROM_DISK -->\r\n";
803 :     if ($readSourceFromHTMLQ ) {
804 :     print $cgi -> submit(-name => 'action', -value => 'Read problem from disk'); # this allows an override about reading from the HTML source
805 :    
806 :     # This ensures that we are using the current (possibly changed)
807 :     # seed even if we are resubmitting answers to a question.
808 :     }
809 :     print $cgi -> endform();
810 :     print "\r\n<!-- END_PG_PROBLEM_FORM -->\r\n";
811 :     #############################################################
812 :     ## End of main form, containing the problem and answer rules
813 :     #############################################################
814 :     ##print the form to get the editor in a different window if the
815 :     ##person using WeBWorK has professor permissions
816 :    
817 :     #############################################################
818 :     ## Show editor form
819 :     #############################################################
820 :    
821 :     if ($insertSourceIntoFormQ) {
822 :     print "\n\n<!--Source is encoded for more security and to avoid problems with the " .
823 :     "conversion from HTML to straight text-->\n";
824 :     print $cgi -> startform(-action=>"$Global::problemEditor_CGI",
825 :     -target=>'editor'),
826 :     &sessionKeyInputs(\%inputs),
827 :     $cgi -> hidden( -name =>'source_encoded_using', -value => $sourceAsHTMLEncodingMethod, -override =>1), "\r\n",
828 :     $cgi -> hidden( -name =>'source', -value => $sourceAsHTML, -override =>1), "\r\n",
829 :     $cgi -> submit( -name =>'action', -value => "Show Editor"), "\r\n",
830 :     $cgi -> hidden( -name =>'probSetKey', -value => $psvn), "\r\n",
831 :     $cgi -> hidden( -name =>'probNum', -value => $probNum), "\n",
832 :     $cgi -> hidden( -name =>'Mode', -value => $mode, -override =>1), "\r\n",
833 :     $cgi -> hidden( -name =>'seed', -value => $seed, -override =>1), "\r\n",
834 :     $cgi -> endform();
835 :    
836 :     }
837 :    
838 :     #############################################################
839 :     ## End "Show editor" form
840 :     ################################################################
841 :     print &htmlBOTTOM($0, \%inputs, 'processProblemHelp.html');
842 :    
843 :     $main::Course = $Course;
844 :     $main::User = $User;
845 :    
846 :     exit(0);
847 :    
848 :    
849 :    
850 :    
851 :     ### DONE ###
852 :     ############################################
853 :     ## SUBROUTINES specific to processProblem.pl
854 :     # this normally loads in macro files -- but for the demo this is done by hand.
855 :    
856 :     sub save_problem_state {
857 :     my ($saved_submitted_answers_string,$rh_problem_state, $num,$user, $psvn)=@_;
858 :    
859 :     # define constants
860 :     my $DELIM = $Global::delim;
861 :     my $scoreFilePrefix = $Global::scoreFilePrefix;
862 :     my $dash = $Global::dash;
863 :     my $numericalID = $Global::numericalGroupID;
864 :     $numericalID = $Global::numericalGroupID;
865 :     #
866 :    
867 :     #&attachProbSetRecord($psvn); # (not needed);
868 :     my($setNumber)=&getSetNumber($psvn);
869 :     my ($scoreFileName)="${databaseDirectory}$scoreFilePrefix$setNumber$dash${psvn}.sco";
870 :     unless (-e $scoreFileName) {
871 :     &createFile($scoreFileName, $Global::sco_files_permission, $numericalID);
872 :     }
873 :     open(TEMP_FILE,">>$scoreFileName") || print "Couldn't record answer in $scoreFileName";
874 :     my $time = &formatDateAndTime(time); # add time stamp
875 :    
876 :     print TEMP_FILE "$num $DELIM " . $rh_problem_state->{recorded_score} . " $DELIM " . $rh_problem_state->{num_of_correct_ans} . " $DELIM" . $rh_problem_state->{num_of_incorrect_ans} . " $DELIM $user $DELIM $time\n";
877 :     close(TEMP_FILE);
878 :    
879 :     putProblemStudentAnswer($saved_submitted_answers_string,$num,$psvn) if $main::recordSubmittedAnswers;
880 :    
881 :     &putProblemNumOfCorrectAns($rh_problem_state->{num_of_correct_ans},$num,$psvn) if defined($rh_problem_state->{num_of_correct_ans}) ;
882 :     &putProblemNumOfIncorrectAns($rh_problem_state->{num_of_incorrect_ans},$num,$psvn) if defined($rh_problem_state->{num_of_incorrect_ans});
883 :    
884 :     &putProblemAttempted(1,$num,$psvn); ## save_problem_state() is run only if the submit button has been
885 :     ## hit so that means the problem has been attempted
886 :    
887 :     if ( defined($rh_problem_state->{recorded_score}) ) {
888 :     &putProblemStatus( $rh_problem_state->{recorded_score} ,$num,$psvn);
889 :     } else {
890 :     warn "Error no recorded_score has been calculated for this problem.";
891 :     }
892 :    
893 :     #my %temp1 = getProbSetRecord($psvn);
894 :     #warn "number of correct attempts is pst$num ", $temp1{"pst$num"};
895 :     &detachProbSetRecord($psvn);
896 :     };
897 :    
898 :    
899 :     sub hackerError { ## prints hacker error message
900 :    
901 :    
902 :     my $msg = "Attempt to hack into WeBWorK \n Remote Host is: ". $cgi -> remote_host()."\n";
903 :     $msg .= $cgi -> query_string();
904 :     # &Global::log_error('hacker error', $cgi -> query_string);
905 :     &Global::log_error('hacker error', $msg); ## log attempt
906 :    
907 :     ## notify by email
908 :    
909 :     my $toAdd = $Global::feedbackAddress;
910 :    
911 :     my $emailMsg = "To: $toAdd
912 :     Subject: Attempt to hack into WeBWorK
913 :    
914 :     Here are the details on the attempt to hack into weBWorK:\n
915 :     $msg
916 :     \n";
917 :    
918 :     my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>20);
919 :     $smtp->mail($Global::webmaster);
920 :     $smtp->recipient($Global::feedbackAddress);
921 :     $smtp->data($msg);
922 :     $smtp->quit;
923 :    
924 :    
925 :     # my $SENDMAIL = $Global::SENDMAIL;
926 :     # open (MAIL,"|$SENDMAIL");
927 :     # print MAIL "$emailMsg";
928 :     # close (MAIL);
929 :    
930 :     print &htmlTOP("Hacker Error"),
931 :     "<H2>Error:Please do not try to hack into WeBWorK!</H2>",
932 :     $cgi -> startform(-action=>"${Global::welcomeAction_CGI}"),
933 :     "<p>",
934 :     &sessionKeyInputs(\%inputs),
935 :     $cgi -> hidden(-name=>'local_psvns', -value=>$psvn),
936 :     $cgi -> hidden(-name=>'action', -value=>'Do_problem_set'),
937 :     $cgi -> endform(),
938 :     &htmlBOTTOM($0, \%inputs);
939 :     }
940 :    
941 :     sub selectionError ## prints error message
942 :     {
943 :     print &htmlTOP("Error: need to select problem"),
944 :     "<H2>Error: You must select a problem!</H2>",
945 :     $cgi -> startform(-action=>"${Global::welcomeAction_CGI}"),
946 :     &sessionKeyInputs(\%inputs),
947 :     $cgi -> hidden(-name=>'local_psvns', -value=>$psvn),
948 :     $cgi -> hidden(-name=>'action', -value=>'Do_problem_set'),
949 :     $cgi -> submit(-value=>"Return to Problem Set"),
950 :     $cgi -> endform(),
951 :     &htmlBOTTOM($0, \%inputs);
952 :     }
953 :    
954 :    
955 :     ###################################################
956 :     sub decodeSource {
957 :     my $source = shift;
958 :     warn "Only source embedded in HTML needs to be decoded" unless defined($inputs{'source'});
959 :     if ( defined($inputs{'source_encoded_using'}) ) { # the source has been encoded and we need to decode it first
960 :     if ( $inputs{'source_encoded_using'} eq 'base64_encode' ) {
961 :     $source = decode_base64($source);
962 :     }
963 :     elsif ( $inputs{'source_encoded_using'} eq 'cgi_escape' ) {
964 :     $source = $cgi -> unescape($source);
965 :     }
966 :     elsif ( $inputs{'source_encoded_using'} eq 'none' ) {
967 :     # no action needed
968 :     }
969 :     elsif ( $inputs{'source_encoded_using'} eq 'escaped_returns' ) {
970 :     $source =~s/&#010;/\n/g; warn "uncoding escaped returns";
971 :     $source =~s/\r\n/\n/g;
972 :     }
973 :     else {
974 :     warn "Did not recognize the source encoding method $inputs{'source_encoded_using'}";
975 :     }
976 :     }
977 :     $source;
978 :     }
979 :    
980 :    
981 :     sub safetyFilter {
982 :     # my $answer = shift; # accepts one answer and checks it
983 :     # $answer = '' unless defined $answer;
984 :     # my ($errorno, $answerIsCorrectQ);
985 :     # $answer =~ tr/\000-\037/ /;
986 :     # #### Return if answer field is empty ########
987 :     # unless ($answer =~ /\S/) {
988 :     # $errorno =1; # "No answer was submitted.";
989 :     #
990 :     # return ($answer,$errorno);
991 :     # }
992 :     # ######### replace ^ with ** (for exponentiation)
993 :     # # $answer =~ s/\^/**/g;
994 :     # ######### Return if forbidden characters are found
995 :     # unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)\[\]\{\}]+$/ ) {
996 :     # $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)\[\]\{\}]/#/c;
997 :     # $errorno = 2; # "There are forbidden characters in your answer: $submittedAnswer<BR>";
998 :     #
999 :     # return ($answer,$errorno);
1000 :     # }
1001 :     #
1002 :     my $answer = shift @_;
1003 :     my $errorno = 0;
1004 :    
1005 :     return($answer, $errorno);
1006 :     }
1007 :    
1008 :    
1009 :    
1010 :     sub processProblem_htmlTOP {
1011 :     my ($title, $header_text, $bg_url) = @_;
1012 :    
1013 :     my $bg_color = $bg_url || $Global::bg_color;
1014 :    
1015 :     $header_text = '' unless defined($header_text);
1016 :     # my $out = header(-type=>'text/html');
1017 :     # $out .= start_html(-'title'=>$title,
1018 :     # -script=>$header_text,
1019 :     # -background=>$background_url);
1020 :     my $test = $cgi -> user_agent();
1021 :     # determine the proper charset
1022 :     my $charset_definition;
1023 :     my $browser = $cgi -> user_agent();
1024 :     # browser contains a string such as: |Mozilla/4.07 (Macintosh; I; PPC, Nav) |
1025 :     if ($browser =~/Macintosh/ or $browser =~/Mac_PowerPC/) { # do we need to know the mode in order to set this properly??
1026 :     $charset_definition = q{charset="x-mac-roman";};
1027 :     } else {
1028 :     $charset_definition =q{};
1029 :     }
1030 :    
1031 :     my $out = <<ENDhtmlTOP;
1032 :     content-type: text/html; $charset_definition
1033 :    
1034 :     <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">
1035 :     <HTML>
1036 :     <HEAD>
1037 :     <TITLE>$title</TITLE>
1038 :     <style>
1039 :     .parsehilight { background: yellow }
1040 :     </style>
1041 :     $header_text
1042 :     </HEAD>
1043 :     <BODY BGCOLOR="$bg_color"><p>
1044 :     ENDhtmlTOP
1045 :     $out;
1046 :     }
1047 :    
1048 :     sub preview_answers_htmlTOP {
1049 :     my ($title, $header_text, $bg_url) = @_;
1050 :    
1051 :     my $bg_color = $bg_url || $Global::bg_color;
1052 :    
1053 :     $header_text = '' unless defined($header_text);
1054 :    
1055 :     my $out = <<ENDhtmlTOP;
1056 :     content-type: text/html;
1057 :    
1058 :     <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">
1059 :     <HTML>
1060 :     <HEAD>
1061 :     <TITLE>$title</TITLE>
1062 :     <style>
1063 :     .parsehilight { background: yellow }
1064 :     </style>
1065 :     $header_text
1066 :     </HEAD>
1067 :     <BODY BGCOLOR="$bg_color"><p>
1068 :     ENDhtmlTOP
1069 :     $out;
1070 :     }
1071 :    
1072 :    
1073 :    
1074 :     sub format_navigation_bar {
1075 :     my ($previousProbNum, $nextProbNum,$numberOfProblems) = @_;
1076 :     my $navigation_bar = '';
1077 :     $navigation_bar .= qq{
1078 :     <TABLE BORDER="0" WIDTH="100%">
1079 :     <TR ALIGN=CENTER VALIGN=TOP >
1080 :     <TD ALIGN=LEFT VALIGN=MIDDLE>
1081 :     <TABLE><TR><TD ALIGN=CENTER VALIGN=MIDDLE>
1082 :     };
1083 :    
1084 :     unless($previousProbNum <= 0) {
1085 :     $navigation_bar .= $cgi->startform(-method=>'POST', -action=>"$Global::processProblem_CGI"). "\n".
1086 :     $cgi->input({-type=>'IMAGE', -src=>"$Global::previousImgUrl", -alt=>'<--Previous Problem'}). "\n".
1087 :     $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"). "\n".
1088 :     $cgi->hidden(-name=>'probNum', -value=>"$previousProbNum", -override=>1). "\n".
1089 :     $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"). "\n".
1090 :     $cgi->hidden(-name=>'user', -value=>"$inputs{user}"). "\n".
1091 :     $cgi->hidden(-name=>'key', -value=>"$inputs{key}"). "\n".
1092 :     $cgi->hidden(-name=>'course', -value=>"$inputs{course}"). "\n".
1093 :     $cgi->endform(). "\n";
1094 :    
1095 :     # $navigation_bar .= qq{
1096 :     # <A HREF="$Global::processProblem_CGI?probSetKey=$inputs{'probSetKey'}&probNum=$previousProbNum&Mode=$inputs{'Mode'}&course=$inputs{'course'}&user=$inputs{'user'}&key=$inputs{'key'}">
1097 :     # <IMG SRC="$Global::previousImgUrl" ALT="&lt;--Previous Problem"></A>
1098 :     # };
1099 :     };
1100 :    
1101 :     $navigation_bar .= qq{
1102 :     </TD> <TD ALIGN=CENTER VALIGN=MIDDLE>
1103 :     };
1104 :    
1105 :     $navigation_bar .= $cgi->startform(-method=>'POST', -action=>"$Global::welcomeAction_CGI"). "\n".
1106 :     $cgi->input({-type=>'IMAGE', -src=>"$Global::problistImgUrl", -alt=>'Problem List'}). "\n".
1107 :     $cgi->hidden(-name=>'local_psvns', -value=>"$inputs{probSetKey}"). "\n".
1108 :     $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"). "\n".
1109 :     $cgi->hidden(-name=>'action', -value=>"Do_problem_set",-override=>1). "\n".
1110 :     $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"). "\n".
1111 :     $cgi->hidden(-name=>'user', -value=>"$inputs{user}"). "\n".
1112 :     $cgi->hidden(-name=>'key', -value=>"$inputs{key}"). "\n".
1113 :     $cgi->hidden(-name=>'course', -value=>"$inputs{course}"). "\n".
1114 :     $cgi->endform(). "\n";
1115 :    
1116 :     # $navigation_bar .= qq{
1117 :     # <A HREF="$Global::welcomeAction_CGI?local_psvns=$inputs{'probSetKey'}&Mode=$inputs{'Mode'}&course=$inputs{'course'}&user=$inputs{'user'}&action=Do_problem_set&key=$inputs{'key'}">
1118 :     # <IMG SRC="$Global::problistImgUrl" ALT="Problem List"></A>
1119 :     # };
1120 :    
1121 :     $navigation_bar .= qq{ </TD>
1122 :    
1123 :     <TD ALIGN=CENTER VALIGN=MIDDLE>
1124 :     };
1125 :    
1126 :     unless($nextProbNum > $numberOfProblems) {
1127 :    
1128 :     $navigation_bar .= $cgi->startform(-method=>'POST', -action=>"$Global::processProblem_CGI"). "\n".
1129 :     $cgi->input({-type=>'IMAGE', -src=>"$Global::nextImgUrl", -alt=>'Next Problem-->'}). "\n".
1130 :     $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"). "\n".
1131 :     $cgi->hidden(-name=>'probNum', -value=>"$nextProbNum", -override=>1). "\n".
1132 :     $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"). "\n".
1133 :     $cgi->hidden(-name=>'user', -value=>"$inputs{user}"). "\n".
1134 :     $cgi->hidden(-name=>'key', -value=>"$inputs{key}"). "\n".
1135 :     $cgi->hidden(-name=>'course', -value=>"$inputs{course}"). "\n".
1136 :     $cgi->endform(). "\n";
1137 :    
1138 :     # $navigation_bar .= qq{
1139 :     # <A HREF="$Global::processProblem_CGI?probSetKey=$inputs{'probSetKey'}&probNum=$nextProbNum&Mode=$inputs{'Mode'}&course=$inputs{'course'}&user=$inputs{'user'}&key=$inputs{'key'}">
1140 :     # <IMG SRC="$Global::nextImgUrl" ALT="Next Problem--&gt;"></A>
1141 :     # };
1142 :     }
1143 :    
1144 :     $navigation_bar .= qq{ </TD>
1145 :     </TR></TABLE></TD><TD ALIGN=RIGHT VALIGN=TOP ROWSPAN=2>
1146 :    
1147 :     };
1148 :    
1149 :     $navigation_bar .= qq{
1150 :     <A HREF="$Global::webworkDocsURL">
1151 :     <IMG SRC="$Global::squareWebworkGif" BORDER=1 ALT="WeBWorK"></A>
1152 :    
1153 :     </TD></TR>
1154 :     <TR><TD ALIGN=LEFT VALIGN=BOTTOM> <H4>$problemStatusMessage</H4>
1155 :     </TD></TR>
1156 :     </TABLE>
1157 :     };
1158 :     # $navigation_bar =~ s/&/&amp;/g; # urlEncode hack.
1159 :    
1160 :     return $navigation_bar;
1161 :     }
1162 :    
1163 :    
1164 :     sub format_preview_navigation_bar {
1165 :     my $curentProbNum = shift;
1166 :     my $navigation_bar = '';
1167 :     $navigation_bar .= qq{
1168 :     <TABLE BORDER="0" WIDTH="100%">
1169 :     <TR ALIGN=CENTER VALIGN=TOP >
1170 :     <TD ALIGN=LEFT VALIGN=MIDDLE>
1171 :     <TABLE><TR><TD ALIGN=CENTER VALIGN=MIDDLE>
1172 :     };
1173 :    
1174 :    
1175 :     $navigation_bar .= $cgi->startform(-method=>'POST', -action=>"$Global::processProblem_CGI"). "\n".
1176 :     $cgi->input({-type=>'IMAGE', -src=>"$Global::currentImgUrl", -alt=>'Current Problem'}). "\n".
1177 :     $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"). "\n".
1178 :     $cgi->hidden(-name=>'probNum', -value=>"$curentProbNum", -override=>1). "\n".
1179 :     $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"). "\n".
1180 :     $cgi->hidden(-name=>'user', -value=>"$inputs{user}"). "\n".
1181 :     $cgi->hidden(-name=>'key', -value=>"$inputs{key}"). "\n".
1182 :     $cgi->hidden(-name=>'course', -value=>"$inputs{course}"). "\n".
1183 :     $cgi->endform(). "\n";
1184 :    
1185 :    
1186 :     # $navigation_bar .= qq{
1187 :     # <A HREF="$Global::processProblem_CGI?probSetKey=$inputs{'probSetKey'}&probNum=$curentProbNum&Mode=$inputs{'Mode'}&course=$inputs{'course'}&user=$inputs{'user'}&key=$inputs{'key'}">
1188 :     # <IMG SRC="$Global::currentImgUrl" ALT="Current Problem"></A>
1189 :     # };
1190 :    
1191 :     $navigation_bar .= qq{
1192 :     </TD> <TD ALIGN=CENTER VALIGN=MIDDLE>
1193 :     };
1194 :    
1195 :     $navigation_bar .= qq{
1196 :     </TD> <TD ALIGN=CENTER VALIGN=MIDDLE>
1197 :     };
1198 :    
1199 :     $navigation_bar .= $cgi->startform(-method=>'POST', -action=>"$Global::welcomeAction_CGI"). "\n".
1200 :     $cgi->input({-type=>'IMAGE', -src=>"$Global::problistImgUrl", -alt=>'Problem List'}). "\n".
1201 :     $cgi->hidden(-name=>'local_psvns', -value=>"$inputs{probSetKey}"). "\n".
1202 :     $cgi->hidden(-name=>'probSetKey', -value=>"$inputs{probSetKey}"). "\n".
1203 :     $cgi->hidden(-name=>'action', -value=>"Do_problem_set", -override=>1). "\n".
1204 :     $cgi->hidden(-name=>'Mode', -value=>"$inputs{Mode}"). "\n".
1205 :     $cgi->hidden(-name=>'user', -value=>"$inputs{user}"). "\n".
1206 :     $cgi->hidden(-name=>'key', -value=>"$inputs{key}"). "\n".
1207 :     $cgi->hidden(-name=>'course', -value=>"$inputs{key}"). "\n".
1208 :     $cgi->endform(). "\n";
1209 :    
1210 :    
1211 :    
1212 :     # $navigation_bar .= qq{
1213 :     # <A HREF="$Global::welcomeAction_CGI?local_psvns=$inputs{'probSetKey'}&Mode=$inputs{'Mode'}&course=$inputs{'course'}&user=$inputs{'user'}&action=Do_problem_set&key=$inputs{'key'}">
1214 :     # <IMG SRC="$Global::problistImgUrl" ALT="Problem List"></A>
1215 :     # };
1216 :    
1217 :     $navigation_bar .= qq{ </TD>
1218 :    
1219 :     <TD ALIGN=CENTER VALIGN=MIDDLE>
1220 :     };
1221 :    
1222 :     $navigation_bar .= qq{ </TD>
1223 :     </TR></TABLE></TD><TD ALIGN=RIGHT VALIGN=TOP WIDTH="20%" ROWSPAN=2>
1224 :    
1225 :     };
1226 :    
1227 :     $navigation_bar .= qq{
1228 :     <A HREF="$Global::webworkDocsURL">
1229 :     <IMG SRC="$Global::squareWebworkGif" BORDER=1 ALT="WeBWorK"></A>
1230 :     </TD>
1231 :     </TD></TR>
1232 :     <TR><TD ALIGN=LEFT VALIGN=BOTTOM> <h3> Preview Answers for Problem $probNum of Set $setNumber </h3>
1233 :     </TD></TR>
1234 :     </TABLE>
1235 :     };
1236 :     $navigation_bar;
1237 :     }
1238 :    
1239 :    
1240 :     ##Subroutine saveProblem takes the modified source of the problem and
1241 :     ##saves it to the file with the original problem name and appends the
1242 :     ##old version of the problem to the file problemname.pg.bak
1243 :    
1244 :     sub saveProblem {
1245 :     my ($source, $probFileName)= @_;
1246 :     my $org_source;
1247 :     #######get original source of the problem
1248 :     if (-e "${templateDirectory}$probFileName" ) {
1249 :     unless (-w "${templateDirectory}$probFileName") {
1250 :     wwerror($0, "Can't write to ${templateDirectory}$probFileName.\n" .
1251 :     "No changes were saved.\n" .
1252 :     "Check that the permissions for this problem are 660 (-rw-rw----)\n",
1253 :     "", "", $cgi -> query_string());
1254 :     }
1255 :     open(PROB,"<${templateDirectory}$probFileName");
1256 :     $org_source = join("",<PROB>);
1257 :     close(PROB);
1258 :     } else {
1259 :     wwerror($0, "<H4>Error: The problem ${templateDirectory}$probFileName could not be found!</H4>");
1260 :     }
1261 :    
1262 :     #######append old version to problemfilename.pg.bak:
1263 :     open BAKFILE, ">>${templateDirectory}${probFileName}.bak" or
1264 :     wwerror($0, "Could not open \n${templateDirectory}${probFileName}.bak for appending.\nNo changes were saved.");
1265 :     my ($sec, $min, $hour, $mday, $mon, $year)=localtime(time);
1266 :     print BAKFILE "##################################################################\n",
1267 :     "##########Date:: $mday-$mon-$year, $hour:$min:$sec################", "\n\n\n";
1268 :     print BAKFILE $org_source;
1269 :     close BAKFILE;
1270 :    
1271 :     chmod 0660, "${templateDirectory}${probFileName}.bak" ||
1272 :     print "Content-type: text/html\n\n
1273 :     CAN'T CHANGE PERMISSIONS ON FILE ${templateDirectory}${probFileName}.bak";
1274 :    
1275 :    
1276 :     #######copy new version to the file problemfilename.pg
1277 :     open (PROBLEM, ">${templateDirectory}$probFileName") ||
1278 :     wwerror($0, "Could not open ${templateDirectory}$probFileName for writing.
1279 :     Check that the permissions for this problem are 660 (-rw-rw----)");
1280 :     print PROBLEM $source;
1281 :     close PROBLEM;
1282 :     chmod 0660, "${templateDirectory}${probFileName}" ||
1283 :     print "Content-type: text/html\n\n
1284 :     CAN'T CHANGE PERMISSIONS ON FILE ${templateDirectory}${probFileName}";
1285 :    
1286 :     }
1287 :    
1288 :     ##Subroutine saveNewProblem takes the modified source of the problem and
1289 :     ##saves it to the file with the $new_file_name
1290 :    
1291 :     sub saveNewProblem {
1292 :     my ($source, $new_file_name)= @_;
1293 :    
1294 :     #######check that the new file name is legal
1295 :     unless ($new_file_name =~ /^\w/ ) {
1296 :     wwerror($0, "The file name or path\n".
1297 :     "$new_file_name\n".
1298 :     "can not begin with a non word character.\n" .
1299 :     "<b>The new version was not saved.</b>\n" .
1300 :     "Go back and choose a different name.");
1301 :     }
1302 :    
1303 :     if ($new_file_name =~ /\.\./ ) {
1304 :     wwerror($0, "The file name or path\n".
1305 :     "$new_file_name\n".
1306 :     "is illegal.\n" .
1307 :     "<b>The new version was not saved.</b>\n" .
1308 :     "Go back and choose a different name.");
1309 :     }
1310 :    
1311 :    
1312 :     #######check that the new file name doesn't exist
1313 :     if (-e "${templateDirectory}$new_file_name" ) {
1314 :     wwerror($0, "The file\n".
1315 :     "${templateDirectory}$new_file_name\n".
1316 :     "already exists.\n" .
1317 :     "<b>The new version was not saved.</b>\n" .
1318 :     "Go back and choose a different file name or\, if you really want to edit\n".
1319 :     "${templateDirectory}$new_file_name\,\n".
1320 :     "go back and hit the \&quot;Save updated version\&quot; button.");
1321 :     }
1322 :    
1323 :    
1324 :     #######copy new version to the file new_file_name
1325 :     open (PROBLEM, ">${templateDirectory}$new_file_name") ||
1326 :     wwerror($0, "Could not open ${templateDirectory}$new_file_name for writing.
1327 :     Check that the permissions for the directory ${templateDirectory} are 770 (drwxrwx---)
1328 :     Also check permissions for any subdirectories in the path.");
1329 :     print PROBLEM $source;
1330 :     close PROBLEM;
1331 :     chmod 0660, "${templateDirectory}$new_file_name" ||
1332 :     print "Content-type: text/html\n\n
1333 :     CAN'T CHANGE PERMISSIONS ON FILE ${templateDirectory}$new_file_name";
1334 :    
1335 :     }
1336 :    
1337 :    
1338 :     sub build_preview_page {
1339 :     print preview_answers_htmlTOP("Preview Answers for Problem $probNum", '',$bg_color);
1340 :     print format_preview_navigation_bar($probNum);
1341 :     print $cgi -> startform(-action=>"$Global::processProblem_CGI");
1342 :     print $preview_text;
1343 :     ############# print hidden information about problem and set
1344 :     $s = '';
1345 :     if( $expected_answer_count > 1) {$s = 's'; }
1346 :     print $cgi -> hidden(-name=>'probNum', -value=>$probNum),
1347 :     $cgi -> hidden(-name=>'probSetKey', -value=>$psvn),
1348 :     $cgi -> hidden(-name=>'answer_form_submitted', -value=>1), # alerts the problem to show answers.
1349 :     $cgi -> hidden(-name=>'Mode', -value=>$mode);
1350 :    
1351 :     print &sessionKeyInputs(\%inputs),
1352 :     '<BR>',
1353 :     $cgi -> submit( -name => 'action', -value=>"Submit Answer$s" ),' ',
1354 :     $cgi -> submit( -name => 'action', -value=>"Preview Again" ),"\n";
1355 :    
1356 :     print $cgi -> endform();
1357 :    
1358 :     print &htmlBOTTOM($0, \%inputs, 'previewAnswersHelp.html');
1359 :     }
1360 :    
1361 :     sub encode_submitted_answers { ## returns an encoded string
1362 :     my $ra_answer_entry_order = shift;
1363 :     my @answer_labels = @$ra_answer_entry_order;
1364 :     my %answer_hash =();
1365 :     my ($label,$value,$out_string);
1366 :    
1367 :     ## we will use ## to joint the hash into a string for storage
1368 :     ## so first we protect # in all keys and values
1369 :     foreach $label (@answer_labels) {
1370 :     $value = (defined $inputs{$label}) ? $inputs{$label} : '' ;
1371 :     $value = '' if length($value) > $Global::maxSizeRecordedAns;
1372 :     #warn "label is |$label| \n";
1373 :     #warn "val is |$value| \n";
1374 :     $label =~ s/#/\\#\\/g;
1375 :     $value =~ s/#/\\#\\/g;
1376 :     $answer_hash{$label} = $value;
1377 :     }
1378 :     $out_string = join '##', %answer_hash;
1379 :    
1380 :     ## When using flat databases (gdbm, db), we use '&' and '=' to
1381 :     ## separate values so we must replace all such occurences. We will
1382 :     ## replace then by %% and @@. First we escape any of these.
1383 :    
1384 :     $out_string =~ s/%/\\%\\/g;
1385 :     $out_string =~ s/@/\\@\\/g;
1386 :     $out_string =~ s/&/%%/g;
1387 :     $out_string =~ s/=/@@/g;
1388 :     #warn "outstring is |$out_string| \n";
1389 :     $out_string;
1390 :     }
1391 :    
1392 :     sub decode_submitted_answers { ## returns a ref to a hash of submitted answers
1393 :     my $in_string = shift;
1394 :    
1395 :     ## reverse encoding process. See comments in encode_submitted_answers
1396 :     $in_string =~ s/@@/=/g;
1397 :     $in_string =~ s/%%/&/g;
1398 :     $in_string =~ s/\\@\\/@/g;
1399 :     $in_string =~ s/\\%\\/%/g;
1400 :    
1401 :     $in_string =~ s/##$/## /; # This makes sure that the last element has a value.
1402 :     # It may cause trouble if this value was supposed to be nil instead of a space.
1403 :    
1404 :     my %saved_answers = split /##/,$in_string;
1405 :     my ($label,$value);
1406 :     my %answer_hash = ();
1407 :    
1408 :     foreach $label (keys (%saved_answers)) {
1409 :     $value = $saved_answers{$label};
1410 :     $label =~ s/\\#\\/#/g;
1411 :     $value =~ s/\\#\\/#/g;
1412 :     $answer_hash{$label} = $value;
1413 :     }
1414 :     \%answer_hash;
1415 :     }
1416 :    
1417 :     sub defineProblemEnvir {
1418 :     my ($mode,$probNum,$psvn,$courseName) = @_;
1419 :     my %envir=();
1420 :     ##how to put an array submittedAnswers in a hash??
1421 :     # $envir{'refSubmittedAnswers'} = $refSubmittedAnswers if defined($refSubmittedAnswers);
1422 :     $envir{'psvnNumber'} = $psvn;
1423 :     $envir{'psvn'} = $psvn;
1424 :     $envir{'studentName'} = &getStudentName($psvn);
1425 :     $envir{'studentLogin'} = &getStudentLogin($psvn);
1426 :     $envir{'sectionName'} = &getClassSection($psvn);
1427 :     $envir{'sectionNumber'} = &getClassSection($psvn);
1428 :     $envir{'recitationName'} = &getClassRecitation($psvn);
1429 :     $envir{'recitationNumber'} = &getClassRecitation($psvn);
1430 :     $envir{'setNumber'} = &getSetNumber($psvn);
1431 :     $envir{'questionNumber'} = $probNum;
1432 :     $envir{'probNum'} = $probNum;
1433 :     $envir{'openDate'} = &getOpenDate($psvn);
1434 :     $envir{'formattedOpenDate'} = &formatDateAndTime(&getOpenDate($psvn));
1435 :     $envir{'dueDate'} = &getDueDate($psvn);
1436 :     $envir{'formattedDueDate'} = &formatDateAndTime(&getDueDate($psvn));
1437 :     $envir{'answerDate'} = &getAnswerDate($psvn);
1438 :     $envir{'formattedAnswerDate'} = &formatDateAndTime(&getAnswerDate($psvn));
1439 :     $envir{'problemValue'} = &getProblemValue($probNum,$psvn);
1440 :     $envir{'fileName'} = &getProblemFileName($probNum,$psvn);
1441 :     $envir{'probFileName'} = &getProblemFileName($probNum,$psvn);
1442 :     $envir{'languageMode'} = $mode;
1443 :     $envir{'displayMode'} = $mode;
1444 :     $envir{'outputMode'} = $mode;
1445 :     $envir{'courseName'} = $courseName;
1446 :     $envir{'sessionKey'} = ( defined($inputs{'key'}) ) ?$inputs{'key'} : " ";
1447 :    
1448 :     # initialize constants for PGanswermacros.pl
1449 :     $envir{'numRelPercentTolDefault'} = getNumRelPercentTolDefault();
1450 :     $envir{'numZeroLevelDefault'} = getNumZeroLevelDefault();
1451 :     $envir{'numZeroLevelTolDefault'} = getNumZeroLevelTolDefault();
1452 :     $envir{'numAbsTolDefault'} = getNumAbsTolDefault();
1453 :     $envir{'numFormatDefault'} = getNumFormatDefault();
1454 :     $envir{'functRelPercentTolDefault'} = getFunctRelPercentTolDefault();
1455 :     $envir{'functZeroLevelDefault'} = getFunctZeroLevelDefault();
1456 :     $envir{'functZeroLevelTolDefault'} = getFunctZeroLevelTolDefault();
1457 :     $envir{'functAbsTolDefault'} = getFunctAbsTolDefault();
1458 :     $envir{'functNumOfPoints'} = getFunctNumOfPoints();
1459 :     $envir{'functVarDefault'} = getFunctVarDefault();
1460 :     $envir{'functLLimitDefault'} = getFunctLLimitDefault();
1461 :     $envir{'functULimitDefault'} = getFunctULimitDefault();
1462 :     $envir{'functMaxConstantOfIntegration'} = getFunctMaxConstantOfIntegration();
1463 :     #kludge check definition of number of attempts again. The +1 is because this is used before the current answer is evaluated.
1464 :     $envir{'numOfAttempts'} = &getProblemNumOfCorrectAns($probNum,$psvn)
1465 :     + &getProblemNumOfIncorrectAns($probNum,$psvn)+1;
1466 :    
1467 :    
1468 :    
1469 :     # defining directorys and URLs
1470 :     $envir{'templateDirectory'} = &getCourseTemplateDirectory();
1471 :     $envir{'classDirectory'} = $Global::classDirectory;
1472 :     $envir{'cgiDirectory'} = $Global::cgiDirectory;
1473 :     $envir{'cgiURL'} = getWebworkCgiURL();
1474 :     $envir{'macroDirectory'} = getCourseMacroDirectory();
1475 :     $envir{'courseScriptsDirectory'} = getCourseScriptsDirectory();
1476 :     $envir{'htmlDirectory'} = getCourseHtmlDirectory();
1477 :     $envir{'htmlURL'} = getCourseHtmlURL();
1478 :     $envir{'tempDirectory'} = getCourseTempDirectory();
1479 :     $envir{'tempURL'} = getCourseTempURL();
1480 :     $envir{'scriptDirectory'} = $Global::scriptDirectory;
1481 :     $envir{'webworkDocsURL'} = $Global::webworkDocsURL;
1482 :    
1483 :    
1484 :     $envir{'inputs_ref'} = \%inputs;
1485 :     $envir{'problemSeed'} = $seed;
1486 :    
1487 :     # here is a way to pass environment variables defined in webworkCourse.ph
1488 :     my $k;
1489 :     foreach $k (keys %Global::PG_environment ) {
1490 :     $envir{$k} = $Global::PG_environment{$k};
1491 :     }
1492 :     %envir;
1493 :     }
1494 :    
1495 :     }; # end eval
1496 :    
1497 :     print "Content-type: text/plain\n\n Error in $Global::processProblem_CGI\n$@" if $@;
1498 :    
1499 :     #### for error checking and debugging purposes
1500 :     sub pretty_print_rh {
1501 :     my $rh = shift;
1502 :     foreach my $key (sort keys %{$rh}) {
1503 :     print " $key => ",$rh->{$key},"\n";
1504 :     }
1505 :     }
1506 :     END {
1507 :     if (defined($main::SIG_TIME_OUT) && $main::SIG_TIME_OUT == 1) {
1508 :     alarm(0); # turn off the alarm
1509 :    
1510 :     my $problem_message = qq!Content-type: text/html\n\n<HTML><BODY BGCOLOR = "FF99CC">
1511 :     <BLOCKQUOTE><H3>WeBWorK heavy useage time out.</H3>\n
1512 :     <H4>Your request for a WeBWorK problem was cancelled because it took more
1513 :     than $main::TIME_OUT_CONSTANT seconds.</H4>
1514 :     If this occurs for only this problem, it is likely that there is a programing error
1515 :     in this problem, maybe an infinite loop. Please report this to your instructor.<P>\n
1516 :     If you get this error on several different problems, it
1517 :     is probably because the
1518 :     WeBWorK server is extraordinarily busy.<P>\n
1519 :     In this case you should be warned that WeBWorK response will be unusually slow. If possible you should try
1520 :     to use WeBWorK at another time when the load is not as high. The highest useage periods are in the
1521 :     evening, particularly in the two hours before assignments are due.<P>\n
1522 :     Use the back button to return to the previous page and try again.<P>\n
1523 :     If the high useage problem continues you can report this to your instructor using
1524 :     the feedback button.
1525 :     <P>
1526 :     Script: $Global::processProblem_CGI
1527 :     </BLOCKQUOTE></BODY></HTML>
1528 :     !;
1529 :     print $problem_message, "\n";
1530 :    
1531 :    
1532 :    
1533 :     }
1534 :    
1535 :     # begin Timing code
1536 :     if( $main::logTimingData == 1 ) {
1537 :     my $endTime = new Benchmark;
1538 :     my $error_str='';
1539 :    
1540 :     if ($main::SIGPIPE) {
1541 :     $error_str = 'broken PIPE--';
1542 :     }
1543 :     elsif ($main::SIG_TIME_OUT) {
1544 :     $error_str = "TIME_OUT after $main::TIME_OUT_CONSTANT secs --";
1545 :     }
1546 :    
1547 :     &Global::logTimingInfo($main::beginTime,$endTime,$error_str.'processProb8.pl '. "(mode: $main::display_mode, action: $main::Action)",$main::Course,$main::User);
1548 :     }
1549 :     # end Timing code
1550 :    
1551 :     }
1552 :    

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9