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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9