Parent Directory
| 
Revision Log
nothing should change
1 #!/usr/local/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 '.'; use webworkInit; # WeBWorKInitLine 13 # this is the home directory. (change to system) 14 use Global; 15 use Pod::Html; 16 use Carp; 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" ) or warn "Can't open pod2webwork.log for writing"; 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> 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 &) 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 # $inLine =~s/"([^;])/"$1/g; # work around for bad quoting in pod2html for links 169 print LOG "${inLine}\n"; 170 171 $inLine = '' unless $inLine =~ /\S/; #treat lines with only whitespace as blank 172 $HTMLpre = 1 if $inLine =~ m|<PRE>|i; #$HTMLpre assumes <PRE> begins the line 173 174 $inLine =~ s/``/"/g; #use " for increased browser compatibility 175 $inLine =~ s/''/"/g; 176 # $inLine =~ s/"/"/g; # can't do this you destroy legitimate HTML attributes 177 my $p2Htabs = 8; #pod2HTML uses 8-column tabs 178 179 #Replace multiple spaces with tabs. $& is the string that was matched. 180 #The number of tabs is equal to the number of spaces / $p2Htabs, plus 1 if there 181 #is a remainder, 0 if not. See comments above for tab explanation. 182 1 while $inLine =~ 183 s| +|"\t" x ( int(length($&) / $p2Htabs)+(length($&) % $p2Htabs != 0 ? 1 : 0) )|e; 184 185 186 # kludge to work around the fact that sometimes pod2html uses " instead of " 187 188 my @line = split( //, $inLine ); 189 190 # constants 191 my $tabWidth = 4; 192 my $indentFlag = 1; 193 my $commentIndentInc = 2; # zero puts t 194 my $maxLineLength = 80; 195 196 # counters 197 my $HTMLtag = 0; #is the current character part of an HTML tag? 198 my $HTMLchar = 0; #are we in special character of the form &name; ? 199 my $indentSize = 0; 200 my $position = 0; #give number of characters to the left of the pointer 201 # (pointer is after current character) 202 my $spacesForTab = 0; #number of spaces to substitute for a tab 203 204 my $out = ""; 205 206 foreach my $char ( @line ) { 207 $position++; 208 209 if( $char eq '<' ) { #entering an HTML tag 210 $HTMLtag = 1; 211 } 212 if( $char eq '&' ) { #entering HTML special character 213 $HTMLchar = 1; 214 } 215 216 $position -= ($HTMLtag || $HTMLchar); #don't count HTML tags or chars for 217 #purposes of line breaks and tabs 218 219 if( $char =~ /\s/ ) { 220 die "clipline(): The line cannot contain a return" if $char eq "\n"; 221 222 if( $char eq "\t" ) { 223 #emulates tab stops -- the tab might or might not be the full 224 #width of the tab field, depending on where it started 225 $spacesForTab = ( ($position % $tabWidth) == 0 ? 226 1 : ($tabWidth - $position % $tabWidth + 1) ); 227 228 $char = ' ' x $spacesForTab; 229 230 $indentSize += $spacesForTab if $indentFlag == 1; 231 $position += $spacesForTab - 1; 232 } 233 else { 234 $indentSize++ if $indentFlag == 1; 235 } 236 237 #Uncomment to enable wrapping lines after $maxLineLength characters. 238 #This code might need updating to work correctly 239 if ($position > $maxLineLength) { 240 $out .= $char . "\n" . ' ' x $indentSize; 241 $position = $indentSize + 1; 242 } 243 } 244 else { 245 $indentFlag = 0 if $HTMLtag == 0; 246 } 247 248 if ($char eq "#") { 249 $indentSize = $position + $commentIndentInc - 2; #the 2 is right 250 } 251 ### debug $char = "$char|$position|" if $char eq "|"; 252 $out .= $char; 253 254 if( $char eq '>' && $HTMLtag == 1 ) { #leaving an HTML tag 255 $HTMLtag = 0; 256 } 257 if( $char eq ';' && $HTMLchar == 1 ) { #leaving an HTML char 258 $HTMLchar = 0; 259 $position++; 260 } 261 } 262 263 $out =~ s/\s*$//; 264 265 #this was an attempt to force line breaks to follow the source text, but 266 #incoming text has already removed those line breaks. DME 8/1/2000 267 # 268 #don't add a <BR> if the line is blank or contains only HTML tags 269 #$out .= "<BR>" if( $HTMLpre == 0 && $out ne '' && $out !~ m|^\s*</?.*?>\s*$| ); 270 271 $out .= "\n"; 272 273 $HTMLpre = 0 if $out =~ m|</PRE>|i; #assumes <PRE> ends the line 274 275 return $out; 276 }
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |