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