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

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9