w3mman2html.cgi.in (5891B)
1 #!@PERL@ 2 3 $MAN = $ENV{'W3MMAN_MAN'} || '@MAN@'; 4 $QUERY = $ENV{'QUERY_STRING'} || $ARGV[0]; 5 $SCRIPT_NAME = $ENV{'SCRIPT_NAME'} || $0; 6 $CGI = "file://$SCRIPT_NAME"; 7 $CGI2 = "file:"; 8 # $CGI2 = "file:///\$LIB/hlink.cgi?"; 9 $SQUEEZE = 1; 10 $ENV{'PAGER'} = 'cat'; 11 12 if ($QUERY =~ /\=/) { 13 for (split('&', $QUERY)) { 14 ($v, $q) = split('=', $_, 2); 15 $query{$v} = &form_decode($q); 16 } 17 } else { 18 $QUERY =~ s/^man=//; 19 $query{"man"} = &form_decode($QUERY); 20 } 21 22 if ((! $query{"man"}) && (! $query{"local"})) { 23 if ($query{"keyword"}) { 24 $keyword = $query{"keyword"}; 25 $k = &html_quote($keyword); 26 print <<EOF; 27 Content-Type: text/html 28 29 <html> 30 <head><title>man -k $k</title></head> 31 <body> 32 <h2>man -k <b>$k</b></h2> 33 <ul> 34 EOF 35 $keyword =~ s:([^-\w\200-\377.,])::g; 36 open(F, "$MAN -k $keyword 2> /dev/null |"); 37 @line = (); 38 while(<F>) { 39 chop; 40 $_ = &html_quote($_); 41 s/(\s+-.*)$//; 42 $title = $1; 43 s@(\w[\w.\-]*(\s*\,\s*\w[\w.\-]*)*)\s*(\([\dn]\w*\))@&keyword_ref($1, $3)@ge; 44 print "<li>$_$title\n"; 45 } 46 close(F); 47 print <<EOF; 48 </ul> 49 </body> 50 </html> 51 EOF 52 exit; 53 } 54 print <<EOF; 55 Content-Type: text/html 56 57 <html> 58 <head><title>man</title></head> 59 <body> 60 <form action="$CGI"> 61 <table> 62 <tr><td>Manual:<td><input name=man> 63 <tr><td>Section:<td><input name=section> 64 <tr><td>Keyword:<td><input name=keyword> 65 <tr><td><td><input type=submit> <input type=reset> 66 </table> 67 </form> 68 </body> 69 </html> 70 EOF 71 exit; 72 } 73 74 if ($query{"local"}) { 75 $file = $query{"local"}; 76 if (! ($file =~ /^\//)) { 77 $file = $query{"pwd"} . '/' . $file; 78 } 79 open(F, "MAN_KEEP_FORMATTING=1 $MAN -l $file 2> /dev/null |"); 80 } else { 81 $man = $query{"man"}; 82 if ($man =~ s/\((\w+)\)$//) { 83 $section = $1; 84 $man_section = "$man($1)"; 85 } elsif ($query{"section"}) { 86 $section = $query{"section"}; 87 $man_section = "$man($section)"; 88 } else { 89 $section = ""; 90 $man_section = "$man"; 91 } 92 93 $section =~ s:([^-\w\200-\377.,])::g; 94 $man =~ s:([^-\w\200-\377.,])::g; 95 open(F, "MAN_KEEP_FORMATTING=1 $MAN $section $man 2> /dev/null |"); 96 } 97 $ok = 0; 98 undef $header; 99 $blank = -1; 100 $cmd = ""; 101 $prev = ""; 102 while(<F>) { 103 if (! defined($header)) { 104 /^\s*$/ && next; 105 $header = $_; 106 $space = $header; 107 chop $space; 108 $space =~ s/\S.*//; 109 } elsif ($_ eq $header) { # delete header 110 $blank = -1; 111 next; 112 } elsif (!/\010/ && /^$space[\w\200-\377].*\s\S/o) { # delete footer 113 $blank = -1; 114 next; 115 } 116 if ($SQUEEZE) { 117 if (/^\s*$/) { 118 $blank || $blank++; 119 next; 120 } elsif ($blank) { 121 $blank > 0 && print "\n"; 122 $blank = 0; 123 } 124 } 125 126 s/\&/\&/g; 127 s/\</\</g; 128 s/\>/\>/g; 129 130 s@([\200-\377].)(\010{1,2}\1)+@<b>$1</b>@g; 131 s@(\&\w+;|.)(\010\1)+@<b>$1</b>@g; 132 s@__\010{1,2}((\<b\>)?[\200-\377].(\</b\>)?)@<u>$1</u>@g; 133 s@_\010((\<b\>)?(\&\w+\;|.)(\</b\>)?)@<u>$1</u>@g; 134 s@((\<b\>)?[\200-\377].(\</b\>)?)\010{1,2}__@<u>$1</u>@g; 135 s@((\<b\>)?(\&\w+\;|.)(\</b\>)?)\010_@<u>$1</u>@g; 136 s@.\010(.)@$1@g; 137 138 s@\</b\>\</u\>\<b\>_\</b\>\<u\>\<b\>@_@g; 139 s@\</u\>\<b\>_\</b\>\<u\>@_@g; 140 s@\</u\>\<u\>@@g; 141 s@\</b\>\<b\>@@g; 142 143 if (! $ok) { 144 /^No/ && last; 145 print <<EOF; 146 Content-Type: text/html 147 148 <html> 149 <head><title>man $man_section</title></head> 150 <body> 151 <pre> 152 EOF 153 print; 154 $ok = 1; 155 next; 156 } 157 158 s@(http|ftp)://[\w.\-/~]+[\w/]@<a href="$&">$&</a>@g; 159 s@(\W)(mailto:)?(\w[\w.\-]*\@\w[\w.\-]*\.[\w.\-]*\w)@$1<a href="mailto:$3">$2$3</a>@g; 160 s@(\W)(\~?/[\w.][\w.\-/~]*)@$1 . &file_ref($2)@ge; 161 s@(include(<\/?[bu]\>|\s)*\<)([\w.\-/]+)@$1 . &include_ref($3)@ge; 162 if ($prev && m@^\s*(\<[bu]\>)*(\w[\w.\-]*)(\</[bu]\>)*(\([\dm]\w*\))@) { 163 $cmd .= "$2$4"; 164 $prev =~ s@(\w[\w.\-]*-)((\</[bu]\>)*\s*)$@<a href="$CGI?$cmd">$1</a>$2@; 165 print $prev; 166 $prev = ''; 167 s@^(\s*(\<[bu]\>)*)(\w[\w.\-]*)@@; 168 print "$1<a href=\"$CGI?$cmd\">$3</a>"; 169 } elsif ($prev) { 170 print $prev; 171 $prev = ''; 172 } 173 s@(\w[\w.\-]*)((\</[bu]\>)*)(\([\dm]\w*\))@<a href="$CGI?$1$4">$1</a>$2$4@g; 174 if (m@(\w[\w.\-]*)-(\</[bu]\>)*\s*$@) { 175 $cmd = $1; 176 $prev = $_; 177 next; 178 } 179 print; 180 } 181 if ($prev) { 182 print $prev; 183 } 184 close(F); 185 if (! $ok) { 186 if ($query{'quit'}) { 187 if ($query{'local'}) { 188 print STDERR "File $file not found.\n"; 189 } else { 190 print STDERR "No manual entry for $man_section.\n"; 191 } 192 print STDERR "No manual entry for $man_section.\n"; 193 print <<EOF; 194 w3m-control: EXIT 195 EOF 196 exit 1; 197 } 198 print <<EOF; 199 Content-Type: text/html 200 201 <html> 202 <head><title>man $man_section</title></head> 203 <body> 204 <pre> 205 EOF 206 if ($query{'local'}) { 207 print "File <B>$file</B> not found.\n"; 208 } else { 209 print "No manual entry for <B>$man_section</B>.\n"; 210 } 211 } 212 print <<EOF; 213 </pre> 214 </body> 215 </html> 216 EOF 217 218 sub is_command { 219 local($_) = @_; 220 local($p); 221 222 (! -d && -x) || return 0; 223 if (! defined(%PATH)) { 224 for $p (split(":", $ENV{'PATH'})) { 225 $p =~ s@/+$@@; 226 $PATH{$p} = 1; 227 } 228 } 229 s@/[^/]*$@@; 230 return defined($PATH{$_}); 231 } 232 233 sub file_ref { 234 local($_) = @_; 235 236 if (&is_command($_)) { 237 ($man = $_) =~ s@.*/@@; 238 return "<a href=\"$CGI?$man\">$_</a>"; 239 } 240 if (/^\~/ || -f || -d) { 241 return "<a href=\"$CGI2$_\">$_</a>"; 242 } 243 return $_; 244 } 245 246 sub include_ref { 247 local($_) = @_; 248 local($d); 249 250 for $d ( 251 "/usr/include", 252 "/usr/local/include", 253 "/usr/X11R6/include", 254 "/usr/X11/include", 255 "/usr/X/include", 256 "/usr/include/X11" 257 ) { 258 -f "$d/$_" && return "<a href=\"$CGI2$d/$_\">$_</a>"; 259 } 260 return $_; 261 } 262 263 sub keyword_ref { 264 local($_, $s) = @_; 265 local(@a) = (); 266 267 for (split(/\s*,\s*/)) { 268 push(@a, "<a href=\"$CGI?$_$s\">$_</a>"); 269 } 270 return join(", ", @a) . $s; 271 } 272 273 sub html_quote { 274 local($_) = @_; 275 local(%QUOTE) = ( 276 '<', '<', 277 '>', '>', 278 '&', '&', 279 '"', '"', 280 ); 281 s/[<>&"]/$QUOTE{$&}/g; 282 return $_; 283 } 284 285 sub form_decode { 286 local($_) = @_; 287 s/\+/ /g; 288 s/%([\da-f][\da-f])/pack('c', hex($1))/egi; 289 return $_; 290 } 291