[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 11 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9