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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9