[system] / trunk / pg / macros / displayMacros.pl Repository:
ViewVC logotype

Annotation of /trunk/pg/macros/displayMacros.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : sh002i 1050
2 : apizer 1080
3 : gage 4997 =head1 displayMacros.pl
4 :    
5 :     This file is used with WeBWorK 1.9 and is not used for WeBWorK 2.x.
6 :    
7 :     =cut
8 :    
9 : sh002i 1050 use strict;
10 :    
11 :     ## $ENV{'PATH'} .= ':/usr/math/bin';
12 :    
13 :     my $debug = 0;
14 :     $debug = 1 if $Global::imageDebugMode;
15 :     ## if $debug =1, log, etc. files created by
16 :     ## latex2html are not deleted
17 :    
18 :     ##############################################################
19 :     # File: DisplayMacros.pl
20 : gage 4997 # This contains the subroutines for creating problem files
21 : sh002i 1050 ##############################################################
22 :    
23 :     ################################################################
24 :     # Copyright @1995-1998 by Michael E. Gage, Arnold K. Pizer and
25 :     # WeBWorK at the University of Rochester. All rights reserved.
26 :     ################################################################
27 :    
28 :    
29 :     ## To add or delete displayModes edit this file
30 :    
31 :     sub displaySelectModeLine_string
32 :     # called from probSet.pl
33 :     # displays the option line for selecting display modes
34 :     {
35 : jj 1765 my ($displayMode) =@_ ;
36 :     $displayMode = $Global::htmlModeDefault unless(defined($displayMode));
37 : jj 1764 # If the system is set up with only one display mode, there is
38 :     # no need to display a choice - use the default
39 :     if(scalar(@{$Global::available_mode_list})<2) {
40 :     return('<input type="hidden" name="Mode" value="'.
41 : jj 1765 $displayMode .'">');
42 : jj 1764 }
43 : sh002i 1050 my $out = "Display Mode: <BR>";
44 :    
45 :     # A list of the available modes.
46 :     my $mode_list = $Global::available_mode_list; ## ref to a list of available modes
47 :     ## The format is [internal symbol, external name]
48 :     # A list of the available modes.
49 :     # Format is [internal symbol, external name, ""], where the third
50 :     # argument is changed to checked below for the current displayMode
51 :     # my $mode_list = [
52 :     # ['HTML', 'text', ""],
53 :     # ['HTML_tth', 'formatted-text',""],
54 :     # ['HTML_dpng' ,'dvipng',""],
55 :     # ['Latex2HTML', 'typeset',""]
56 :     # ];
57 :    
58 :     # Make the format [internal symbol, external name, '']
59 :     # The third argument is changed to checked below for the current displayMode
60 :     my $j;
61 :     for $j (0..(scalar(@{$mode_list})-1)) {
62 :     push @{$mode_list->[$j]},'';
63 :     }
64 :    
65 : jj 1765 if (! defined($displayMode) ) {$displayMode = $Global::htmlModeDefault;}
66 : sh002i 1050
67 :    
68 :     my $found = 0;
69 :     # Search through all modes to match for displayMode
70 :     # If we don't find one, found=0 will trigger warn message below
71 :     for $j (0..(scalar(@{$mode_list})-1)) {
72 :     if($mode_list->[$j]->[0] eq $displayMode) {
73 :     $mode_list->[$j]->[2] = "CHECKED";
74 :     $found=1;
75 :     last;
76 :     }
77 :     }
78 :    
79 :     for $j (@{$mode_list}) {
80 :     $out .= qq!<INPUT TYPE=RADIO NAME="Mode" VALUE="$j->[0]" $j->[2]>$j->[1]<BR>\n!;
81 :     }
82 :     if(! $found) {
83 :     my $wstr = " Error: displayMacros.pl: sub displaySelectModeLine. Unrecognized mode |$displayMode| . The acceptable modes are: ";
84 :     for $j (@{$mode_list}) {
85 :     $wstr .= " $j->[0] ";
86 :     }
87 :     warn $wstr;
88 :     }
89 :     $out;
90 :     }
91 :    
92 :     sub displaySelectModeLine {
93 :     print displaySelectModeLine_string(@_);
94 :     }
95 :     ##################################################################################################################
96 :     # Does the initial processing of the problem.
97 :     # Returns an array containing the rendered problem. #
98 :     ##################################################################################################################
99 :    
100 :     sub createDisplayedProblem {
101 :    
102 :     my ($setNumber,$probNum,$psvn,$printlinesref,$rh_flags)= @_;
103 :     my @printlines;
104 :    
105 :    
106 :     my $coursel2hDirectory = getCoursel2hDirectory();
107 :     unless(-e $coursel2hDirectory ) {
108 :     &createDirectory($coursel2hDirectory, $Global::l2h_set_directory_permission,
109 :     $Global::numericalGroupID);
110 :     }
111 :    
112 :     unless(-e "${coursel2hDirectory}set$setNumber") {
113 :     &createDirectory("${coursel2hDirectory}set$setNumber",$Global::l2h_set_directory_permission,
114 :     $Global::numericalGroupID);
115 :     }
116 :    
117 :    
118 :     my $PROBDIR = convertPath("${coursel2hDirectory}set$setNumber/$probNum-$psvn/");
119 :     my $TMPPROBDIR = convertPath("${coursel2hDirectory}$probNum-$psvn/");
120 :    
121 :     if (! -e $PROBDIR) { # no gifs of equations have been created
122 :     &l2hcreate($setNumber,$probNum,$psvn,$printlinesref);
123 :    
124 :     } else { # determine if the gifs are older than the modifications of the source file
125 :     #&attachProbSetRecord($psvn);
126 :     my $fileName = &getProblemFileName($probNum,$psvn);
127 :     $fileName = "${Global::templateDirectory}$fileName";
128 :     #print "\n\n The filename is $fileName \n\n";
129 :     my @probDirStat = stat $PROBDIR;
130 :     my @sourceFileStat = stat $fileName;
131 :     #print "\n\n The source file age is $sourceFileStat[9] \n\n";
132 :     #print "\n\n The prob dir age is $probDirStat[9] \n\n";
133 :    
134 :     if (($sourceFileStat[9] > $probDirStat[9] ) or
135 :     $rh_flags->{'refreshCachedImages'}) {
136 :     ## source file is newer or solutions should be shown recreate the l2h cache
137 :     rmDirectoryAndFiles($PROBDIR);
138 :     &l2hcreate($setNumber,$probNum,$psvn,$printlinesref);
139 :     }
140 :    
141 :    
142 :     }
143 :     #the problem has been rendered by Latex2HTML into this file:
144 :     # open(TEXXX, "${PROBDIR}${psvn}output.html") || die "Can't open ${PROBDIR}${psvn}output.html";
145 :     open(TEXXX, "${PROBDIR}${psvn}output.html") or
146 :     warn "ERROR: $0".
147 :     "Can't open the HTML file: \n ${PROBDIR}${psvn}output.html\n(allegedly)".
148 :     "translated by latex2HTML\n at displayMacros.pl, line" . __LINE__ ;
149 :    
150 :     @printlines = <TEXXX>;
151 :     push(@printlines, "The file ${PROBDIR}${psvn}output.html was empty") unless @printlines;
152 :     #print "PRINTLINES",@printlines;
153 :     close(TEXXX);
154 :    
155 :     @printlines;
156 :     }
157 :    
158 :    
159 :    
160 :     ###########################################################################################
161 :     # Formats and displays the responses to submitted answers to the problem. Returns a string. #
162 :     ###########################################################################################
163 :    
164 :     sub display_answers { # this will be put in displayMacros.pl soon.
165 :     #my ($displayCorrectAnswersQ,$showPartialCorrectAnswers,$rh_answer_results,$rh_problem_result) = @_;
166 :     my ($rh_answer_results,$rh_problem_result,$rh_flags) = @_;
167 :     my $displayCorrectAnswersQ = $rh_flags ->{displayCorrectAnswersQ};
168 :     my $showPartialCorrectAnswers = $rh_flags -> {showPartialCorrectAnswers};
169 :     my @answer_entry_order = @{$rh_flags -> {ANSWER_ENTRY_ORDER} };
170 :     my $ANSWER_PREFIX = $rh_flags -> {ANSWER_PREFIX};
171 :     my $allAnswersCorrectQ = 1;
172 :     my $printedResponse='';
173 :     ###### Print appropriate response to submitted answers
174 :     my ($i,$answerIsCorrectQ, $normalizedSubmittedAnswer,$normalizedCorrectAnswer,$ans_name,$errors);
175 :     $i=0;
176 : apizer 1351 # $printedResponse .= "\n<table border=0 cellpadding=0 cellspacing=0 bgcolor=\"#cccccc\">\n";
177 :     # replace above line by next two lines as per Davide Cervone. AKP.
178 :     $printedResponse .= "\n<table border=0 cellpadding=7 cellspacing=0 bgcolor=\"#cccccc\">\n";
179 :     $printedResponse .= "<tr><td><table border=0 cellpadding=0 cellspacing=0>\n";
180 : sh002i 1050 foreach my $key ( @answer_entry_order ) {
181 :    
182 :     $i++;
183 :     $answerIsCorrectQ = $rh_answer_results ->{$key} -> {score};
184 :     $normalizedSubmittedAnswer = $rh_answer_results ->{$key} -> {student_ans};
185 :     $normalizedSubmittedAnswer = '' if ($normalizedSubmittedAnswer =~ /^error:\s+empty/);
186 : gage 1071 $normalizedCorrectAnswer = $rh_answer_results ->{$key} -> {original_correct_ans};
187 :    
188 :     ## Handle the case where the answer evaluator does not return original_correct_ans
189 :     if ((!defined $normalizedCorrectAnswer) or (!$normalizedCorrectAnswer =~ /\S/)) {
190 :     $normalizedCorrectAnswer = $rh_answer_results ->{$key} -> {correct_ans};
191 :     }
192 :    
193 : sh002i 1050 $errors = $rh_answer_results ->{$key} -> {ans_message};
194 :     $errors = '' if ($errors eq 'empty');
195 :     #$ans_name = $rh_answer_results ->{$key} -> {ans_name};
196 :     #$ans_name =~ s/$ANSWER_PREFIX//; # this handles implicitly defined answer names.
197 :     $ans_name = $i; # just number the answers in order
198 :     $allAnswersCorrectQ = $allAnswersCorrectQ && $answerIsCorrectQ;
199 :     $printedResponse .= "\n<TR><TD align=left COLSPAN =2><em>Answer $ans_name entered:</em>--&gt; $normalizedSubmittedAnswer &lt;-- ";
200 :     $printedResponse .= "<B>Correct. </B></TD></TR>" if ($answerIsCorrectQ && $showPartialCorrectAnswers );
201 :     $printedResponse .= "<B>Incorrect. </B></TD></TR>" if (!($answerIsCorrectQ) && $showPartialCorrectAnswers);
202 : apizer 1351 $errors =~ s/\n/<BR>/g; ## convert newlines to <BR> in error messages as per Davide Cervone
203 : sh002i 1050 # change 9/2/00 by MEG -- give width in pixels rather than %.
204 :     # Some browsers break with % widht which is not the standard
205 : apizer 1351 $printedResponse .= "\n<TR> <TD align=left WIDTH = \"50\" >&nbsp;</TD><TD align=left>$errors</TD></TR>" if ($errors =~ /\w/);
206 : sh002i 1050
207 : apizer 1351 $printedResponse .= "\n<TR><TD align=left WIDTH = \"50\">&nbsp;</TD> <TD align=left><em>Correct answer:</em> $normalizedCorrectAnswer</TD></TR>" if ($displayCorrectAnswersQ);
208 : sh002i 1050
209 :     }
210 :     if ($i == 1) {
211 :     $printedResponse .= "\n<TR><TD align=left COLSPAN =2><B>The above answer is correct.</B><BR>" if ($allAnswersCorrectQ);
212 :     $printedResponse .= "\n<TR><TD align=left COLSPAN =2><B>The above answer is NOT correct.</B><BR>" if (!($allAnswersCorrectQ));
213 :     }
214 :     else {
215 :     $printedResponse .= "\n<TR><TD align=left COLSPAN =2><B>All of the above answers are correct.</B><BR>" if ($allAnswersCorrectQ);
216 :     $printedResponse .= "\n<TR><TD align=left COLSPAN =2><B>At least one of the above answers is NOT correct.</B><BR>" if (!($allAnswersCorrectQ));
217 :     }
218 :     my $percentCorr = int(100*$rh_problem_result->{score} +.5);
219 :    
220 :     $printedResponse .="\n<TR><TD align=left COLSPAN =2><B>Your score on this attempt is ${percentCorr}\%.</B><BR>";
221 : apizer 1351 # $printedResponse .= "\n</table>\n";
222 :     # replace above line by next line as per Davide Cervone. AKP.
223 :     $printedResponse .= "</td></tr>\n</table>\n</table>\n";
224 : sh002i 1050 # $printedResponse .="\n problem grader is ".$rh_problem_result->{type}." and the score is ".$rh_problem_result->{score}."<BR>\n";
225 :     $printedResponse;
226 :     }
227 :    
228 :     ###########################################################################################
229 :     # Previews submitted answers to the problem. Returns a string. #
230 :     ###########################################################################################
231 :    
232 :     sub preview_answers {
233 :     my ($rh_answer_results,$rh_problem_result,$rh_flags) = @_;
234 :     my @answer_entry_order = @{$rh_flags -> {ANSWER_ENTRY_ORDER} };
235 :     my $ANSWER_PREFIX = $rh_flags -> {ANSWER_PREFIX};
236 :     my $printedResponse ='';
237 :     ###### Print appropriate response to submitted answers
238 :     my ($i,$original_student_ans,$normalizedSubmittedAnswer,$errors,$ans_name,$preview_text_string,$preview_latex_string);
239 :     my ($ans_evaluator_type, $value_word, $error_word, $show_value);
240 :    
241 :     $i=0;
242 :     $printedResponse .= "\n<table border=0 cellpadding=0 cellspacing=0 >\n";
243 :     foreach my $key ( @answer_entry_order ) {
244 :     $i++;
245 :     $ans_name = $rh_answer_results ->{$key} -> {ans_name};
246 :     #$ans_name =~ s/$ANSWER_PREFIX//; # this handles implicitly defined answer names. #commented out by DME 6/6/2000
247 :     $original_student_ans = $rh_answer_results ->{$key} -> {original_student_ans};
248 :     $normalizedSubmittedAnswer = $rh_answer_results ->{$key} -> {student_ans};
249 :     $errors = $rh_answer_results ->{$key} -> {ans_message};
250 : apizer 1351 $errors =~ s/\n/<BR>/g; ## convert newlines to <BR> in error messages as per Davide Cervone
251 : sh002i 1050 $preview_text_string ='';
252 :     $preview_text_string = $rh_answer_results ->{$key} -> {preview_text_string}
253 :     if defined $rh_answer_results ->{$key} -> {preview_text_string};
254 :     $preview_latex_string ='';
255 :     $preview_latex_string = $rh_answer_results ->{$key} -> {preview_latex_string}
256 :     if defined $rh_answer_results ->{$key} -> {preview_latex_string};
257 :     $ans_evaluator_type = $rh_answer_results ->{$key} -> {type};
258 :     $value_word = 'value:';
259 :     $show_value = 0;
260 :     $show_value = 1 if ((($ans_evaluator_type =~ /number/) and ($normalizedSubmittedAnswer =~ /\w/)) or ($normalizedSubmittedAnswer =~ /^error/));
261 :     $show_value = 0 if ($normalizedSubmittedAnswer =~ /^error:\s+empty/);
262 :     $value_word = '' if ($normalizedSubmittedAnswer =~ /^error/);
263 :     $error_word = 'error:';
264 :     $error_word = '' if ($errors =~ /^error:/);
265 :     $printedResponse .= "\n<TR><TD align=left>Ans $i </TD>";
266 :     #$printedResponse .= "\n<TD align=left><INPUT TYPE=\"text\" NAME=\"${ANSWER_PREFIX}${ans_name}\" VALUE=\"$original_student_ans\" SIZE=70></TD></TR>"; #commented out by DME 6/6/2000
267 :     $printedResponse .= "\n<TD align=left><INPUT TYPE=\"text\" NAME=\"${ans_name}\" VALUE=\"$original_student_ans\" SIZE=70></TD></TR>";
268 :     $printedResponse .= "\n<TR> <TD align=left WIDTH = \"7%\" ></TD><TD align=left>parsed: $preview_text_string</TD></TR>" if ($preview_text_string =~ /\w/);
269 :     $printedResponse .= "\n<TR> <TD align=left WIDTH = \"7%\" ></TD><TD align=left>${value_word} $normalizedSubmittedAnswer</TD></TR>" if $show_value == 1;
270 :     $printedResponse .= "\n<TR> <TD align=left WIDTH = \"7%\" ></TD><TD align=left>${error_word} $errors</TD></TR>" if (($errors =~ /\w/) and ($errors ne 'empty')) ;
271 :     if ($preview_latex_string =~ /\w/) {
272 :     $printedResponse .= "\n<TR> <TD align=left WIDTH = \"7%\" ></TD><TD align=left>";
273 :     $printedResponse .= "\n <APPLET CODE=\"HotEqn.class\" HEIGHT=\"80\" WIDTH=\"500\" ARCHIVE=\"HotEqn.zip\" NAME=\"Equation\" ALIGN=\"middle\" CODEBASE=\"$Global::appletsURL\"> ";
274 :     $printedResponse .= "\n <PARAM NAME=\"equation\" VALUE=\"$preview_latex_string\"></APPLET></TD></TR> ";
275 :     }
276 :     $printedResponse .= "\n<TR Height = 5></TR>";
277 :     }
278 :    
279 :     $printedResponse .= "\n</table>\n";
280 :     $printedResponse;
281 :     }
282 :    
283 :    
284 :     sub lc_sort { # this sorts strings with letters and number groups, alternately lexigraphically and numerically
285 :     # (lc stands for library of congress as in QA617.34R45)
286 :     my($left,$right) = @_;
287 :     # format "abcd345.57def34ABC";
288 :     # string assumed to begin with alpha
289 :     # string is split into alternating alpha and numeric groups
290 :     # numeric groups match [\d\.]+
291 :     # numeric groups assumed to contain at least one digit, ( a period alone will cause and error)
292 :     # alpha groups can contain any characters except digits and the period
293 :     # spaces in alpha groups will cause unexpected behavior
294 :     # sort is not case sensitive
295 :     # _ sorts after alpha characters
296 :    
297 :     # not case sensitive
298 :    
299 :     my @a = split( /([\d\.]+)/, $left);
300 :    
301 :     my @b = split( /([\d\.]+)/, $right);
302 :    
303 :     my $out = undef;
304 :     my $mode = 0; # even is lexic and odd is numeric
305 :     my($l,$r);
306 :     while (@a) {
307 :     $l = shift @a;
308 :     $r = shift @b;
309 :     $out = ($mode++ % 2 == 0) ? uc($l) cmp uc($r) : $l <=> $r; # lexic or numeric compare
310 :     last unless $out==0; # stop unless $l and $r are different.
311 :    
312 :     }
313 :     $out;
314 :     }
315 :    
316 :     #####################################################################
317 :     # Creates an insert which appears on the probSet page. #
318 :     #####################################################################
319 :     sub createDisplayedInsert
320 :     {
321 :     #my ($mode,$setNumber,$fileName,$psvn,$courseName,$printlinesref)= @_;
322 :     my ($setNumber,$fileName,$psvn,$courseName,$printlinesref)= @_;
323 :    
324 :     my @printlines=@$printlinesref;
325 :     my $PROBDIR;
326 :    
327 :     # if($mode eq "HTML" || $mode eq 'HTML_tth') {
328 :     # @printlines = &createProblem2($mode,$fileName,$psvn,$courseName,$sourceref);
329 :     #
330 :     # } elsif ($mode eq 'Latex2HTML') {
331 :     #latex2html processing
332 :     my $coursel2hDirectory = getCoursel2hDirectory();
333 :     unless(-e $coursel2hDirectory ) {
334 :     &createDirectory($coursel2hDirectory, $Global::l2h_set_directory_permission,
335 :     $Global::numericalGroupID);
336 :     }
337 :    
338 :     unless(-e "${coursel2hDirectory}set$setNumber") {
339 :     &createDirectory("${coursel2hDirectory}set$setNumber",$Global::l2h_set_directory_permission,
340 :     $Global::numericalGroupID);
341 :     }
342 :    
343 :     my $shortFileName = $fileName;
344 :     $shortFileName =~ s|^.*?([^\/]*)$|$1|;
345 :     $shortFileName =~ s|\..*$||;
346 :     $PROBDIR = convertPath("${coursel2hDirectory}set$setNumber/$shortFileName-$psvn/");
347 :     if (! -e $PROBDIR) {
348 :     &l2hcreate($setNumber,$shortFileName,$psvn,$printlinesref);
349 :     } else {
350 :     #&attachProbSetRecord($psvn);
351 :     my $fullFileName = "${Global::templateDirectory}$fileName";
352 :     #print "\n\n The full filename is $fullFileName \n\n";
353 :     my @probDirStat = stat $PROBDIR;
354 :     my @sourceFileStat = stat $fullFileName;
355 :     #print "\n\n The source file age is $sourceFileStat[9] \n\n";
356 :     #print "\n\n The prob dir age is $probDirStat[9] \n\n";
357 :     if ($sourceFileStat[9] > $probDirStat[9] ) { ## source file is newer
358 :     rmDirectoryAndFiles($PROBDIR);
359 :     &l2hcreate($setNumber,$shortFileName,$psvn,$printlinesref);
360 :     }
361 :     #else {&createProblem2($mode, $fileName, $psvn,$courseName,$sourceref);} ##initialize problem
362 :    
363 :     }
364 :    
365 :    
366 :     open(TEXXX, "${PROBDIR}${psvn}output.html") or
367 : sh002i 2274 die "ERROR: $0 Can't open ${PROBDIR}${psvn}output.html";
368 : sh002i 1050 @printlines = <TEXXX>;
369 :     close(TEXXX);
370 :     # } else {
371 :     #
372 :     # @printlines="createDisplayedProblem: Error: Mode is not HTML, HTML_tthHTML_tth or Latex2HTML.";
373 :     #
374 :     #
375 :     # }
376 :     @printlines;
377 :     }
378 :    
379 :     ##do not need this subroutine anymore
380 :     #sub l2hcreateProb {
381 :     # my ($setNumber,$probNum,$psvn,$printlinesref)= @_;
382 :     # #my ($setNumber,$probNum,$psvn,$courseName,$printlinesref)= @_;
383 :     # #my $mode = 'Latex2HTML';
384 :     #
385 :     # #my @printlines = &createProblem($mode, $probNum, $psvn, $courseName,$sourceref,$refSubmittedAnswers);
386 :     # #my $printlinesref = \@printlines;
387 :     # my $tmpDirectory = "tmp/l2h/set$setNumber/$probNum-$psvn/";
388 :     # l2hcreate($setNumber,$probNum,$psvn,$printlinesref)
389 :     #}
390 :    
391 :     #do not use this subroutine anymore
392 :     #sub l2hcreateInsert {
393 :     # my ($setNumber,$shortFileName,$psvn,$printlinesref)= @_;
394 :     # #my $mode = 'Latex2HTML';
395 :     # #my @printlines = &createProblem2($mode, $fileName, $psvn,$courseName,$sourceref);
396 :     # #my $printlinesref = \@printlines;
397 :     # #my $shortFileName = $fileName;
398 :     # #$shortFileName =~ s|^.*?([^\/]*)$|$1|;
399 :     # #my $tmpDirectory = "tmp/l2h/set$setNumber/$shortFileName-$psvn/";
400 :     # l2hcreate($setNumber,$shortFileName,$psvn,$printlinesref)
401 :     #}
402 :    
403 :     sub l2hcreate { ## for latex2HTML 96.1 and 98.1
404 :     my ($setNumber,$probNum,$psvn,$printlinesref) = @_;
405 :    
406 :     # warn "l2hcreate is being executed displaymacros.pl line ".__LINE__;
407 :    
408 :     my $PROBDIR = convertPath(&getCoursel2hDirectory."set$setNumber/$probNum-$psvn/");
409 :     my $TMPPROBDIR = convertPath(&getCoursel2hDirectory."$probNum-$psvn/");
410 :     my $PROBURL = &getCoursel2hURL."set$setNumber/$probNum-$psvn/";
411 :    
412 :     &createDirectory($TMPPROBDIR,$Global::l2h_prob_directory_permission,$Global::numericalGroupID)
413 :     unless(-e "$TMPPROBDIR");
414 :    
415 : sh002i 2274 open(OUTTEXFILE, ">$TMPPROBDIR${psvn}output.tex") or die "Can't open temporary file $TMPPROBDIR${psvn}output.tex";
416 : sh002i 1050
417 :     print OUTTEXFILE &texInput($Global::TEX_PROB_PREAMBLE);
418 :     print OUTTEXFILE &texInput($Global::TEX_PROB_HEADER);
419 :     print OUTTEXFILE @$printlinesref;
420 :     print OUTTEXFILE &texInput($Global::TEX_PROB_FOOTER);
421 :     close(OUTTEXFILE);
422 :    
423 :     ## Give this temporary file permission 666 in case the process dies before it it deleted 60 lines further down
424 :     chmod(0666, "$TMPPROBDIR${psvn}output.tex");
425 :    
426 :     ## system("/usr/math/bin/latex2html -init_file ${Global::mainDirectory}latex2html.init -dir $PROBDIR -prefix $psvn ${htmlDirectory}tmp/l2h/${psvn}output.tex > ${htmlDirectory}tmp/l2h/${psvn}l2h.log");
427 :     my $latex2HTML_result = &makeL2H($TMPPROBDIR, $psvn) ;
428 :     warn( "LaTeX2HTML failed. Returned with status: $latex2HTML_result\n" ) if $latex2HTML_result ;
429 : gage 1071
430 : sh002i 1050 ##Get rid of all unwanted stuff in html document created by latex2html
431 :     unless(-e "${TMPPROBDIR}${psvn}output.html") {
432 :     warn "Can't rename ${TMPPROBDIR}${psvn}output.html";
433 :     return (0); ### there was a failure in latex2html processing
434 :     ### we just give a warning so that so that l2hPrecreateSet.pl can continue
435 :     }
436 :    
437 :     rename("${TMPPROBDIR}${psvn}output.html","${TMPPROBDIR}${psvn}output.html.org") or
438 :     warn "Can't rename ${TMPPROBDIR}${psvn}output.html at ". __LINE__;
439 :     open(TEXORG, "${TMPPROBDIR}${psvn}output.html.org") or
440 :     warn "Can't open ${TMPPROBDIR}${psvn}output.html.org";
441 :     my @l2hOutputArray;
442 :    
443 :    
444 :    
445 :    
446 :     BLK: { # This is protection to make absolutely sure that the line separater is set properly.
447 :     # It's still a mystery as to where this becomes defined to be something else.
448 :     local($/);
449 :     $/ = "\n";
450 :     @l2hOutputArray = <TEXORG>;
451 :    
452 :    
453 :     }
454 :    
455 :     close(TEXORG);
456 :     open(TEXNEW, ">${TMPPROBDIR}${psvn}output.html") or
457 : sh002i 2274 die "Can't open ${TMPPROBDIR}${psvn}output.html";
458 : sh002i 1050
459 :    
460 :     foreach (@l2hOutputArray) {
461 :     if($_ =~ /^<META/) {next;}
462 :     if($_ =~ /^<!DOCTYPE HTML PUBLIC/) {next;}
463 :     if($_ =~ /^<HTML>/) {next;}
464 :     if($_ =~ /^<HEAD>/) {next;}
465 :     if($_ =~ /^<TITLE>/) {next;}
466 :     if($_ =~ /^<LINK REL/) {next;}
467 :     if($_ =~ /^<\/HEAD>/) {next;}
468 :     if($_ =~ /^<BODY/) {next;}
469 :     if($_ =~ /^<\/BODY>/) {next;}
470 :     if($_ =~ /^<\/HTML>/) {next;}
471 :     if($_ =~ /^<BR> <HR>/) {next;}
472 :    
473 :     print TEXNEW ;
474 :     }
475 :    
476 :    
477 :     close(TEXNEW);
478 :    
479 :     ## Now do global multiline changes on whole file
480 :    
481 :     open(TEXNEW, "${TMPPROBDIR}${psvn}output.html") or
482 : sh002i 2274 die "Can't open ${TMPPROBDIR}${psvn}output.html";
483 : sh002i 1050 @l2hOutputArray = <TEXNEW>;
484 :     close(TEXNEW);
485 :     my $l2hOutputString = join('',@l2hOutputArray);
486 :    
487 :     ## make gif images created by latex2html locatable by server
488 :     ## NOTE: $htmlURL is defined in webworkCourse.ph . Often this will
489 :     ## will be a link appearing in a public_html_docs directory.
490 :     ## The $htmlURL, any links, and the next line must be coordinated.
491 :    
492 :     $l2hOutputString =~ s|${psvn}img|${PROBURL}${psvn}img|g;
493 :    
494 :     ## remove multiline comments
495 :     $l2hOutputString =~ s|<!--.*?-->\n||sg;
496 :    
497 :     open(TEXNEW, ">${TMPPROBDIR}${psvn}output.html") or
498 : sh002i 2274 die "Can't open ${TMPPROBDIR}${psvn}output.html";
499 : sh002i 1050 print TEXNEW $l2hOutputString;
500 :     close(TEXNEW);
501 :    
502 :     ## remove unneeded files
503 :    
504 :     unless ($debug) {unlink("${TMPPROBDIR}${psvn}output.html.org");}
505 :     unless ($debug) {unlink(<${TMPPROBDIR}*images.*>);}
506 :     unless ($debug) {unlink(<${TMPPROBDIR}.*.db>);}
507 :     unless ($debug) {unlink(<${TMPPROBDIR}*.db>);}
508 :     unless ($debug) {unlink(<${TMPPROBDIR}IMG_PARAMS.*>);}
509 :     unless ($debug) {unlink(<${TMPPROBDIR}*.pl>);}
510 :     unless ($debug) {unlink(<${TMPPROBDIR}*.css>);}
511 :     unless ($debug) {unlink("${TMPPROBDIR}index.html");}
512 :     unless ($debug) {unlink("${TMPPROBDIR}${psvn}output.tex");}
513 :     unless ($debug) {unlink("${TMPPROBDIR}${psvn}l2h.log");}
514 :     unless ($debug) {
515 :     my @allfiles = ();
516 :     opendir( DIRHANDLE, "$TMPPROBDIR") || warn qq/Can't read directory $TMPPROBDIR $!/;
517 :     @allfiles = map "$TMPPROBDIR$_", grep( /^l2h/, readdir DIRHANDLE);
518 :     closedir(DIRHANDLE);
519 :     my $l2hTempDir = $allfiles[0];
520 :     if (defined $l2hTempDir) {
521 :     unlink(<$l2hTempDir/*>);
522 :     rmdir ($l2hTempDir);
523 :     }
524 :     }
525 :    
526 :     ## change permission and group on remaining files
527 :     chmod($Global::l2h_data_permission, glob("${TMPPROBDIR}*"));
528 :     chown(-1,$Global::numericalGroupID,glob("${TMPPROBDIR}*"));
529 :    
530 :     ## Now that all the processing has been done, rename the $TMPPROBDIR TO $PROBDIR
531 :    
532 :     rename("$TMPPROBDIR","$PROBDIR") or
533 :     warn "Can't rename the temporary problem directory:\n $TMPPROBDIR to $PROBDIR\n at displayMacros.pl , line: " . __LINE__ ;
534 :    
535 :     }
536 :    
537 :    
538 :     #########################################################################################################
539 :     ##Subroutine that makes answers sticky in l2h mode #
540 :     # #
541 :     # INPUT: $rh_submittedAnswers Reference to a hash containing the answers submitted #
542 :     # $ra_printLines Reference to an array containing the (HTML) text to be output #
543 :     # $rh_flags Reference to a hash containing flags; specifically a #
544 :     # reference to an array containing the answer field labels #
545 :     # #
546 :     # OUTPUT: @printLines An array containing the (modified) text to be output #
547 :     # #
548 :     # OVERVIEW: l2h_sticky_answers is given HTML text, a list of submitted answers, and a list of #
549 :     # answer field labels. Its job is to retain the user's answers between submissions #
550 :     # when in typeset mode (this is handled elsewhere in the text modes). Basically, its #
551 :     # job is to act as a "filter" for the HTML text, replacing the answer fields that have #
552 :     # been reset with fields containing the previously entered answers, returning the #
553 :     # modified text. A brief high-level overview of the algorithm follows: #
554 :     # #
555 :     # ALGORITHM: The references are first dereferenced. The incoming text is first joined into #
556 :     # one string. It is then split up again, but not by line. Rather, the text is split #
557 :     # such that each array entry is either text which can be ignored, or a single #
558 :     # <INPUT...> tag. Each entry is then processed. If it is an <INPUT> tag, then it #
559 :     # must be checked for the presence of each answer field label for which a value was #
560 :     # submitted (there are many <INPUT> fields which are not answer fields, so we can't #
561 :     # assume that consecutive <INPUT> fields correspond to consecutive answer labels). #
562 :     # If a label is found, the blank value space is replaced with the appropriate #
563 :     # submitted answer (note that we can assume that there is a one-to-one correspondence #
564 :     # between answer labels and submitted answers; this is guaranteed by the specs). Radio #
565 :     # buttons and checkboxes are handled specially; see below. The modified text is then #
566 :     # added to the output string, which is split on a placeholder such that the output #
567 :     # array has the same number of entries as the input array (this is not required, but #
568 :     # might avoid some subtle bug in the future). #
569 :     # #
570 :     # NOTE: The specifications seem to require that the input text array consist of one #
571 :     # field for each line of text. However, it appears that the input is actually one #
572 :     # field, with newline characters separating lines. This function should accept #
573 :     # either form of input, although the "correct" form of one field per line has not #
574 :     # been tested. It is possible that, if input is received in this form AND the #
575 :     # newline characters have been truncated, the output could be garbled. #
576 :     # #
577 :     # --David Etlinger 6/7/2000 #
578 :     # #
579 :     # ADDED: Added a few lines of code to properly handle radio buttons. Checkboxes still need #
580 :     # to be implemented. #
581 :     # --David Etlinger 6/14/2000 #
582 :     # #
583 :     # ADDED: Added code to handle checkboxes. This is complicated because the submitted checkboxes #
584 :     # are originally stored as a single string with "\0" as a delimiter. If the input type #
585 :     # is determined to be checkboxes, the string is first split into an array. A hash key #
586 :     # in a special checkbox array is then made to point to the array. This is done because #
587 :     # there might be more than one checkbox set in a single question. Each time an input line #
588 :     # of type checkbox appears, the next value in this array is popped into a temp variable. #
589 :     # If it is determined that the line being processed corresponds to this value, the line #
590 :     # is processed (made "sticky"); otherwise, the value is pushed back on the array. The #
591 :     # fact that the number of checked cehckboxes is known but the total number of checkboxes #
592 :     # is not means that a given line of input type checkbox might or might not correspond #
593 :     # to the next value in the checkbox array. (I hope this explanation is clear enough!) #
594 :     # --David Etlinger 6/28/2000 #
595 :     #########################################################################################################
596 :    
597 :     sub l2h_sticky_answers {
598 :     my ( $rh_submittedAnswers, $ra_printLines, $rh_flags ) = @_;
599 :    
600 :     #warn ("rh_submittedAnswers = \@rh_submittedAnswers");
601 :     #warn ("ra_printLines = \@{ra_printLines}");
602 :     #warn ("rh_flags = \@{rh_flags}");
603 :    
604 :     my %submittedAnswers = %{$rh_submittedAnswers};
605 :     my @printLines = @{$ra_printLines};
606 :     my @answerLabels = @{$rh_flags -> {ANSWER_ENTRY_ORDER}};
607 :    
608 :     my $line; # holds the text of each line
609 :     my $label; # holds each answer label
610 :     my $counter = 0; # holds the index of the current answer
611 :     my $output; # holds the text the subroutine returns
612 :    
613 :     my $answer_value;
614 :    
615 :     my %checkboxAns; # holder for the checkbox multi-part answers
616 :     my $nextCheckboxAns; # temp holder for the next checkbox answer to be processed
617 :    
618 :     my $placeholder = "\x253"; # unused hex character to join text lines with
619 :    
620 :     #first, convert the array of text lines to one string...
621 :     my $text = join( "$placeholder", @printLines );
622 :    
623 :     #then, split it such that a line consists of either text
624 :     #or a single <INPUT> tag (case insensitive; note also that
625 :     #whitespace within the <INPUT> tag is accounted for).
626 :     # NOTE -- the regular expression searches for "<", then any
627 :     # amount of whitespace, then "INPUT", then any number of
628 :     # characters that aren't ">", then ">". I think that instead of
629 :     # searching for characters that aren't ">", I could have instead
630 :     # searched to match a minimal number of characters (using ?), and
631 :     # then ">". I don't know regular expressions well enough to tell
632 :     # if this might lead to some subtle difference.
633 :     my @textLines = split( m|(<\s*INPUT[^>]*>)|is, $text );
634 :     #my @textLines = split( m|(<\s*INPUT.*?>)|is, $text );
635 :    
636 :     foreach $line ( @textLines ) {
637 :     if( $line =~ m|<\s*INPUT|i ) {
638 :     foreach $label ( @answerLabels ) {
639 :     next unless exists( $submittedAnswers{$label} ); # skip if no answer was submitted.
640 :     if( $line =~ m|NAME\s*=\s*"$label"|i ) {
641 :     if( $line =~ m|TYPE\s*=\s*RADIO|i ) { #handle radio buttons
642 :     $line =~ s|VALUE\s*=\s*"$submittedAnswers{$label}"|VALUE = "$submittedAnswers{$label}" CHECKED|i;
643 :     }
644 :     elsif( $line =~ m|TYPE\s*=\s*CHECKBOX|i ) {
645 :     #make the hash key point to an anonymous array
646 :     $checkboxAns{$label} = [ split( "\0", $submittedAnswers{$label} ) ] if not exists( $checkboxAns{$label} );
647 :     if( defined $checkboxAns{$label}[0] ) {
648 :     $nextCheckboxAns = shift @{$checkboxAns{$label}};
649 :     if( $line !~ s|VALUE\s*=\s*"$nextCheckboxAns"|VALUE = "$nextCheckboxAns" CHECKED|i ) {
650 :     unshift( @{$checkboxAns{$label}}, $nextCheckboxAns ); #put the unused answer back on the list
651 :     }
652 :     }
653 :     }
654 :     else {
655 :     # we'll assume this is something else, like one or more fields.
656 :     # if it's several fields, we need to take only one answer at a time
657 :     # \0 are used to delimeter between entries.
658 :     if ($submittedAnswers{$label} =~ /\0/ ) {
659 :     my @answers = split("\0", $submittedAnswers{$label});
660 :     $answer_value = shift(@answers); # use up the first answer
661 :     $submittedAnswers{$label}=join "\0", @answers; # store the rest
662 :     $answer_value= '' unless defined($answer_value);
663 :    
664 :     }
665 :     else {
666 :     $answer_value = $submittedAnswers{$label};
667 :     }
668 :    
669 :     $line =~ s|VALUE\s*=\s*""|VALUE = "$answer_value"|i;
670 :     }
671 :     }
672 :     }
673 :     } #end if test for "<INPUT"
674 :    
675 :     $output .= $line;
676 :     } #end foreach
677 :    
678 :     @printLines = split( m|$placeholder|, $output );
679 :     return @printLines;
680 :     } #end l2h_sticky_answers()
681 :    
682 :     ## This is the old system (but newer than the one below).
683 :     ## It has been replaced for two reasons:
684 :     ## 1) It is complicated and difficult to understand or modify
685 :     ## 2) It does not work for several situations that rarely come up,
686 :     ## but must be handled properly. Specifically, it doesn't handle
687 :     ## text with more than one <INPUT> tag on a given line very well.
688 :     ## there are probably other problems, but that is the biggest.
689 :     ## --DME 6/7/2000
690 :     # # the following doubly nested loop iterates over each line,
691 :     # # and for each line searches for each answer label. Technically,
692 :     # # it might have been faster to join each entry in @printlines
693 :     # # into one string, search on that, and split it back up, but I
694 :     # # felt that the slight theoretical speed gain was not worth the
695 :     # # added complexity.
696 :     # warn "answerLabels = @answerLabels"; #DEBUG
697 :     # foreach $line ( @printLines ) {
698 :     # warn "Line is $line"; #DEBUG
699 :     # foreach $label ( @answerLabels ) {
700 :     # if( $line =~ m|<INPUT TYPE=TEXT.*NAME="$label| ) {
701 :     # while ($line =~ /VALUE = ""/) {
702 :     # # Put trailing space in displayed answer so that while loop will
703 :     # # always end. We are using the form of the s/// operator which
704 :     # # evaluates its right hand side
705 :     # $line =~ s|NAME="$label" VALUE = ""|
706 :     # $counter++;
707 :     # $submittedAnswers[$counter]=" " unless defined ($submittedAnswers[$counter])
708 :     # && not $submittedAnswers[$counter] =~ /^\s*$/;
709 :     # qq{ NAME="$label" VALUE = "$submittedAnswers[$counter]" } |e;
710 :     # # This insures that in VALUE = "$submittedAnswers[$counter]"
711 :     # # the quantity $submittedAnswers[$counter]
712 :     # # is never empty. This is required in order to terminate the loop.
713 :     # } #end while
714 :     # push( @output, $line );
715 :     # } #end if
716 :     # else {
717 :     # push( @output, $line );
718 :     # }
719 :     # } #end foreach over @answerLabels
720 :     # } #end foreach over @printLines
721 :     #
722 :     # @printLines = @output;
723 :     # } #end outer if
724 :     #
725 :     # return @printLines;
726 :     # } #end l2h_sticky_answers()
727 :    
728 :     ##subroutine that makes answers sticky in l2h mode
729 :     # this is an old version of this routine, which assumes (incorrectly)
730 :     # that answer labels begin with "AnSwEr". I've left it here just in case...
731 :     # DME 6/6/2000
732 :     #sub l2h_sticky_answers {
733 :     # my ($refSubmittedAnswers, $refprintlines)=@_;
734 :     # my @printlines=@$refprintlines;
735 :     # if ((@{$refSubmittedAnswers}!=0)) {
736 :     # my $line;
737 :     # my @output=();
738 :     # foreach $line (@printlines) {
739 :     # if ($line =~ m|<INPUT TYPE=TEXT.*NAME="AnSwEr|) {
740 :     # #print "<P>line doesn't exists<P>\n" unless defined($line);
741 :     # while ($line =~ /VALUE = ""/) {
742 :     # ## Put trailing space in displayed answer so that while loop will
743 :     # ## always end. We are using the form of the s/// operator which evaluates its right hand side
744 :     # $line =~ s|NAME="AnSwEr(\d*)" VALUE = ""|
745 :     # my $tttemp = $1;
746 :     # ${$refSubmittedAnswers}[$tttemp-1]=" " unless defined (${$refSubmittedAnswers}[$tttemp-1])
747 :     # && not ${$refSubmittedAnswers}[$tttemp-1] =~ /^\s*$/;
748 :     #
749 :     # qq{ NAME="AnSwEr$tttemp" VALUE = "${$refSubmittedAnswers}[$tttemp-1]" } |e;
750 :     # # This insures that in VALUE = "${$refSubmittedAnswers}[$tttemp-1]" the quantity ${$refSubmittedAnswers}[$tttemp-1]
751 :     # # is never empty. This is required in order to terminate the loop.
752 :     # }
753 :     # push(@output, $line);
754 :     # }
755 :     # else {
756 :     # push(@output, $line);
757 :     # }
758 :     # }
759 :     #
760 :     # @printlines = @output;
761 :     # }
762 :     #
763 :     # @printlines;
764 :     #}
765 :    
766 :     ##subroutine that updates current keys in the l2h mode
767 :    
768 :     # sub l2h_update_keys {
769 :     # my ($sessionKey, $refprintlines)= @_;
770 :     # my @printlines=@$refprintlines;
771 :     # my $line;
772 :     # my @output=();
773 :     # #my $sessionKey = $main::sessionKey;
774 :     # warn "hi lines = ",join("",@printlines);
775 :     # foreach $line (@printlines) {
776 :     # if ($line =~ m|^\s*<A(.*?)\&key=[^&]*&user|) { #<A.*&key=.*?&user
777 :     # #grab the session key from the CGI input or make it blank
778 :     # $line =~ s|^\s*<A(.*?)&key=[^&]*&user|<A$1&key=$sessionKey&user|;
779 :     # warn "line = $line<BR>";
780 :     # push(@output, $line);
781 :     # }else{
782 :     # push(@output, $line);
783 :     # }
784 :     #
785 :     # }
786 :     # @printlines;
787 :     #
788 :     # }
789 :    
790 :    
791 :     sub makeL2H {
792 :     my ($TMPPROBDIR,$psvn) =@_;
793 :     $ENV{PATH} .= "$Global::extendedPath";
794 :     if($Global::externalLaTeX2HTMLVersion eq "98.1p1") {
795 :     system("$Global::externalLaTeX2HTMLPath -no_math -init_file $Global::externalLaTeX2HTMLInit -dir $TMPPROBDIR -prefix $psvn $TMPPROBDIR${psvn}output.tex > $TMPPROBDIR${psvn}l2h.log 2>&1");
796 :     } elsif($Global::externalLaTeX2HTMLVersion eq "96.1") {
797 :     system("$Global::externalLaTeX2HTMLPath -init_file $Global::externalLaTeX2HTMLInit -dir $TMPPROBDIR -prefix $psvn $TMPPROBDIR${psvn}output.tex > $TMPPROBDIR${psvn}l2h.log");
798 :     } else {
799 :     die "Unknown LaTeX2HTML version: \$Global::externalLaTeX2HTMLVersion = $Global::externalLaTeX2HTMLVersion";
800 :     }
801 :     }
802 :    
803 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9