[system] / trunk / webwork / system / cgi / cgi-scripts / pod2webwork.pl Repository:
ViewVC logotype

View of /trunk/webwork/system/cgi/cgi-scripts/pod2webwork.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (download) (as text) (annotate)
Thu Jun 14 17:08:51 2001 UTC (18 years, 8 months ago) by sam
File size: 7898 byte(s)
initial import

    1 #!/usr/bin/perl
    2 
    3 ## $Id$
    4 
    5 ####################################################################
    6 # Copyright @ 1995-1998 University of Rochester
    7 # All Rights Reserved
    8 ####################################################################
    9 
   10 use strict;
   11 
   12 use lib '/ww/webwork/system/'; # mainWeBWorKDirectory;
   13 # this is the home directory. (change to system)
   14 use Global;
   15 use Pod::Html;
   16 
   17 use CGI qw(:standard);
   18 #eval {
   19 $| = 1;   #force command buffering
   20 print "Content-type: text/html\n\n";
   21 $| = 0;
   22 # augment the paths to search for documentation.
   23 # e.g. '/webwork/experimental/courseScripts', '/webwork/experimental/scripts',
   24 # This is not fool proof, but it will work if the webwork system has been set up as at U. of Rochester.
   25 
   26 #my $dir1 = $INC[0];
   27 #my $dir2 = $INC[1];
   28 
   29 my $dir3 = "/ww/webwork/development/";  #kludge for the summer so that the latest docs make it to the web.
   30 unshift(@INC,$dir3);
   31 #unshift(@INC, $dir1.'courseScripts/',$dir1.'scripts/',$dir1.'cgi/cgi-scripts/');
   32 #unshift(@INC, $dir2.'courseScripts/',$dir2.'scripts/',$dir2.'cgi/cgi-scripts/');
   33 unshift(@INC, $dir3.'courseScripts/',$dir3.'scripts/',$dir3.'cgi/cgi-scripts/');
   34 #   End defining search paths.
   35 
   36 open( LOG, ">pod2webwork.log" );
   37 print LOG "";
   38 close( LOG );
   39 open( LOG, ">>pod2webwork.log" );
   40 
   41 my $path = param('path');
   42 
   43 my $HTMLpre = 0;    #for use with clipline(); must be global to this file
   44             #because it's used over multiple calls of clipline()
   45 
   46 my $up_path = referer(); #This is the URL that the "up" button will point to.
   47 if (defined $up_path)  {
   48   # point to the index of the directory
   49   $up_path =~ s|/[^/]*$|/index.html|g;
   50 
   51 } else {
   52   $up_path = "${Global::webworkDocsURL}";
   53 }
   54 
   55 
   56 # Now find the path to the file
   57 my $p;
   58 
   59 foreach $p ("",@INC) {
   60   if (-r "$p$path") {
   61     $path = "$p$path";
   62     #print "found $path<BR>\n";
   63     last;
   64   }
   65   #print "looking for $p$path<BR>\n";
   66 }
   67 
   68 output_filter();   # install output filter
   69 
   70 
   71 pod2html($path, "--title= ");  # produces a blank title, eliminating error message.
   72                                # real title is produced in output_filter
   73 close(STDOUT);
   74 close( LOG );
   75 
   76 
   77 
   78 #}; # end eval
   79 
   80 print "Content-type: text/html\n\n <PRE> $@ </PRE>" if $@;
   81 
   82 ###########
   83 
   84    # This will print to STDOUT which will then be filtered.
   85 sub output_filter{
   86       # use command buffering;
   87     my $pid;
   88 
   89     return if $pid = open(STDOUT, "|-") ;  #I'm not sure why this works -- see Perl cookbook.
   90 
   91   print <<EOT;
   92 
   93   <html>
   94   <head>
   95   <title>$path</title>
   96   </head>
   97   <body alink="#008000" bgcolor="#FFFFFF" link="#0000FF" vlink="#800080"><p>
   98 
   99    <!--ALIGN = "CENTER" -->
  100   <IMG SRC="${Global::imagesURL}webwork-short.gif"  BORDER=1 ALT ="WeBWorK" ALIGN = "LEFT"  >
  101   <P ALIGN=RIGHT>
  102            <A HREF="$up_path"  ><IMG SRC="$Global::upImgURL"   BORDER=1 ALT ="[Up]"  ></A>
  103            <A HREF="/cgi-bin/feedback"><IMG SRC="$Global::feedbackGifUrl"   BORDER=1 ALT ="[Feedback]"  ></A>
  104   <BR CLEAR=ALL><HR NOSHADE><p>
  105 
  106   <BLOCKQUOTE>
  107 EOT
  108 
  109   unless (-r $path) {
  110     print "<H3> Missing documentation</H3>";
  111     print "Can't find file <CODE>$path</CODE> after searching in the following directories:<BR>";
  112     print join("<BR>",@INC);
  113   }
  114 
  115      unless ( defined($pid) ) {
  116       print "<H3> Can't find the file $path </H3>";
  117       return;
  118      }
  119 
  120 # get rid of the html header
  121   while (<STDIN>)  {
  122     last if /<BODY>/;
  123   }
  124 
  125   while (<STDIN>) {
  126     my $line = $_;
  127     last if $line =~ m{</BODY>}i;
  128     chomp($line);
  129     print clipline($line);
  130   }
  131 
  132   print <<EOT;
  133    <p><H6>File path = $path</H6>
  134   </BLOCKQUOTE>
  135   <HR NOSHADE>
  136   Last updated: <STRONG>12 August 1999</STRONG>&nbsp;
  137   <TT>$path</TT>
  138   <BR><FONT SIZE="-2"><STRONG><EM>WeBWorK</EM> documentation written by M. Gage, E. Pachepsky and A. Pizer.
  139   <BR>This page was built by <A HREF = "mailto:gage\@math.rochester.edu">M.Gage</A>
  140   </STRONG></FONT>
  141   </body>
  142   </html>
  143 EOT
  144 
  145 exit;
  146 } # end output filter
  147 
  148 # Routine authors: Arnold Pizer and Michael Gage
  149 # modified by David Etlinger
  150 #
  151 # This routine handles indenting the line and wrapping it, and other formatting
  152 # issues. The incoming text includes HTML tags; code which wraps lines at a
  153 # certain number of characters must ignore these tags. The assumptions I'm making
  154 # about the incoming text are:
  155 # 1)  It contains HTML tags already
  156 # 2)  Special characters (like &) are replaced by HTML codes (like &amp;)
  157 # 3)  Most tabs have already been replaced by spaces (this is a pain to deal with!)
  158 #     Pod2HTML uses 8-column tabs, while we want to use 4-column. Also, 2 or
  159 #     more consecutive spaces are assumed to be a tab. So incoming 8-column
  160 #     tabs need to be converted to 4-column tabs.
  161 # Some of these assumptions might not be valid if pod2HTML changes, or other
  162 # system components are modified.
  163 #                     --David Etlinger 7/27/2000
  164 sub clipline {
  165   my $inLine = shift @_;
  166 
  167   #DEBUG
  168   print LOG "${inLine}\n";
  169 
  170   $inLine = '' unless $inLine =~ /\S/;    #treat lines with only whitespace as blank
  171   $HTMLpre = 1 if $inLine =~ m|<PRE>|i;   #$HTMLpre assumes <PRE> begins the line
  172 
  173   $inLine =~ s/``/&quot;/;    #use &quot; for increased browser compatibility
  174   $inLine =~ s/''/&quot;/;
  175 
  176   my $p2Htabs = 8;        #pod2HTML uses 8-column tabs
  177 
  178   #Replace multiple spaces with tabs. $& is the string that was matched.
  179   #The number of tabs is equal to the number of spaces / $p2Htabs, plus 1 if there
  180   #is a remainder, 0 if not. See comments above for tab explanation.
  181   1 while $inLine =~
  182     s|  +|"\t" x ( int(length($&) / $p2Htabs)+(length($&) % $p2Htabs != 0 ? 1 : 0) )|e;
  183 
  184   my @line = split( //, $inLine );
  185 
  186   # constants
  187   my $tabWidth = 4;
  188   my $indentFlag = 1;
  189   my $commentIndentInc = 2;  # zero puts t
  190   my $maxLineLength = 80;
  191 
  192   # counters
  193   my $HTMLtag = 0;    #is the current character part of an HTML tag?
  194   my $HTMLchar = 0;   #are we in special character of the form &name; ?
  195   my $indentSize = 0;
  196   my $position = 0;   #give number of characters to the left of the pointer
  197               # (pointer is after current character)
  198   my $spacesForTab = 0; #number of spaces to substitute for a tab
  199 
  200   my $out = "";
  201 
  202   foreach my $char ( @line ) {
  203     $position++;
  204 
  205     if( $char eq '<' ) {    #entering an HTML tag
  206       $HTMLtag = 1;
  207     }
  208     if( $char eq '&' ) {    #entering HTML special character
  209       $HTMLchar = 1;
  210     }
  211 
  212     $position -= ($HTMLtag || $HTMLchar); #don't count HTML tags or chars for
  213                         #purposes of line breaks and tabs
  214 
  215     if( $char =~ /\s/ ) {
  216       die "clipline(): The line cannot contain a return" if $char eq "\n";
  217 
  218       if( $char eq "\t" ) {
  219         #emulates tab stops -- the tab might or might not be the full
  220         #width of the tab field, depending on where it started
  221         $spacesForTab = ( ($position % $tabWidth) == 0 ?
  222                     1 : ($tabWidth - $position % $tabWidth + 1) );
  223 
  224         $char = ' ' x $spacesForTab;
  225 
  226         $indentSize += $spacesForTab if $indentFlag == 1;
  227         $position += $spacesForTab - 1;
  228       }
  229       else {
  230         $indentSize++ if $indentFlag == 1;
  231       }
  232 
  233 #Uncomment to enable wrapping lines after $maxLineLength characters.
  234 #This code might need updating to work correctly
  235 #       if ($position > $maxLineLength) {
  236 #         $out .= $char . "\n" . ' ' x $indentSize;
  237 #         $position = $indentSize + 1;
  238 #       }
  239     }
  240     else {
  241       $indentFlag = 0 if $HTMLtag == 0;
  242     }
  243 
  244     if ($char eq "#") {
  245       $indentSize = $position + $commentIndentInc - 2;  #the 2 is right
  246     }
  247 
  248     $out .= $char;
  249 
  250     if( $char eq '>' && $HTMLtag == 1 ) {   #leaving an HTML tag
  251       $HTMLtag = 0;
  252     }
  253     if( $char eq ';' && $HTMLchar == 1 ) {    #leaving an HTML char
  254       $HTMLchar = 0;
  255       $position++;
  256     }
  257   }
  258 
  259   $out =~ s/\s*$//;
  260 
  261   #this was an attempt to force line breaks to follow the source text, but
  262   #incoming text has already removed those line breaks. DME 8/1/2000
  263   #
  264   #don't add a <BR> if the line is blank or contains only HTML tags
  265   #$out .= "<BR>" if( $HTMLpre == 0 && $out ne '' && $out !~ m|^\s*</?.*?>\s*$| );
  266 
  267   $out .= "\n";
  268 
  269   $HTMLpre = 0 if $out =~ m|</PRE>|i;   #assumes <PRE> ends the line
  270 
  271   return $out;
  272 }

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9