w3m

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/w3m.git/
Log | Files | Refs | README

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/\&/\&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