| 1 | #!/usr/bin/perl |
1 | #!/usr/local/bin/perl |
| 2 | |
2 | |
| 3 | ## $Id$ |
3 | ## $Id$ |
| 4 | |
4 | |
| 5 | #################################################################### |
5 | #################################################################### |
| 6 | # Copyright @ 1995-1998 University of Rochester |
6 | # Copyright @ 1995-1998 University of Rochester |
| 7 | # All Rights Reserved |
7 | # All Rights Reserved |
| 8 | #################################################################### |
8 | #################################################################### |
| 9 | |
9 | |
| 10 | use strict; |
10 | use strict; |
| 11 | |
11 | |
| 12 | use lib '/ww/webwork/system/'; # mainWeBWorKDirectory; |
12 | use lib '/ww/webwork/gage_system/webwork/system/lib/'; # mainWeBWorKDirectory |
| 13 | # this is the home directory. (change to system) |
13 | # this is the home directory. (change to system) |
| 14 | use Global; |
14 | use Global; |
| 15 | use Pod::Html; |
15 | use Pod::Html; |
| 16 | |
16 | use Carp; |
| 17 | use CGI qw(:standard); |
17 | use CGI qw(:standard); |
| 18 | #eval { |
18 | #eval { |
| 19 | $| = 1; #force command buffering |
19 | $| = 1; #force command buffering |
| 20 | print "Content-type: text/html\n\n"; |
20 | print "Content-type: text/html\n\n"; |
| 21 | $| = 0; |
21 | $| = 0; |
| … | |
… | |
| 31 | #unshift(@INC, $dir1.'courseScripts/',$dir1.'scripts/',$dir1.'cgi/cgi-scripts/'); |
31 | #unshift(@INC, $dir1.'courseScripts/',$dir1.'scripts/',$dir1.'cgi/cgi-scripts/'); |
| 32 | #unshift(@INC, $dir2.'courseScripts/',$dir2.'scripts/',$dir2.'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/'); |
33 | unshift(@INC, $dir3.'courseScripts/',$dir3.'scripts/',$dir3.'cgi/cgi-scripts/'); |
| 34 | # End defining search paths. |
34 | # End defining search paths. |
| 35 | |
35 | |
| 36 | open( LOG, ">pod2webwork.log" ); |
36 | open( LOG, ">pod2webwork.log" ) or warn "Can't open pod2webwork.log for writing"; |
| 37 | print LOG ""; |
37 | #print LOG ""; |
| 38 | close( LOG ); |
38 | #close( LOG ); |
| 39 | open( LOG, ">>pod2webwork.log" ); |
39 | #open( LOG, ">>pod2webwork.log" ); |
| 40 | |
40 | |
| 41 | my $path = param('path'); |
41 | my $path = param('path'); |
| 42 | |
42 | |
| 43 | my $HTMLpre = 0; #for use with clipline(); must be global to this file |
43 | my $HTMLpre = 0; #for use with clipline(); must be global to this file |
| 44 | #because it's used over multiple calls of clipline() |
44 | #because it's used over multiple calls of clipline() |
| … | |
… | |
| 163 | # --David Etlinger 7/27/2000 |
163 | # --David Etlinger 7/27/2000 |
| 164 | sub clipline { |
164 | sub clipline { |
| 165 | my $inLine = shift @_; |
165 | my $inLine = shift @_; |
| 166 | |
166 | |
| 167 | #DEBUG |
167 | #DEBUG |
|
|
168 | # $inLine =~s/"([^;])/"$1/g; # work around for bad quoting in pod2html for links |
| 168 | print LOG "${inLine}\n"; |
169 | print LOG "${inLine}\n"; |
| 169 | |
170 | |
| 170 | $inLine = '' unless $inLine =~ /\S/; #treat lines with only whitespace as blank |
171 | $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 | $HTMLpre = 1 if $inLine =~ m|<PRE>|i; #$HTMLpre assumes <PRE> begins the line |
| 172 | |
173 | |
| 173 | $inLine =~ s/``/"/; #use " for increased browser compatibility |
174 | $inLine =~ s/``/"/g; #use " for increased browser compatibility |
| 174 | $inLine =~ s/''/"/; |
175 | $inLine =~ s/''/"/g; |
| 175 | |
176 | # $inLine =~ s/"/"/g; # can't do this you destroy legitimate HTML attributes |
| 176 | my $p2Htabs = 8; #pod2HTML uses 8-column tabs |
177 | my $p2Htabs = 8; #pod2HTML uses 8-column tabs |
| 177 | |
178 | |
| 178 | #Replace multiple spaces with tabs. $& is the string that was matched. |
179 | #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 | #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 | #is a remainder, 0 if not. See comments above for tab explanation. |
| 181 | 1 while $inLine =~ |
182 | 1 while $inLine =~ |
| 182 | s| +|"\t" x ( int(length($&) / $p2Htabs)+(length($&) % $p2Htabs != 0 ? 1 : 0) )|e; |
183 | s| +|"\t" x ( int(length($&) / $p2Htabs)+(length($&) % $p2Htabs != 0 ? 1 : 0) )|e; |
| 183 | |
184 | |
|
|
185 | |
|
|
186 | # kludge to work around the fact that sometimes pod2html uses " instead of " |
|
|
187 | |
| 184 | my @line = split( //, $inLine ); |
188 | my @line = split( //, $inLine ); |
| 185 | |
189 | |
| 186 | # constants |
190 | # constants |
| 187 | my $tabWidth = 4; |
191 | my $tabWidth = 4; |
| 188 | my $indentFlag = 1; |
192 | my $indentFlag = 1; |
| … | |
… | |
| 230 | $indentSize++ if $indentFlag == 1; |
234 | $indentSize++ if $indentFlag == 1; |
| 231 | } |
235 | } |
| 232 | |
236 | |
| 233 | #Uncomment to enable wrapping lines after $maxLineLength characters. |
237 | #Uncomment to enable wrapping lines after $maxLineLength characters. |
| 234 | #This code might need updating to work correctly |
238 | #This code might need updating to work correctly |
| 235 | # if ($position > $maxLineLength) { |
239 | if ($position > $maxLineLength) { |
| 236 | # $out .= $char . "\n" . ' ' x $indentSize; |
240 | $out .= $char . "\n" . ' ' x $indentSize; |
| 237 | # $position = $indentSize + 1; |
241 | $position = $indentSize + 1; |
| 238 | # } |
242 | } |
| 239 | } |
243 | } |
| 240 | else { |
244 | else { |
| 241 | $indentFlag = 0 if $HTMLtag == 0; |
245 | $indentFlag = 0 if $HTMLtag == 0; |
| 242 | } |
246 | } |
| 243 | |
247 | |
| 244 | if ($char eq "#") { |
248 | if ($char eq "#") { |
| 245 | $indentSize = $position + $commentIndentInc - 2; #the 2 is right |
249 | $indentSize = $position + $commentIndentInc - 2; #the 2 is right |
| 246 | } |
250 | } |
| 247 | |
251 | ### debug $char = "$char|$position|" if $char eq "|"; |
| 248 | $out .= $char; |
252 | $out .= $char; |
| 249 | |
253 | |
| 250 | if( $char eq '>' && $HTMLtag == 1 ) { #leaving an HTML tag |
254 | if( $char eq '>' && $HTMLtag == 1 ) { #leaving an HTML tag |
| 251 | $HTMLtag = 0; |
255 | $HTMLtag = 0; |
| 252 | } |
256 | } |