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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5557 - (download) (as text) (annotate)
Thu Oct 4 16:41:07 2007 UTC (12 years, 3 months ago) by sh002i
File size: 37395 byte(s)
documentation cleanup

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9