scripts/w3mman/w3mman2html.cgi.in

   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 -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 $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/\&/\&amp;/g;
 127   s/\</\&lt;/g;
 128   s/\>/\&gt;/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)*\&lt;)([\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     '<', '&lt;',
 277     '>', '&gt;',
 278     '&', '&amp;',
 279     '"', '&quot;',
 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