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